utils/consistbl.cmi
utils/consistbl.cmi : \
utils/misc.cmi
+utils/diffing.cmo : \
+ utils/diffing.cmi
+utils/diffing.cmx : \
+ utils/diffing.cmi
+utils/diffing.cmi :
utils/domainstate.cmo : \
utils/domainstate.cmi
utils/domainstate.cmx : \
utils/int_replace_polymorphic_compare.cmx : \
utils/int_replace_polymorphic_compare.cmi
utils/int_replace_polymorphic_compare.cmi :
+utils/lazy_backtrack.cmo : \
+ utils/lazy_backtrack.cmi
+utils/lazy_backtrack.cmx : \
+ utils/lazy_backtrack.cmi
+utils/lazy_backtrack.cmi :
utils/load_path.cmo : \
utils/misc.cmi \
utils/local_store.cmi \
parsing/location.cmi \
utils/local_store.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
utils/clflags.cmi \
typing/btype.cmi \
parsing/location.cmx \
utils/local_store.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
utils/clflags.cmx \
typing/btype.cmx \
typing/type_immediacy.cmi \
typing/path.cmi \
parsing/longident.cmi \
+ parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
parsing/asttypes.cmi
typing/datarepr.cmo : \
parsing/location.cmi \
utils/local_store.cmi \
utils/load_path.cmi \
+ utils/lazy_backtrack.cmi \
typing/ident.cmi \
typing/datarepr.cmi \
file_formats/cmi_format.cmi \
parsing/location.cmx \
utils/local_store.cmx \
utils/load_path.cmx \
+ utils/lazy_backtrack.cmx \
typing/ident.cmx \
typing/datarepr.cmx \
file_formats/cmi_format.cmx \
typing/subst.cmi \
typing/path.cmi \
typing/env.cmi
+typing/errortrace.cmo : \
+ typing/types.cmi \
+ typing/path.cmi \
+ parsing/asttypes.cmi \
+ typing/errortrace.cmi
+typing/errortrace.cmx : \
+ typing/types.cmx \
+ typing/path.cmx \
+ parsing/asttypes.cmi \
+ typing/errortrace.cmi
+typing/errortrace.cmi : \
+ typing/types.cmi \
+ typing/path.cmi \
+ parsing/asttypes.cmi
typing/ident.cmo : \
utils/misc.cmi \
utils/local_store.cmi \
typing/typedtree.cmi \
typing/type_immediacy.cmi \
typing/printtyp.cmi \
+ typing/primitive.cmi \
typing/path.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
parsing/builtin_attributes.cmi \
typing/typedtree.cmx \
typing/type_immediacy.cmx \
typing/printtyp.cmx \
+ typing/primitive.cmx \
typing/path.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
parsing/builtin_attributes.cmx \
typing/path.cmi \
parsing/location.cmi \
typing/ident.cmi \
- typing/env.cmi \
- typing/ctype.cmi
+ typing/errortrace.cmi \
+ typing/env.cmi
typing/includemod.cmo : \
typing/types.cmi \
typing/typedtree.cmi \
typing/primitive.cmi \
typing/predef.cmi \
typing/path.cmi \
- typing/oprint.cmi \
typing/mtype.cmi \
utils/misc.cmi \
+ parsing/longident.cmi \
parsing/location.cmi \
typing/includecore.cmi \
typing/includeclass.cmi \
typing/ident.cmi \
typing/env.cmi \
+ utils/diffing.cmi \
typing/ctype.cmi \
file_formats/cmt_format.cmi \
- utils/clflags.cmi \
parsing/builtin_attributes.cmi \
typing/btype.cmi \
typing/includemod.cmi
typing/primitive.cmx \
typing/predef.cmx \
typing/path.cmx \
- typing/oprint.cmx \
typing/mtype.cmx \
utils/misc.cmx \
+ parsing/longident.cmx \
parsing/location.cmx \
typing/includecore.cmx \
typing/includeclass.cmx \
typing/ident.cmx \
typing/env.cmx \
+ utils/diffing.cmx \
typing/ctype.cmx \
file_formats/cmt_format.cmx \
- utils/clflags.cmx \
parsing/builtin_attributes.cmx \
typing/btype.cmx \
typing/includemod.cmi
typing/types.cmi \
typing/typedtree.cmi \
typing/path.cmi \
+ parsing/longident.cmi \
parsing/location.cmi \
typing/includecore.cmi \
typing/ident.cmi \
typing/env.cmi \
+ utils/diffing.cmi \
typing/ctype.cmi
+typing/includemod_errorprinter.cmo : \
+ typing/types.cmi \
+ typing/typedtree.cmi \
+ typing/printtyp.cmi \
+ typing/path.cmi \
+ typing/oprint.cmi \
+ utils/misc.cmi \
+ parsing/location.cmi \
+ typing/includemod.cmi \
+ typing/includecore.cmi \
+ typing/includeclass.cmi \
+ typing/ident.cmi \
+ typing/env.cmi \
+ utils/diffing.cmi \
+ utils/clflags.cmi \
+ typing/includemod_errorprinter.cmi
+typing/includemod_errorprinter.cmx : \
+ typing/types.cmx \
+ typing/typedtree.cmx \
+ typing/printtyp.cmx \
+ typing/path.cmx \
+ typing/oprint.cmx \
+ utils/misc.cmx \
+ parsing/location.cmx \
+ typing/includemod.cmx \
+ typing/includecore.cmx \
+ typing/includeclass.cmx \
+ typing/ident.cmx \
+ typing/env.cmx \
+ utils/diffing.cmx \
+ utils/clflags.cmx \
+ typing/includemod_errorprinter.cmi
+typing/includemod_errorprinter.cmi : \
+ typing/includemod.cmi
typing/mtype.cmo : \
typing/types.cmi \
typing/subst.cmi \
utils/misc.cmi \
parsing/location.cmi \
utils/load_path.cmi \
+ utils/lazy_backtrack.cmi \
utils/consistbl.cmi \
utils/config.cmi \
file_formats/cmi_format.cmi \
utils/misc.cmx \
parsing/location.cmx \
utils/load_path.cmx \
+ utils/lazy_backtrack.cmx \
utils/consistbl.cmx \
utils/config.cmx \
file_formats/cmi_format.cmx \
typing/types.cmi \
utils/misc.cmi \
parsing/location.cmi \
+ utils/lazy_backtrack.cmi \
utils/consistbl.cmi \
file_formats/cmi_format.cmi
typing/predef.cmo : \
utils/warnings.cmi \
typing/types.cmi \
typing/type_immediacy.cmi \
+ typing/signature_group.cmi \
typing/primitive.cmi \
typing/predef.cmi \
typing/path.cmi \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/clflags.cmi \
utils/warnings.cmx \
typing/types.cmx \
typing/type_immediacy.cmx \
+ typing/signature_group.cmx \
typing/primitive.cmx \
typing/predef.cmx \
typing/path.cmx \
parsing/longident.cmx \
parsing/location.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/clflags.cmx \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
- typing/ctype.cmi \
parsing/asttypes.cmi
typing/printtyped.cmo : \
typing/types.cmi \
typing/rec_check.cmi : \
typing/typedtree.cmi \
typing/ident.cmi
+typing/signature_group.cmo : \
+ typing/types.cmi \
+ typing/ident.cmi \
+ typing/btype.cmi \
+ typing/signature_group.cmi
+typing/signature_group.cmx : \
+ typing/types.cmx \
+ typing/ident.cmx \
+ typing/btype.cmx \
+ typing/signature_group.cmi
+typing/signature_group.cmi : \
+ typing/types.cmi
typing/stypes.cmo : \
typing/typedtree.cmi \
typing/printtyp.cmi \
typing/subst.cmi : \
typing/types.cmi \
typing/path.cmi \
+ parsing/location.cmi \
typing/ident.cmi
typing/tast_iterator.cmo : \
typing/typedtree.cmi \
parsing/location.cmi \
typing/includeclass.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
file_formats/cmt_format.cmi \
parsing/location.cmx \
typing/includeclass.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
file_formats/cmt_format.cmx \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
parsing/asttypes.cmi
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
file_formats/cmt_format.cmi \
parsing/longident.cmx \
parsing/location.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
file_formats/cmt_format.cmx \
parsing/longident.cmi \
parsing/location.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
- typing/ctype.cmi \
parsing/asttypes.cmi
typing/typedecl.cmo : \
utils/warnings.cmi \
parsing/location.cmi \
typing/includecore.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/config.cmi \
parsing/location.cmx \
typing/includecore.cmx \
typing/ident.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/config.cmx \
parsing/location.cmi \
typing/includecore.cmi \
typing/ident.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
- typing/ctype.cmi \
parsing/asttypes.cmi
typing/typedecl_immediacy.cmo : \
typing/types.cmi \
typing/ctype.cmi \
utils/config.cmi \
typing/btype.cmi \
- parsing/asttypes.cmi \
typing/typedecl_separability.cmi
typing/typedecl_separability.cmx : \
typing/types.cmx \
typing/ctype.cmx \
utils/config.cmx \
typing/btype.cmx \
- parsing/asttypes.cmi \
typing/typedecl_separability.cmi
typing/typedecl_separability.cmi : \
typing/types.cmi \
typing/typecore.cmi \
typing/typeclass.cmi \
typing/subst.cmi \
+ typing/signature_group.cmi \
typing/printtyp.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
utils/load_path.cmi \
+ typing/includemod_errorprinter.cmi \
typing/includemod.cmi \
typing/ident.cmi \
typing/env.cmi \
typing/typecore.cmx \
typing/typeclass.cmx \
typing/subst.cmx \
+ typing/signature_group.cmx \
typing/printtyp.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
parsing/longident.cmx \
parsing/location.cmx \
utils/load_path.cmx \
+ typing/includemod_errorprinter.cmx \
typing/includemod.cmx \
typing/ident.cmx \
typing/env.cmx \
utils/misc.cmi \
parsing/longident.cmi \
parsing/location.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
typing/ctype.cmi \
utils/clflags.cmi \
utils/misc.cmx \
parsing/longident.cmx \
parsing/location.cmx \
+ typing/errortrace.cmx \
typing/env.cmx \
typing/ctype.cmx \
utils/clflags.cmx \
parsing/parsetree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
+ typing/errortrace.cmi \
typing/env.cmi \
- typing/ctype.cmi \
parsing/asttypes.cmi
typing/untypeast.cmo : \
typing/typedtree.cmi \
asmcomp/proc.cmi \
asmcomp/mach.cmi \
asmcomp/cmm.cmi \
+ parsing/asttypes.cmi \
asmcomp/CSEgen.cmi
asmcomp/CSEgen.cmx : \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
asmcomp/mach.cmx \
asmcomp/cmm.cmx \
+ parsing/asttypes.cmi \
asmcomp/CSEgen.cmi
asmcomp/CSEgen.cmi : \
- asmcomp/mach.cmi
+ asmcomp/mach.cmi \
+ parsing/asttypes.cmi
asmcomp/afl_instrument.cmo : \
lambda/lambda.cmi \
asmcomp/cmm.cmi \
asmcomp/printlinear.cmi \
asmcomp/printcmm.cmi \
typing/primitive.cmi \
+ asmcomp/polling.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
parsing/location.cmi \
asmcomp/linscan.cmi \
asmcomp/linearize.cmi \
file_formats/linear_format.cmi \
+ asmcomp/linear.cmi \
lambda/lambda.cmi \
asmcomp/interval.cmi \
asmcomp/interf.cmi \
asmcomp/comballoc.cmi \
asmcomp/coloring.cmi \
asmcomp/cmmgen.cmi \
+ asmcomp/cmm_invariants.cmi \
asmcomp/cmm_helpers.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
middle_end/clambda.cmi \
asmcomp/CSE.cmo \
middle_end/backend_intf.cmi \
- asmcomp/debug/available_regs.cmi \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmx : \
lambda/translmod.cmx \
asmcomp/printlinear.cmx \
asmcomp/printcmm.cmx \
typing/primitive.cmx \
+ asmcomp/polling.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
parsing/location.cmx \
asmcomp/linscan.cmx \
asmcomp/linearize.cmx \
file_formats/linear_format.cmx \
+ asmcomp/linear.cmx \
lambda/lambda.cmx \
asmcomp/interval.cmx \
asmcomp/interf.cmx \
asmcomp/comballoc.cmx \
asmcomp/coloring.cmx \
asmcomp/cmmgen.cmx \
+ asmcomp/cmm_invariants.cmx \
asmcomp/cmm_helpers.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
middle_end/clambda.cmx \
asmcomp/CSE.cmx \
middle_end/backend_intf.cmi \
- asmcomp/debug/available_regs.cmx \
asmcomp/asmgen.cmi
asmcomp/asmgen.cmi : \
lambda/lambda.cmi \
+ asmcomp/emitaux.cmi \
asmcomp/cmm.cmi \
middle_end/clambda.cmi \
middle_end/backend_intf.cmi
asmcomp/branch_relaxation_intf.cmo : \
asmcomp/linear.cmi \
lambda/debuginfo.cmi \
+ asmcomp/cmm.cmi \
asmcomp/arch.cmo
asmcomp/branch_relaxation_intf.cmx : \
asmcomp/linear.cmx \
lambda/debuginfo.cmx \
+ asmcomp/cmm.cmx \
asmcomp/arch.cmx
asmcomp/cmm.cmo : \
utils/targetint.cmi \
middle_end/clambda_primitives.cmi \
middle_end/clambda.cmi \
parsing/asttypes.cmi
+asmcomp/cmm_invariants.cmo : \
+ utils/numbers.cmi \
+ asmcomp/cmm.cmi \
+ asmcomp/cmm_invariants.cmi
+asmcomp/cmm_invariants.cmx : \
+ utils/numbers.cmx \
+ asmcomp/cmm.cmx \
+ asmcomp/cmm_invariants.cmi
+asmcomp/cmm_invariants.cmi : \
+ asmcomp/cmm.cmi
asmcomp/cmmgen.cmo : \
typing/types.cmi \
middle_end/printclambda_primitives.cmi \
asmcomp/comballoc.cmi
asmcomp/comballoc.cmi : \
asmcomp/mach.cmi
+asmcomp/dataflow.cmo : \
+ asmcomp/mach.cmi \
+ asmcomp/cmm.cmi \
+ asmcomp/dataflow.cmi
+asmcomp/dataflow.cmx : \
+ asmcomp/mach.cmx \
+ asmcomp/cmm.cmx \
+ asmcomp/dataflow.cmi
+asmcomp/dataflow.cmi : \
+ asmcomp/mach.cmi
asmcomp/deadcode.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/mach.cmi \
asmcomp/linear.cmi \
lambda/lambda.cmi \
+ asmcomp/emitenv.cmi \
asmcomp/emitaux.cmi \
utils/domainstate.cmi \
utils/config.cmi \
asmcomp/mach.cmx \
asmcomp/linear.cmx \
lambda/lambda.cmx \
+ asmcomp/emitenv.cmi \
asmcomp/emitaux.cmx \
utils/domainstate.cmx \
utils/config.cmx \
asmcomp/linear.cmi \
asmcomp/cmm.cmi
asmcomp/emitaux.cmo : \
+ asmcomp/emitenv.cmi \
lambda/debuginfo.cmi \
utils/config.cmi \
asmcomp/cmm.cmi \
asmcomp/arch.cmo \
asmcomp/emitaux.cmi
asmcomp/emitaux.cmx : \
+ asmcomp/emitenv.cmi \
lambda/debuginfo.cmx \
utils/config.cmx \
asmcomp/cmm.cmx \
asmcomp/arch.cmx \
asmcomp/emitaux.cmi
asmcomp/emitaux.cmi : \
+ asmcomp/linear.cmi \
+ asmcomp/emitenv.cmi \
lambda/debuginfo.cmi
+asmcomp/emitenv.cmi : \
+ asmcomp/linear.cmi
asmcomp/interf.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/printmach.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
- asmcomp/cmm.cmi \
+ asmcomp/dataflow.cmi \
asmcomp/liveness.cmi
asmcomp/liveness.cmx : \
asmcomp/reg.cmx \
asmcomp/printmach.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
- asmcomp/cmm.cmx \
+ asmcomp/dataflow.cmx \
asmcomp/liveness.cmi
asmcomp/liveness.cmi : \
asmcomp/mach.cmi
asmcomp/mach.cmo : \
- asmcomp/debug/reg_with_debug_info.cmi \
- asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
lambda/lambda.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
- middle_end/backend_var.cmi \
+ parsing/asttypes.cmi \
asmcomp/arch.cmo \
asmcomp/mach.cmi
asmcomp/mach.cmx : \
- asmcomp/debug/reg_with_debug_info.cmx \
- asmcomp/debug/reg_availability_set.cmx \
asmcomp/reg.cmx \
lambda/lambda.cmx \
lambda/debuginfo.cmx \
asmcomp/cmm.cmx \
- middle_end/backend_var.cmx \
+ parsing/asttypes.cmi \
asmcomp/arch.cmx \
asmcomp/mach.cmi
asmcomp/mach.cmi : \
- asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
lambda/lambda.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
- middle_end/backend_var.cmi \
+ parsing/asttypes.cmi \
asmcomp/arch.cmo
+asmcomp/polling.cmo : \
+ utils/numbers.cmi \
+ utils/misc.cmi \
+ asmcomp/mach.cmi \
+ asmcomp/dataflow.cmi \
+ asmcomp/cmm.cmi \
+ asmcomp/polling.cmi
+asmcomp/polling.cmx : \
+ utils/numbers.cmx \
+ utils/misc.cmx \
+ asmcomp/mach.cmx \
+ asmcomp/dataflow.cmx \
+ asmcomp/cmm.cmx \
+ asmcomp/polling.cmi
+asmcomp/polling.cmi : \
+ utils/misc.cmi \
+ asmcomp/mach.cmi
asmcomp/printcmm.cmo : \
utils/targetint.cmi \
lambda/lambda.cmi \
asmcomp/printlinear.cmi : \
asmcomp/linear.cmi
asmcomp/printmach.cmo : \
- asmcomp/debug/reg_availability_set.cmi \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
asmcomp/printcmm.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
- middle_end/backend_var.cmi \
asmcomp/arch.cmo \
asmcomp/printmach.cmi
asmcomp/printmach.cmx : \
- asmcomp/debug/reg_availability_set.cmx \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
asmcomp/printcmm.cmx \
lambda/debuginfo.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
- middle_end/backend_var.cmx \
asmcomp/arch.cmx \
asmcomp/printmach.cmi
asmcomp/printmach.cmi : \
asmcomp/selectgen.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
+ asmcomp/polling.cmi \
utils/numbers.cmi \
utils/misc.cmi \
asmcomp/mach.cmi \
asmcomp/selectgen.cmx : \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
+ asmcomp/polling.cmx \
utils/numbers.cmx \
utils/misc.cmx \
asmcomp/mach.cmx \
asmcomp/selectgen.cmi
asmcomp/selectgen.cmi : \
asmcomp/reg.cmi \
+ utils/misc.cmi \
asmcomp/mach.cmi \
lambda/debuginfo.cmi \
asmcomp/cmm.cmi \
asmcomp/arch.cmx \
asmcomp/selection.cmi
asmcomp/selection.cmi : \
+ utils/misc.cmi \
asmcomp/mach.cmi \
asmcomp/cmm.cmi
asmcomp/spill.cmo : \
asmcomp/reg.cmi \
asmcomp/proc.cmi \
- utils/misc.cmi \
asmcomp/mach.cmi \
asmcomp/cmm.cmi \
utils/clflags.cmi \
asmcomp/spill.cmx : \
asmcomp/reg.cmx \
asmcomp/proc.cmx \
- utils/misc.cmx \
asmcomp/mach.cmx \
asmcomp/cmm.cmx \
utils/clflags.cmx \
middle_end/flambda/base_types/var_within_closure.cmi
middle_end/flambda/base_types/var_within_closure.cmi : \
middle_end/flambda/base_types/closure_element.cmi
-asmcomp/debug/available_regs.cmo : \
- asmcomp/debug/reg_with_debug_info.cmi \
- asmcomp/debug/reg_availability_set.cmi \
- asmcomp/reg.cmi \
- asmcomp/proc.cmi \
- asmcomp/printmach.cmi \
- utils/misc.cmi \
- asmcomp/mach.cmi \
- utils/clflags.cmi \
- middle_end/backend_var.cmi \
- asmcomp/debug/available_regs.cmi
-asmcomp/debug/available_regs.cmx : \
- asmcomp/debug/reg_with_debug_info.cmx \
- asmcomp/debug/reg_availability_set.cmx \
- asmcomp/reg.cmx \
- asmcomp/proc.cmx \
- asmcomp/printmach.cmx \
- utils/misc.cmx \
- asmcomp/mach.cmx \
- utils/clflags.cmx \
- middle_end/backend_var.cmx \
- asmcomp/debug/available_regs.cmi
-asmcomp/debug/available_regs.cmi : \
- asmcomp/mach.cmi
-asmcomp/debug/compute_ranges.cmo : \
- asmcomp/printlinear.cmi \
- utils/numbers.cmi \
- utils/misc.cmi \
- asmcomp/linear.cmi \
- utils/int_replace_polymorphic_compare.cmi \
- asmcomp/debug/compute_ranges_intf.cmo \
- asmcomp/cmm.cmi \
- asmcomp/debug/compute_ranges.cmi
-asmcomp/debug/compute_ranges.cmx : \
- asmcomp/printlinear.cmx \
- utils/numbers.cmx \
- utils/misc.cmx \
- asmcomp/linear.cmx \
- utils/int_replace_polymorphic_compare.cmx \
- asmcomp/debug/compute_ranges_intf.cmx \
- asmcomp/cmm.cmx \
- asmcomp/debug/compute_ranges.cmi
-asmcomp/debug/compute_ranges.cmi : \
- asmcomp/debug/compute_ranges_intf.cmo
-asmcomp/debug/compute_ranges_intf.cmo : \
- utils/numbers.cmi \
- asmcomp/linear.cmi \
- utils/identifiable.cmi
-asmcomp/debug/compute_ranges_intf.cmx : \
- utils/numbers.cmx \
- asmcomp/linear.cmx \
- utils/identifiable.cmx
-asmcomp/debug/reg_availability_set.cmo : \
- asmcomp/debug/reg_with_debug_info.cmi \
- middle_end/backend_var.cmi \
- asmcomp/debug/reg_availability_set.cmi
-asmcomp/debug/reg_availability_set.cmx : \
- asmcomp/debug/reg_with_debug_info.cmx \
- middle_end/backend_var.cmx \
- asmcomp/debug/reg_availability_set.cmi
-asmcomp/debug/reg_availability_set.cmi : \
- asmcomp/debug/reg_with_debug_info.cmi \
- asmcomp/reg.cmi
-asmcomp/debug/reg_with_debug_info.cmo : \
- asmcomp/reg.cmi \
- middle_end/backend_var.cmi \
- asmcomp/debug/reg_with_debug_info.cmi
-asmcomp/debug/reg_with_debug_info.cmx : \
- asmcomp/reg.cmx \
- middle_end/backend_var.cmx \
- asmcomp/debug/reg_with_debug_info.cmi
-asmcomp/debug/reg_with_debug_info.cmi : \
- asmcomp/reg.cmi \
- middle_end/backend_var.cmi
driver/compenv.cmo : \
utils/warnings.cmi \
utils/profile.cmi \
driver/compenv.cmi : \
utils/clflags.cmi
driver/compile.cmo : \
+ typing/typedtree.cmi \
lambda/translmod.cmi \
lambda/simplif.cmi \
utils/profile.cmi \
bytecomp/bytegen.cmi \
driver/compile.cmi
driver/compile.cmx : \
+ typing/typedtree.cmx \
lambda/translmod.cmx \
lambda/simplif.cmx \
utils/profile.cmx \
utils/warnings.cmi \
utils/profile.cmi \
utils/misc.cmi \
+ parsing/location.cmi \
utils/config.cmi \
driver/compenv.cmi \
utils/clflags.cmi \
utils/warnings.cmx \
utils/profile.cmx \
utils/misc.cmx \
+ parsing/location.cmx \
utils/config.cmx \
driver/compenv.cmx \
utils/clflags.cmx \
driver/makedepend.cmi
driver/makedepend.cmi :
driver/optcompile.cmo : \
+ typing/typedtree.cmi \
lambda/translmod.cmi \
lambda/simplif.cmi \
utils/profile.cmi \
asmcomp/asmgen.cmi \
driver/optcompile.cmi
driver/optcompile.cmx : \
+ typing/typedtree.cmx \
lambda/translmod.cmx \
lambda/simplif.cmx \
utils/profile.cmx \
typing/path.cmi \
typing/outcometree.cmi \
typing/env.cmi
-toplevel/opttopdirs.cmo : \
- utils/warnings.cmi \
- typing/types.cmi \
- typing/printtyp.cmi \
- toplevel/opttoploop.cmi \
- utils/misc.cmi \
- parsing/longident.cmi \
- utils/load_path.cmi \
- typing/ident.cmi \
- typing/env.cmi \
- typing/ctype.cmi \
- utils/config.cmi \
- driver/compenv.cmi \
- utils/clflags.cmi \
- asmcomp/asmlink.cmi \
- toplevel/opttopdirs.cmi
-toplevel/opttopdirs.cmx : \
- utils/warnings.cmx \
- typing/types.cmx \
- typing/printtyp.cmx \
- toplevel/opttoploop.cmx \
- utils/misc.cmx \
- parsing/longident.cmx \
- utils/load_path.cmx \
- typing/ident.cmx \
- typing/env.cmx \
- typing/ctype.cmx \
- utils/config.cmx \
- driver/compenv.cmx \
- utils/clflags.cmx \
- asmcomp/asmlink.cmx \
- toplevel/opttopdirs.cmi
-toplevel/opttopdirs.cmi : \
- parsing/longident.cmi
-toplevel/opttoploop.cmo : \
- utils/warnings.cmi \
- typing/types.cmi \
- typing/typemod.cmi \
- typing/typedtree.cmi \
- typing/typecore.cmi \
- lambda/translmod.cmi \
- lambda/simplif.cmi \
- asmcomp/proc.cmi \
- typing/printtyped.cmi \
- typing/printtyp.cmi \
- lambda/printlambda.cmi \
+toplevel/topcommon.cmo : \
parsing/printast.cmi \
typing/predef.cmi \
parsing/pprintast.cmi \
parsing/location.cmi \
utils/load_path.cmi \
parsing/lexer.cmi \
- lambda/lambda.cmi \
- typing/includemod.cmi \
- middle_end/flambda/import_approx.cmi \
typing/ident.cmi \
toplevel/genprintval.cmi \
- middle_end/flambda/flambda_middle_end.cmi \
typing/env.cmi \
+ bytecomp/dll.cmi \
utils/config.cmi \
driver/compmisc.cmi \
- middle_end/compilenv.cmi \
driver/compenv.cmi \
- middle_end/closure/closure_middle_end.cmi \
utils/clflags.cmi \
- typing/btype.cmi \
- middle_end/backend_intf.cmi \
- parsing/asttypes.cmi \
parsing/ast_helper.cmi \
- asmcomp/asmlink.cmi \
- asmcomp/asmgen.cmi \
- asmcomp/arch.cmo \
- toplevel/opttoploop.cmi
-toplevel/opttoploop.cmx : \
- utils/warnings.cmx \
- typing/types.cmx \
- typing/typemod.cmx \
- typing/typedtree.cmx \
- typing/typecore.cmx \
- lambda/translmod.cmx \
- lambda/simplif.cmx \
- asmcomp/proc.cmx \
- typing/printtyped.cmx \
- typing/printtyp.cmx \
- lambda/printlambda.cmx \
+ toplevel/topcommon.cmi
+toplevel/topcommon.cmx : \
parsing/printast.cmx \
typing/predef.cmx \
parsing/pprintast.cmx \
parsing/location.cmx \
utils/load_path.cmx \
parsing/lexer.cmx \
- lambda/lambda.cmx \
- typing/includemod.cmx \
- middle_end/flambda/import_approx.cmx \
typing/ident.cmx \
toplevel/genprintval.cmx \
- middle_end/flambda/flambda_middle_end.cmx \
typing/env.cmx \
+ bytecomp/dll.cmx \
utils/config.cmx \
driver/compmisc.cmx \
- middle_end/compilenv.cmx \
driver/compenv.cmx \
- middle_end/closure/closure_middle_end.cmx \
utils/clflags.cmx \
- typing/btype.cmx \
- middle_end/backend_intf.cmi \
- parsing/asttypes.cmi \
parsing/ast_helper.cmx \
- asmcomp/asmlink.cmx \
- asmcomp/asmgen.cmx \
- asmcomp/arch.cmx \
- toplevel/opttoploop.cmi
-toplevel/opttoploop.cmi : \
+ toplevel/topcommon.cmi
+toplevel/topcommon.cmi : \
utils/warnings.cmi \
typing/types.cmi \
typing/path.cmi \
typing/outcometree.cmi \
parsing/longident.cmi \
parsing/location.cmi \
+ typing/ident.cmi \
+ toplevel/genprintval.cmi \
typing/env.cmi
-toplevel/opttopmain.cmo : \
- toplevel/opttoploop.cmi \
- toplevel/opttopdirs.cmi \
- utils/misc.cmi \
- driver/main_args.cmi \
- parsing/location.cmi \
- driver/compmisc.cmi \
- driver/compenv.cmi \
- utils/clflags.cmi \
- toplevel/opttopmain.cmi
-toplevel/opttopmain.cmx : \
- toplevel/opttoploop.cmx \
- toplevel/opttopdirs.cmx \
- utils/misc.cmx \
- driver/main_args.cmx \
- parsing/location.cmx \
- driver/compmisc.cmx \
- driver/compenv.cmx \
- utils/clflags.cmx \
- toplevel/opttopmain.cmi
-toplevel/opttopmain.cmi :
-toplevel/opttopstart.cmo : \
- toplevel/opttopmain.cmi
-toplevel/opttopstart.cmx : \
- toplevel/opttopmain.cmx
toplevel/topdirs.cmo : \
utils/warnings.cmi \
typing/types.cmi \
- toplevel/trace.cmi \
toplevel/toploop.cmi \
- bytecomp/symtable.cmi \
+ toplevel/topeval.cmi \
typing/printtyp.cmi \
typing/predef.cmi \
- typing/persistent_env.cmi \
typing/path.cmi \
parsing/parsetree.cmi \
- bytecomp/opcodes.cmi \
utils/misc.cmi \
- bytecomp/meta.cmi \
parsing/longident.cmi \
parsing/location.cmi \
utils/load_path.cmi \
typing/ctype.cmi \
utils/config.cmi \
driver/compenv.cmi \
- file_formats/cmo_format.cmi \
utils/clflags.cmi \
typing/btype.cmi \
parsing/asttypes.cmi \
toplevel/topdirs.cmx : \
utils/warnings.cmx \
typing/types.cmx \
- toplevel/trace.cmx \
toplevel/toploop.cmx \
- bytecomp/symtable.cmx \
+ toplevel/topeval.cmi \
typing/printtyp.cmx \
typing/predef.cmx \
- typing/persistent_env.cmx \
typing/path.cmx \
parsing/parsetree.cmi \
- bytecomp/opcodes.cmx \
utils/misc.cmx \
- bytecomp/meta.cmx \
parsing/longident.cmx \
parsing/location.cmx \
utils/load_path.cmx \
typing/ctype.cmx \
utils/config.cmx \
driver/compenv.cmx \
- file_formats/cmo_format.cmi \
utils/clflags.cmx \
typing/btype.cmx \
parsing/asttypes.cmi \
toplevel/topdirs.cmi
toplevel/topdirs.cmi : \
parsing/longident.cmi
+toplevel/topeval.cmi : \
+ toplevel/topcommon.cmi \
+ parsing/parsetree.cmi
toplevel/toploop.cmo : \
utils/warnings.cmi \
typing/typetexp.cmi \
+ toplevel/topeval.cmi \
+ toplevel/topcommon.cmi \
+ utils/misc.cmi \
+ parsing/location.cmi \
+ utils/load_path.cmi \
+ parsing/lexer.cmi \
+ typing/env.cmi \
+ utils/config.cmi \
+ driver/compmisc.cmi \
+ driver/compenv.cmi \
+ utils/clflags.cmi \
+ typing/btype.cmi \
+ toplevel/toploop.cmi
+toplevel/toploop.cmx : \
+ utils/warnings.cmx \
+ typing/typetexp.cmx \
+ toplevel/topeval.cmi \
+ toplevel/topcommon.cmx \
+ utils/misc.cmx \
+ parsing/location.cmx \
+ utils/load_path.cmx \
+ parsing/lexer.cmx \
+ typing/env.cmx \
+ utils/config.cmx \
+ driver/compmisc.cmx \
+ driver/compenv.cmx \
+ utils/clflags.cmx \
+ typing/btype.cmx \
+ toplevel/toploop.cmi
+toplevel/toploop.cmi : \
+ utils/warnings.cmi \
+ typing/types.cmi \
+ typing/path.cmi \
+ parsing/parsetree.cmi \
+ typing/outcometree.cmi \
+ parsing/longident.cmi \
+ parsing/location.cmi \
+ typing/env.cmi
+toplevel/topmain.cmi :
+toplevel/topstart.cmo : \
+ toplevel/topmain.cmi
+toplevel/topstart.cmx : \
+ toplevel/topmain.cmi
+toplevel/trace.cmi : \
+ typing/types.cmi \
+ typing/path.cmi \
+ parsing/longident.cmi \
+ typing/env.cmi
+toplevel/byte/topeval.cmo : \
+ utils/warnings.cmi \
typing/types.cmi \
typing/typemod.cmi \
typing/typedtree.cmi \
typing/typecore.cmi \
lambda/translmod.cmi \
+ toplevel/topcommon.cmi \
bytecomp/symtable.cmi \
lambda/simplif.cmi \
typing/printtyped.cmi \
typing/printtyp.cmi \
lambda/printlambda.cmi \
bytecomp/printinstr.cmi \
- parsing/printast.cmi \
typing/predef.cmi \
- parsing/pprintast.cmi \
- driver/pparse.cmi \
- typing/path.cmi \
+ typing/persistent_env.cmi \
parsing/parsetree.cmi \
- parsing/parse.cmi \
typing/outcometree.cmi \
- typing/oprint.cmi \
+ bytecomp/opcodes.cmi \
utils/misc.cmi \
bytecomp/meta.cmi \
- parsing/longident.cmi \
parsing/location.cmi \
utils/load_path.cmi \
- parsing/lexer.cmi \
typing/includemod.cmi \
typing/ident.cmi \
- toplevel/genprintval.cmi \
typing/env.cmi \
bytecomp/emitcode.cmi \
bytecomp/dll.cmi \
utils/config.cmi \
driver/compmisc.cmi \
- driver/compenv.cmi \
+ file_formats/cmo_format.cmi \
utils/clflags.cmi \
bytecomp/bytegen.cmi \
- typing/btype.cmi \
parsing/asttypes.cmi \
- parsing/ast_helper.cmi \
- toplevel/toploop.cmi
-toplevel/toploop.cmx : \
+ toplevel/byte/topeval.cmi
+toplevel/byte/topeval.cmx : \
utils/warnings.cmx \
- typing/typetexp.cmx \
typing/types.cmx \
typing/typemod.cmx \
typing/typedtree.cmx \
typing/typecore.cmx \
lambda/translmod.cmx \
+ toplevel/topcommon.cmx \
bytecomp/symtable.cmx \
lambda/simplif.cmx \
typing/printtyped.cmx \
typing/printtyp.cmx \
lambda/printlambda.cmx \
bytecomp/printinstr.cmx \
- parsing/printast.cmx \
typing/predef.cmx \
- parsing/pprintast.cmx \
- driver/pparse.cmx \
- typing/path.cmx \
+ typing/persistent_env.cmx \
parsing/parsetree.cmi \
- parsing/parse.cmx \
typing/outcometree.cmi \
- typing/oprint.cmx \
+ bytecomp/opcodes.cmx \
utils/misc.cmx \
bytecomp/meta.cmx \
- parsing/longident.cmx \
parsing/location.cmx \
utils/load_path.cmx \
- parsing/lexer.cmx \
typing/includemod.cmx \
typing/ident.cmx \
- toplevel/genprintval.cmx \
typing/env.cmx \
bytecomp/emitcode.cmx \
bytecomp/dll.cmx \
utils/config.cmx \
driver/compmisc.cmx \
- driver/compenv.cmx \
+ file_formats/cmo_format.cmi \
utils/clflags.cmx \
bytecomp/bytegen.cmx \
- typing/btype.cmx \
parsing/asttypes.cmi \
- parsing/ast_helper.cmx \
- toplevel/toploop.cmi
-toplevel/toploop.cmi : \
- utils/warnings.cmi \
- typing/types.cmi \
- typing/path.cmi \
- parsing/parsetree.cmi \
- typing/outcometree.cmi \
- parsing/longident.cmi \
- parsing/location.cmi \
- typing/env.cmi
-toplevel/topmain.cmo : \
+ toplevel/byte/topeval.cmi
+toplevel/byte/topeval.cmi : \
+ toplevel/topcommon.cmi \
+ parsing/parsetree.cmi
+toplevel/byte/topmain.cmo : \
+ toplevel/byte/trace.cmi \
toplevel/toploop.cmi \
+ toplevel/byte/topeval.cmi \
toplevel/topdirs.cmi \
+ toplevel/topcommon.cmi \
+ typing/printtyp.cmi \
+ typing/path.cmi \
utils/misc.cmi \
driver/main_args.cmi \
parsing/location.cmi \
+ typing/env.cmi \
+ typing/ctype.cmi \
driver/compmisc.cmi \
driver/compenv.cmi \
utils/clflags.cmi \
- toplevel/topmain.cmi
-toplevel/topmain.cmx : \
+ toplevel/byte/topmain.cmi
+toplevel/byte/topmain.cmx : \
+ toplevel/byte/trace.cmx \
toplevel/toploop.cmx \
+ toplevel/byte/topeval.cmx \
toplevel/topdirs.cmx \
+ toplevel/topcommon.cmx \
+ typing/printtyp.cmx \
+ typing/path.cmx \
utils/misc.cmx \
driver/main_args.cmx \
parsing/location.cmx \
+ typing/env.cmx \
+ typing/ctype.cmx \
driver/compmisc.cmx \
driver/compenv.cmx \
utils/clflags.cmx \
- toplevel/topmain.cmi
-toplevel/topmain.cmi :
-toplevel/topstart.cmo : \
- toplevel/topmain.cmi
-toplevel/topstart.cmx : \
- toplevel/topmain.cmx
-toplevel/trace.cmo : \
+ toplevel/byte/topmain.cmi
+toplevel/byte/topmain.cmi :
+toplevel/byte/trace.cmo : \
typing/types.cmi \
- toplevel/toploop.cmi \
+ toplevel/byte/topeval.cmi \
+ toplevel/topcommon.cmi \
typing/printtyp.cmi \
typing/predef.cmi \
typing/path.cmi \
parsing/longident.cmi \
typing/ctype.cmi \
parsing/asttypes.cmi \
- toplevel/trace.cmi
-toplevel/trace.cmx : \
+ toplevel/byte/trace.cmi
+toplevel/byte/trace.cmx : \
typing/types.cmx \
- toplevel/toploop.cmx \
+ toplevel/byte/topeval.cmx \
+ toplevel/topcommon.cmx \
typing/printtyp.cmx \
typing/predef.cmx \
typing/path.cmx \
parsing/longident.cmx \
typing/ctype.cmx \
parsing/asttypes.cmi \
- toplevel/trace.cmi
-toplevel/trace.cmi : \
+ toplevel/byte/trace.cmi
+toplevel/byte/trace.cmi : \
+ typing/types.cmi \
+ typing/path.cmi \
+ parsing/longident.cmi \
+ typing/env.cmi
+toplevel/native/topeval.cmo : \
+ utils/warnings.cmi \
+ typing/types.cmi \
+ typing/typemod.cmi \
+ typing/typedtree.cmi \
+ typing/typecore.cmi \
+ lambda/translmod.cmi \
+ toplevel/topcommon.cmi \
+ lambda/simplif.cmi \
+ asmcomp/proc.cmi \
+ typing/printtyped.cmi \
+ typing/printtyp.cmi \
+ lambda/printlambda.cmi \
+ typing/predef.cmi \
+ parsing/parsetree.cmi \
+ typing/outcometree.cmi \
+ utils/misc.cmi \
+ parsing/location.cmi \
+ utils/load_path.cmi \
+ lambda/lambda.cmi \
+ typing/includemod.cmi \
+ middle_end/flambda/import_approx.cmi \
+ typing/ident.cmi \
+ middle_end/flambda/flambda_middle_end.cmi \
+ typing/env.cmi \
+ utils/config.cmi \
+ driver/compmisc.cmi \
+ middle_end/compilenv.cmi \
+ middle_end/closure/closure_middle_end.cmi \
+ utils/clflags.cmi \
+ middle_end/backend_intf.cmi \
+ parsing/asttypes.cmi \
+ parsing/ast_helper.cmi \
+ asmcomp/asmlink.cmi \
+ asmcomp/asmgen.cmi \
+ asmcomp/arch.cmo \
+ toplevel/native/topeval.cmi
+toplevel/native/topeval.cmx : \
+ utils/warnings.cmx \
+ typing/types.cmx \
+ typing/typemod.cmx \
+ typing/typedtree.cmx \
+ typing/typecore.cmx \
+ lambda/translmod.cmx \
+ toplevel/topcommon.cmx \
+ lambda/simplif.cmx \
+ asmcomp/proc.cmx \
+ typing/printtyped.cmx \
+ typing/printtyp.cmx \
+ lambda/printlambda.cmx \
+ typing/predef.cmx \
+ parsing/parsetree.cmi \
+ typing/outcometree.cmi \
+ utils/misc.cmx \
+ parsing/location.cmx \
+ utils/load_path.cmx \
+ lambda/lambda.cmx \
+ typing/includemod.cmx \
+ middle_end/flambda/import_approx.cmx \
+ typing/ident.cmx \
+ middle_end/flambda/flambda_middle_end.cmx \
+ typing/env.cmx \
+ utils/config.cmx \
+ driver/compmisc.cmx \
+ middle_end/compilenv.cmx \
+ middle_end/closure/closure_middle_end.cmx \
+ utils/clflags.cmx \
+ middle_end/backend_intf.cmi \
+ parsing/asttypes.cmi \
+ parsing/ast_helper.cmx \
+ asmcomp/asmlink.cmx \
+ asmcomp/asmgen.cmx \
+ asmcomp/arch.cmx \
+ toplevel/native/topeval.cmi
+toplevel/native/topeval.cmi : \
+ toplevel/topcommon.cmi \
+ parsing/parsetree.cmi
+toplevel/native/topmain.cmo : \
+ toplevel/toploop.cmi \
+ toplevel/native/topeval.cmi \
+ toplevel/topcommon.cmi \
+ utils/misc.cmi \
+ driver/main_args.cmi \
+ parsing/location.cmi \
+ driver/compmisc.cmi \
+ driver/compenv.cmi \
+ utils/clflags.cmi \
+ toplevel/native/topmain.cmi
+toplevel/native/topmain.cmx : \
+ toplevel/toploop.cmx \
+ toplevel/native/topeval.cmx \
+ toplevel/topcommon.cmx \
+ utils/misc.cmx \
+ driver/main_args.cmx \
+ parsing/location.cmx \
+ driver/compmisc.cmx \
+ driver/compenv.cmx \
+ utils/clflags.cmx \
+ toplevel/native/topmain.cmi
+toplevel/native/topmain.cmi :
+toplevel/native/trace.cmo : \
+ typing/path.cmi \
+ toplevel/native/trace.cmi
+toplevel/native/trace.cmx : \
+ typing/path.cmx \
+ toplevel/native/trace.cmi
+toplevel/native/trace.cmi : \
typing/types.cmi \
typing/path.cmi \
parsing/longident.cmi \
*.md typo.missing-header
README* typo.missing-header
*.adoc typo.missing-header
-stdlib/*.mld typo.missing-header
+api_docgen/*.mld typo.missing-header
+api_docgen/alldoc.tex typo.missing-header
tools/mantis2gh_stripped.csv typo.missing-header
*.adoc typo.long-line=may
# tools/ci/appveyor/appveyor_build.cmd only has missing-header because
# dra27 too lazy to update check-typo to interpret Cmd-style comments!
/tools/ci/appveyor/appveyor_build.cmd typo.very-long-line typo.missing-header typo.non-ascii
-/tools/ci/appveyor/appveyor_build.sh typo.non-ascii
/tools/ci/inria/bootstrap/remove-sinh-primitive.patch typo.prune
/release-info/howto.md typo.missing-header typo.long-line
/release-info/templates/*.md typo.missing-header typo.very-long-line=may
/.depend.menhir typo.prune
# Makefiles may contain tabs
-Makefile* typo.tab=may
+Makefile* typo.makefile-whitespace=may
asmcomp/*/emit.mlp typo.tab=may typo.long-line=may
otherlibs/win32unix/stat.c typo.long-line
otherlibs/win32unix/symlink.c typo.long-line
+runtime/sak.c typo.non-ascii
+
stdlib/hashbang typo.white-at-eol typo.missing-lf
testsuite/tests/** typo.missing-header typo.long-line=may
testsuite/tests/tool-toplevel/strings.ml typo.utf8
testsuite/tests/win-unicode/*.ml typo.utf8
testsuite/tests/asmgen/immediates.cmm typo.very-long-line
+testsuite/tests/generated-parse-errors/errors.* typo.very-long-line
testsuite/tools/*.S typo.missing-header
testsuite/tools/*.asm typo.missing-header
testsuite/typing typo.missing-header
/tools/ci/appveyor/appveyor_build.cmd text eol=crlf
+aclocal.m4 typo.tab
configure.ac text eol=lf
build-aux/compile text eol=lf
build-aux/config.guess text eol=lf
tools/autogen text eol=lf
tools/ci/inria/remove-sinh-primitive.patch text eol=lf
tools/check-typo text eol=lf
+tools/check-symbol-names text eol=lf
tools/ci-build text eol=lf
tools/msvs-promote-path text eol=lf
tools/gdb-macros text eol=lf
tools/make-opcodes text eol=lf
tools/make-package-macosx text eol=lf
tools/ocaml-objcopy-macosx text eol=lf
-tools/ocamlmktop.tpl text eol=lf
tools/ocamlsize text eol=lf
tools/pre-commit-githook text eol=lf
tools/markdown-add-pr-links.sh text eol=lf
# Tests which include references spanning multiple lines fail with \r\n
# endings, so use \n endings only, even on Windows.
+testsuite/tests/backtrace/names.ml text eol=lf
testsuite/tests/basic-modules/anonymous.ml text eol=lf
-testsuite/tests/basic-more/morematch.ml text eol=lf
-testsuite/tests/basic-more/robustmatch.ml text eol=lf
-testsuite/tests/parsing/*.ml text eol=lf
-testsuite/tests/docstrings/empty.ml text eol=lf
+testsuite/tests/formatting/test_locations.ml text eol=lf
testsuite/tests/functors/functors.ml text eol=lf
+testsuite/tests/lib-dynlink-initializers/test10_main.ml text eol=lf
+testsuite/tests/parsing/attributes.ml text eol=lf
+testsuite/tests/parsing/extensions.ml text eol=lf
+testsuite/tests/parsing/hash_ambiguity.ml text eol=lf
+testsuite/tests/parsing/int_and_float_with_modifier.ml text eol=lf
+testsuite/tests/parsing/pr6865.ml text eol=lf
+testsuite/tests/parsing/quotedextensions.ml text eol=lf
+testsuite/tests/parsing/shortcut_ext_attr.ml text eol=lf
testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_impl.ml text eol=lf
testsuite/tests/tool-ocamlc-stop-after/stop_after_parsing_intf.mli text eol=lf
testsuite/tests/tool-ocamlc-stop-after/stop_after_typing_impl.ml text eol=lf
-testsuite/tests/tool-toplevel/error_highlighting.ml text eol=lf
-testsuite/tests/tool-toplevel/error_highlighting_use4.ml text eol=lf
testsuite/tests/translprim/module_coercion.ml text eol=lf
-testsuite/tests/typing-objects-bugs/pr3968_bad.ml text eol=lf
-testsuite/tests/typing-ocamlc-i/pr7402.ml text eol=lf
-testsuite/tests/typing-ocamlc-i/pervasives_leitmotiv.ml text eol=lf
-testsuite/tests/typing-recmod/t12bad.ml text eol=lf
-testsuite/tests/typing-safe-linking/b_bad.ml text eol=lf
-testsuite/tests/warnings/w04.ml text eol=lf
-testsuite/tests/warnings/w04_failure.ml text eol=lf
-testsuite/tests/warnings/w32.ml text eol=lf
-
-# These are forced to \n to allow the Cygwin testsuite to pass on a
+
+# This is forced to \n to allow the Cygwin testsuite to pass on a
# Windows-checkout
-testsuite/tests/formatting/margins.ml text eol=lf
-testsuite/tests/letrec-check/pr7706.ml text eol=lf
-testsuite/tests/letrec-disallowed/disallowed.ml text eol=lf
-testsuite/tests/letrec-disallowed/extension_constructor.ml text eol=lf
-testsuite/tests/letrec-disallowed/float_block_allowed.ml text eol=lf
-testsuite/tests/letrec-disallowed/float_block_disallowed.ml text eol=lf
-testsuite/tests/letrec-disallowed/generic_arrays.ml text eol=lf
-testsuite/tests/letrec-disallowed/lazy_.ml text eol=lf
-testsuite/tests/letrec-disallowed/module_constraints.ml text eol=lf
-testsuite/tests/letrec-disallowed/unboxed.ml text eol=lf
-testsuite/tests/letrec-disallowed/pr7215.ml text eol=lf
-testsuite/tests/letrec-disallowed/pr7231.ml text eol=lf
-testsuite/tests/letrec-disallowed/pr7706.ml text eol=lf
-testsuite/tests/lexing/uchar_esc.ml text eol=lf
-testsuite/tests/match-exception-warnings/exhaustiveness_warnings.ml text eol=lf
-testsuite/tests/tool-toplevel/pr7060.ml text eol=lf
-testsuite/tests/typing-extension-constructor/test.ml text eol=lf
-testsuite/tests/typing-extensions/extensions.ml text eol=lf
-testsuite/tests/typing-extensions/open_types.ml text eol=lf
-testsuite/tests/typing-objects/Exemples.ml text eol=lf
-testsuite/tests/typing-objects/pr5619_bad.ml text eol=lf
-testsuite/tests/typing-objects/pr6123_bad.ml text eol=lf
-testsuite/tests/typing-objects/pr6907_bad.ml text eol=lf
-testsuite/tests/typing-objects/Tests.ml text eol=lf
-testsuite/tests/typing-pattern_open/pattern_open.ml text eol=lf
-testsuite/tests/typing-private/private.ml text eol=lf
-testsuite/tests/typing-recordarg/recordarg.ml text eol=lf
-testsuite/tests/typing-short-paths/pr5918.ml text eol=lf
-testsuite/tests/typing-sigsubst/sigsubst.ml text eol=lf
-testsuite/tests/typing-typeparam/newtype.ml text eol=lf
-testsuite/tests/typing-unboxed/test.ml text eol=lf
-testsuite/tests/typing-unboxed-types/test.ml text eol=lf
-testsuite/tests/typing-unboxed-types/test_flat.ml text eol=lf
-testsuite/tests/typing-unboxed-types/test_no_flat.ml text eol=lf
-testsuite/tests/typing-warnings/ambiguous_guarded_disjunction.ml text eol=lf
-testsuite/tests/typing-warnings/application.ml text eol=lf
-testsuite/tests/typing-warnings/coercions.ml text eol=lf
-testsuite/tests/typing-warnings/exhaustiveness.ml text eol=lf
-testsuite/tests/typing-warnings/pr6587.ml text eol=lf
-testsuite/tests/typing-warnings/pr6872.ml text eol=lf
-testsuite/tests/typing-warnings/pr7085.ml text eol=lf
-testsuite/tests/typing-warnings/pr7115.ml text eol=lf
-testsuite/tests/typing-warnings/pr7261.ml text eol=lf
-testsuite/tests/typing-warnings/pr7297.ml text eol=lf
-testsuite/tests/typing-warnings/pr7553.ml text eol=lf
-testsuite/tests/typing-warnings/records.ml text eol=lf
-testsuite/tests/typing-warnings/unused_types.ml text eol=lf
+testsuite/tests/parsetree/locations_test.ml text eol=lf
--- /dev/null
+name: Build
+
+on: [push, pull_request]
+
+jobs:
+ no-naked-pointers:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: configure tree
+ run: ./configure --disable-naked-pointers --disable-stdlib-manpages --disable-dependency-generation --enable-ocamltest
+ - name: Build
+ run: |
+ make -j world.opt
+ - name: Run the testsuite
+ run: |
+ make -C testsuite USE_RUNTIME=d all
+ i386-static:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ - name: Packages
+ run: |
+ sudo apt-get update -y && sudo apt-get install -y gcc-multilib gfortran-multilib
+ - name: configure tree
+ run: |
+ XARCH=i386 CONFIG_ARG='--disable-stdlib-manpages --disable-shared --enable-cmm-invariants' bash -xe tools/ci/actions/runner.sh configure
+ - name: Build
+ run: |
+ bash -xe tools/ci/actions/runner.sh build
+ - name: Run the testsuite
+ run: |
+ bash -xe tools/ci/actions/runner.sh test
+ - name: Install
+ run: |
+ bash -xe tools/ci/actions/runner.sh install
+ - name: Other checks
+ run: |
+ bash -xe tools/ci/actions/runner.sh other-checks
+ full-flambda:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout
+ uses: actions/checkout@v2
+ with:
+ fetch-depth: 50
+ - name: Packages
+ run: |
+ sudo apt-get update -y && sudo apt-get install -y texlive-latex-extra texlive-fonts-recommended hevea sass
+ # Ensure that make distclean can be run from an empty tree
+ - name: distclean
+ run: |
+ MAKE_ARG=-j make distclean
+ - name: configure tree
+ run: |
+ MAKE_ARG=-j XARCH=x64 CONFIG_ARG='--enable-flambda --enable-cmm-invariants --enable-dependency-generation' OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh configure
+ - name: Build
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh build
+ - name: Run the testsuite
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh test
+ - name: Build API Documentation
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh api-docs
+ - name: Install
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh install
+ - name: Check for manual changes
+ id: manual
+ run: >-
+ tools/ci/actions/check-manual-modified.sh
+ '${{ github.ref }}'
+ '${{ github.event_name }}'
+ '${{ github.event.pull_request.base.ref }}'
+ '${{ github.event.pull_request.base.sha }}'
+ '${{ github.event.pull_request.head.ref }}'
+ '${{ github.event.pull_request.head.sha }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.before }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.after }}'
+ '${{ github.event.repository.full_name }}'
+ - name: Build the manual
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh manual
+ # Temporarily disabled 23-Apr-2021 while Dune isn't building
+ if: steps.manual.outputs.changed == 'disabled'
+ - name: Other checks
+ run: |
+ MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh other-checks
--- /dev/null
+name: Hygiene
+on:
+ push:
+ pull_request:
+ types: [opened, synchronize, reopened, labeled, unlabeled]
+
+jobs:
+ hygiene:
+ name: Checks
+ runs-on: ubuntu-latest
+ steps:
+ - name: GitHub Context
+ run: echo $GITHUB_CONTEXT
+ env:
+ GITHUB_CONTEXT: ${{ toJson(github) }}
+ # Comment out the line below to enable (debugging) display of the github
+ # context variable.
+ if: failure()
+
+ - uses: actions/checkout@v2
+ with:
+ fetch-depth: 50
+
+ - name: Changes updated
+ run: >-
+ tools/ci/actions/check-changes-modified.sh
+ '${{ github.ref }}'
+ 'pull_request'
+ '${{ github.event.pull_request.base.ref }}'
+ '${{ github.event.pull_request.base.sha }}'
+ '${{ github.event.pull_request.head.ref }}'
+ '${{ github.event.pull_request.head.sha }}'
+ if: >-
+ !contains(github.event.pull_request.labels.*.name, 'no-change-entry-needed')
+ && github.event_name == 'pull_request'
+
+ - name: configure correctly generated
+ run: >-
+ tools/ci/actions/check-configure.sh
+ '${{ github.ref }}'
+ '${{ github.event_name }}'
+ '${{ github.event.pull_request.base.ref }}'
+ '${{ github.event.pull_request.base.sha }}'
+ '${{ github.event.pull_request.head.ref }}'
+ '${{ github.event.pull_request.head.sha }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.before }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.after }}'
+ if: ${{ always() }}
+
+ - name: check-typo revered
+ run: >-
+ tools/ci/actions/check-typo.sh
+ '${{ github.ref }}'
+ '${{ github.event_name }}'
+ '${{ github.event.pull_request.base.ref }}'
+ '${{ github.event.pull_request.base.sha }}'
+ '${{ github.event.pull_request.head.ref }}'
+ '${{ github.event.pull_request.head.sha }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.before }}'
+ '${{ github.event.ref }}'
+ '${{ github.event.after }}'
+ if: ${{ always() }}
+
+ - name: check-typo on whole tree
+ run: tools/check-typo
+ if: >-
+ github.event_name == 'push'
+ && (startsWith(github.event.ref, 'refs/heads/4.')
+ || github.event.ref == 'refs/heads/trunk')
+ && always()
+
+ - name: Check that labelled/unlabelled .mli files are in sync
+ run: tools/ci/actions/check-labelled-interfaces.sh
+ if: always()
+
+ # This step records the build success in the variable build-status,
+ # allowing the last two steps to skip, rather than go beserk with a
+ # faulty compiler.
+ - name: Build a minimal compiler for alldepend
+ id: compiler
+ run: tools/ci/actions/runner.sh basic-compiler
+ if: always()
+
+ - name: Check that dependency info is up-to-date
+ run: tools/ci/actions/check-alldepend.sh
+ if: steps.compiler.outputs.build-status == 'success' && always()
+
+ - name: Check global structure of the reference manual
+ run: |
+ # Required configuration info is left-over from the previous step
+ make -C manual/tests check-stdlib check-case-collision
+ if: steps.compiler.outputs.build-status == 'success' && always()
+++ /dev/null
-name: main
-
-on: [push, pull_request]
-
-jobs:
- no-naked-pointers:
- runs-on: ubuntu-latest
- steps:
- - name: Checkout
- uses: actions/checkout@v2
- - name: configure tree
- run: ./configure --disable-naked-pointers --disable-stdlib-manpages --disable-dependency-generation --enable-ocamltest
- - name: Build
- run: |
- make -j world.opt
- - name: Run the testsuite
- run: |
- make -C testsuite USE_RUNTIME=d all
- i386-static:
- runs-on: ubuntu-latest
- steps:
- - name: Checkout
- uses: actions/checkout@v2
- - name: Packages
- run: |
- sudo apt-get update -y && sudo apt-get install -y gcc-multilib gfortran-multilib
- - name: configure tree
- run: |
- XARCH=i386 CONFIG_ARG='--disable-stdlib-manpages --disable-shared' bash -xe tools/ci/actions/runner.sh configure
- - name: Build
- run: |
- bash -xe tools/ci/actions/runner.sh build
- - name: Run the testsuite
- run: |
- bash -xe tools/ci/actions/runner.sh test
- - name: Install
- run: |
- bash -xe tools/ci/actions/runner.sh install
- - name: Other checks
- run: |
- bash -xe tools/ci/actions/runner.sh other-checks
- full-flambda:
- runs-on: ubuntu-latest
- steps:
- - name: Checkout
- uses: actions/checkout@v2
- - name: Packages
- run: |
- sudo apt-get update -y && sudo apt-get install -y texlive-latex-extra texlive-fonts-recommended
- # Ensure that make distclean can be run from an empty tree
- - name: distclean
- run: |
- MAKE_ARG=-j make distclean
- - name: configure tree
- run: |
- MAKE_ARG=-j XARCH=x64 CONFIG_ARG='--enable-flambda --enable-dependency-generation' OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh configure
- - name: Build
- run: |
- MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh build
- - name: Run the testsuite
- run: |
- MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh test
- - name: Build API Documentation
- run: |
- MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh api-docs
- - name: Install
- run: |
- MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh install
- - name: Other checks
- run: |
- MAKE_ARG=-j OCAMLRUNPARAM=b,v=0 bash -xe tools/ci/actions/runner.sh other-checks
/ocaml-*.cache
/config.log
/config.status
+/flexlink.opt
/libtool
/ocamlc.opt
/expunge
/asmcomp/CSE.ml
/boot/ocamlrun
+/boot/ocamlruns
/boot/camlheader
/boot/ocamlc.opt
+/boot/flexlink.byte
/bytecomp/opcodes.ml
/bytecomp/opcodes.mli
/emacs/ocamltags
/emacs/*.elc
+/flexdll-sources
+
/lambda/runtimedef.ml
/lex/parser.ml
/lex/ocamllex.opt
/lex/parser.output
-/manual/manual/cmds/warnings-help.etex
-/manual/manual/warnings-help.etex
+/manual/src/cmds/warnings-help.etex
+/manual/src/warnings-help.etex
+
+/api_docgen/build
+/api_docgen/odoc/build
+/api_docgen/ocamldoc/build
/ocamldoc/ocamldoc
/ocamldoc/ocamldoc.opt
/ocamldoc/odoc_text_lexer.ml
/ocamldoc/odoc_text_parser.ml
/ocamldoc/odoc_text_parser.mli
-/ocamldoc/stdlib_man
-/ocamldoc/stdlib_html
-/ocamldoc/stdlib_latex
-/ocamldoc/stdlib_texi
/ocamldoc/*.output
/ocamldoc/test_stdlib
/ocamldoc/test_latex
/parsing/parser.output
/parsing/parser.automaton
/parsing/parser.conflicts
+/parsing/parser.auto.messages
/parsing/camlinternalMenhirLib.ml
/parsing/camlinternalMenhirLib.mli
/runtime/ld.conf
/runtime/.gdb_history
/runtime/.dep
+/runtime/build_config.h
+/runtime/sak
/runtime/domain_state32.inc
/runtime/domain_state64.inc
/tools/keywords
/tools/ocamlmklib
/tools/ocamlmklib.opt
-/tools/ocamlmklibconfig.ml
/tools/ocamlcmt
/tools/ocamlcmt.opt
/tools/cmpbyt
/tools/caml-tex
/tools/eventlog_metadata
+/toplevel/byte/topeval.mli
+/toplevel/byte/trace.mli
+/toplevel/byte/topmain.mli
+/toplevel/native/topeval.mli
+/toplevel/native/trace.mli
+/toplevel/native/topmain.mli
+
/utils/config.ml
/utils/domainstate.ml
/utils/domainstate.mli
Damien Doligez <damien.doligez@inria.fr> Some Name <some@name.com>
Damien Doligez <damien.doligez@inria.fr> doligez <damien.doligez@inria.fr>
Mohamed Iguernelala <mohamed.iguernelala@gmail.com>
-Jérémie Dimino <jdimino@janestreet.com>
+Jérémie Dimino <jeremie@dimino.org>
+Jérémie Dimino <jeremie@dimino.org> <jdimino@janestreet.com>
Jeremy Yallop <yallop@gmail.com> yallop <yallop@gmail.com>
Nicolás Ojeda Bär <n.oje.bar@gmail.com>
-
+Nicolás Ojeda Bär <n.oje.bar@gmail.com> <nicolas.ojeda.bar@lexifi.com>
+François Pottier <francois.pottier@inria.fr>
+Jérôme Vouillon <Jerome.Vouillon@pps.jussieu.fr>
+Frédéric Bour <frederic.bour@lakaban.net>
+Frédéric Bour <frederic.bour@lakaban.net> <def@fb.com>
+Armaël Guéneau <Armael@users.noreply.github.com>
+Armaël Guéneau <Armael@users.noreply.github.com> <armael.gueneau@ens-lyon.fr>
+Armaël Guéneau <Armael@users.noreply.github.com> <armael@isomorphis.me>
+Edwin Török <edwin@etorok.net>
+Edwin Török <edwin@etorok.net> <edvin.torok@citrix.com>
+Edwin Török <edwin@etorok.net> <edwintorok@users.noreply.github.com>
### Approved Approvers
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Anil Madhavapeddy, OCaml Labs *
-#* *
-#* Copyright 2014 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-dist: bionic
-language: c
-git:
- submodules: false
-script: tools/ci/travis/travis-ci.sh
-matrix:
- include:
- - env: CI_KIND=check-depend
- - env: CI_KIND=changes
- - env: CI_KIND=manual
- - env: CI_KIND=check-typo
-
-notifications:
- email:
- - ocaml-ci-notifications@inria.fr
safer. Similarly, `make world.opt` will also bring you to such a stable
state but builds more things than actually required.)
-4. Now, and only now, edit the sources. Changes here may include adding,
- removing or renaming a primitive in the runtime, changing the magic
+4. Now, and only now, edit the sources. Changes here may include removing
+ or renaming a primitive in the runtime, changing the magic
number of bytecode executable files, changing the way types are
represented or anything else in the format of .cmi files, etc.
make bootstrap
+= Problems
+
If you notice that this procedure fails for a given change you are
trying to implement, please report it so that the procedure can be
updated to also cope with your change.
+= Upstreaming
+
If you want to upstream your changes, indicate in the message of the
commit that the changes need a bootstrap. Perform the bootstrap and
commit the result of the bootstrap separately, after that commit.
+
+= Adding, removing and renaming primitives
+
+Primitives can be added without having to bootstrap, however it is necessary
+to repeat `make coldstart` in order to use your new primitive in the standard
+library.
+
+There are five steps to renaming a primitive:
+
+1. Rename the primitive and its uses
+
+2. Create a temporary stub with the old primitive's name. This stub simply
+ passes its arguments on to the new primitive:
+
+ CAMLprim value caml_old_primitive(value a1, value a2) {
+ return caml_new_primitive(a1, a2);
+ }
+
+3. Deal with the addition of the new primitive:
+
+ make coldstart
+
+4. Ensure the system still works:
+
+ make coreall
+
+5. Now remove the old primitive stub and issue:
+
+ make bootstrap
+
+It is desirable for bootstraps to be easily repeatable, so you should commit
+changes after step 4.
+
+= Bootstrap test script
+
+A script is provided (and used on Inria's continuous
+integration infrastructure) to make sure the bootstrap works. This
+script implements the bootstrap procedure described above and performs
+two changes to the compiler: it updates the magic numbers and removes
+a primitive from the runtime. It then makes sure the bootstrap still
+works after these changes. This script can be run locally as follows:
+
+ OCAML_ARCH=linux ./tools/ci/inria/bootstrap
You should not leave trailing whitespace; not have line longer than 80
columns, not use tab characters (spaces only), and not use non-ASCII
characters. These typographical rules can be checked with the script
-`tools/check-typo`.
-
-If you are working from a Git clone, you can automate this process by
-copying the file `tools/pre-commit-githook` to `.git/hooks/pre-commit`.
+`tools/check-typo`, see [HACKING.adoc: check-typo](HACKING.adoc#check-typo).
Otherwise, there are no strongly enforced guidelines specific to the
compiler -- and, as a result, the style may differ in the different
## Contributing to the standard library
-Contributions to the standard library are very welcome. There is some
-widespread belief in the community than the stdlib is somehow "frozen"
-and that its evolutions are mostly driven by the need of the OCaml
-compiler itself. Let's be clear: this is just plain wrong. The
-compiler is happy with its own local utility functions, and many
-recent additions to the stdlib are not used by the compiler.
-
-Another common and wrong idea is that core OCaml maintainers don't
-really care about the standard library. This is not true, and won't
-be unless one of the "alternative standard" libraries really gains
-enough "market share" in the community.
-
-So: please contribute!
-
-Obviously, the proposals to evolve the standard library will be
-evaluated with very high standards, similar to those applied to the
-evolution of the surface langage, and much higher than those for
-internal compiler changes (optimizations, etc).
-
-A key property of the standard library is its stability. Backward
-compatibility is not an absolute technical requirement (any addition
-to/of a module can break existing code, formally), but breakage should
-be limited as much as possible (and assessed, when relevant). A
-corollary is that any addition creates a long-term support commitment.
-For instance, once a concrete type or function is made public,
-changing the exposed definition cannot be done easily.
-
-There is no plan to extend dramatically the functional domain covered
-by the standard library. For instance, proposals to include support
-for XML, JSON, or network protocols are very likely to be rejected. Such
-domains are better treated by external libraries. Small additions to
-existing modules are much simpler to get in, even more so (but not
-necessarily) when:
-
- - they cannot easily be implemented externally, or when
- - they facilitate communication between independent external
- libraries, or when
- - they fill obvious gaps.
-
-Of course, standard guidelines apply as well: proper documentation,
-proper tests, portability (yes, also Windows!), good justification for
-why the change is desirable and why it should go into stdlib.
-
-So: be prepared for some serious review process! But yes, yes,
-contributions are welcome and appreciated. Promised.
+Contributions to the standard library are very welcome.
+See the dedicated [stdlib/CONTRIBUTING.md](stdlib/CONTRIBUTING.md)
+for more information.
## Contributing optimizations
-OCaml 4.12.1 (24 September 2021)
+OCaml 4.13.0 (24 September 2021)
--------------------------------
-### Bug fixes:
+### Progress towards Multicore:
+
+- #10039: Safepoints
+ Add poll points to native generated code. These are effectively
+ zero-sized allocations and fix some signal and remembered set
+ issues. Also multicore prerequisite.
+ (Sadiq Jaffer, Stephen Dolan, Damien Doligez, Xavier Leroy,
+ Anmol Sahoo, Mark Shinwell, review by Damien Doligez, Xavier Leroy,
+ and Mark Shinwell)
+
+- #9876: do not cache the young_limit GC variable in a processor register.
+ This affects the ARM64, PowerPC and RISC-V ports, making signal handling
+ and minor GC triggers more reliable, at the cost of a small slowdown.
+ (Xavier Leroy, review by Nicolás Ojeda Bär)
+
+### Language features (highlights):
+
+- #9584, #7074: Allow to name existentials in pattern-matching
+ One can now write '(Cstr (type a) (x, y : int * a))' to give a name to
+ existentials freshly introduced by GADT constructors.
+ (Jacques Garrigue, review by Leo White and Gabriel Scherer)
+
+### Compiler user-interface and warnings (highlights):
+
+- #9331: Improve error messages for functor application and functor types.
+ (Florian Angeletti and Gabriel Radanne, review by Leo White)
+
+* #10118, #10140: enable warning 6 [labels-omitted] by default.
+ The following now warns:
+ let f ~x y = ... in f 3 5
+ the callsite (f 3 5) has to be turned into (f ~x:3 5).
+ This prevents mistakes where two arguments of the same types are swapped.
+ (Note: Dune already enables this warning by default.)
+ (Gabriel Scherer, review by Xavier Leroy and Florian Angeletti,
+ report by ygrek)
+
+### Manual and documentation (highlights):
+
+- #10247: Add initial tranche of examples to reference manual.
+ Adds some eighty examples to the reference manual, principally to the
+ expressions and patterns sections.
+ https://ocaml.org/releases/4.13/manual/patterns.html
+ (John Whitington, review by Xavier Leroy, Gabriel Scherer, @Fourchaux, and
+ Florian Angeletti)
+
+- #9987, #9988, #9996, #9997: add an odoc mode for the documentation
+ of the standard library and compiler library
+ (Florian Angeletti, review by David Allsopp, Sébastien Hinderer,
+ and Gabriel Scherer)
+
+### Standard library (highlights):
+
+- #944: Add some missing C99 float operations. `Stdlib` now contains
+ the inverse hyperbolic functions
+ `acosh`, `asinh`, and `atanh`.
+ These functions were also added to module `Stdlib.Float` together with
+ `exp2`, `log2`, `cbrt`, `erf`, and `erfc`.
+ Full support on MSVC requires VS2013+ but emulated versions are
+ still available (for now) for older compilers.
+ (Markus Mottl, review by David Allsopp, Olivier Andrieu, Florian Angeletti,
+ Nicolás Ojeda Bär, Daniel Bünzli, Fabian @copy, Pascal Cuoq, Damien
+ Doligez, Sébastien Hinderer, Jacques-Henri Jourdan, Xavier Leroy, Guillaume
+ Melquiond, Perry E. Metzger, Runhang Li, Gabriel Scherer, Mark Shinwell,
+ Bernhard Schommer and Christophe Troestler)
+
+- #9582: Add Array.{find_opt,find_map,split,combine}.
+ (Nicolás Ojeda Bär, review by Daniel Bünzli and Gabriel Scherer)
+
+- #9533: Added String.starts_with and String.ends_with.
+ (Bernhard Schommer, review by Daniel Bünzli, Gabriel Scherer and
+ Alain Frisch)
+
+### Code generation and optimizations (highlights):
+
+- #10404: Add a generic backward dataflow analyzer and use it to speed up
+ liveness analysis
+ (Xavier Leroy, review by Gabriel Scherer, Greta Yorsh, Mark Shinwell)
+
+- #10414: Avoid compilation times exponential in the nesting of loops
+ in the spilling and reloading passes
+ (Xavier Leroy, review by Vincent Laviron)
+
+### Internal typechecker changes (highlights):
+
+- #10170: Maintain more structural information in type-checking errors
+ A mostly-internal change that preserves more information in errors
+ during type checking; most significantly, it split the errors from
+ unification, moregen, and type equality into three different types.
+ (Antal Spector-Zabusky and Mekhrubon Tuarev, review by Leo White,
+ Florian Angeletti, and Jacques Garrigue)
+
+- #9994: Make Types.type_expr a private type, and abstract marking mechanism
+ (Jacques Garrigue and Takafumi Saikawa,
+ review by Gabriel Scherer and Leo White)
+
+### Runtime system (highlights):
+
+- #10188, #10213: Switch the default allocation policy to best-fit and adjust
+ the default overhead parameter accordingly.
+ (Damien Doligez, review by Josh Berdine and Xavier Leroy)
+
+- #10549: Stack overflow detection and naked pointers checking for ARM64
+ (Xavier Leroy, review by Stephen Dolan)
+
+- #9934: Optimise sweeping using prefetching.
+ (Stephen Dolan and Will Hasenplaugh, review by David Allsopp, Xavier
+ Leroy and Damien Doligez, benchmarking by Shubham Kumar and KC
+ Sivaramakrishnan)
+
+- #10194: Change compaction-triggering heuristic: use the overhead measured
+ by the previous GC cycle instead of an indirect (and noisy) computation
+ of the current overhead.
+ (Damien Doligez, review by Stephen Dolan)
+
+- #10449: Fix major GC work accounting (the GC was running too fast).
+ (Damien Doligez, report by Stephen Dolan, review by Nicolás Ojeda Bär and
+ Sadiq Jaffer)
+
+
+### Language features:
+
+- #10013: Let-punning
+ Allow 'let* x in ...' and 'let%ext x in ...' as shorthand for
+ 'let* x = x in ...' and 'let%ext x = x in ...' respectively.
+ (Stephen Dolan, review by Gabriel Scherer)
+
+- #10133: module type substitutions
+ Allow 'SIG with module type T = F(X).S', 'SIG with module type T := sig end'
+ and their local equivalent `module type T := sig type u end`
+ (Florian Angeletti, review by Gabriel Radanne and Leo White)
+
+### Type system:
+
+* #10081: Typecheck `x |> f` and `f @@ x` as `(f x)`
+ (Alain Frisch, review by Jacques Garrigue, Josh Berdine and Thomas Refis)
+
+### Runtime system:
+
+- #10318: Windows Unicode runtime functions are no longer marked as
+ experimental.
+ (Nicolás Ojeda Bär, review by David Allsopp)
+
+- #9284: Add -config option to display the configuration of ocamlrun on stdout,
+ including the search path for shared stub libraries.
+ (David Allsopp, review by Xavier Leroy)
+
+- #9919: Introduce caml_record_backtraces and update Interfacing with C to
+ refer to it (previous instruction to use caml_record_backtrace primitive was
+ not possible without defining CAML_INTERNALS)
+ (David Allsopp, review by Xavier Leroy)
+
+- #10102: Ignore PROFINFO_WIDTH if WITH_PROFINFO is not defined (technically
+ a breaking change if the configuration system was being abused before).
+ (David Allsopp, review by Xavier Leroy)
- #10107: Ensure modules compiled with -afl-instrument can still link on
platforms without AFL support.
(David Allsopp, review by Xavier Leroy)
+* #10098: Improve command-line parsing in ocamlrun: strictly recognise options,
+ be more informative for `ocamlrun -I` and support `--` for terminating options
+ parsing.
+ (David Allsopp, review by Xavier Leroy)
+
+- #10101: Add -help/--help option to ocamlrun.
+ (David Allsopp, review by Xavier Leroy)
+
+- #10136: Minor clean-ups in runtime/io.c and runtime/caml/io.h
+ (Xavier Leroy, review by David Allsopp and Guillaume Munch-Maccagnoni)
+
+- #10171: Tweak the naked pointers checker so that processes which trigger the
+ alarm always exit with non-zero status (i.e. exit(0) becomes exit(70)).
+ (David Allsopp, review by Xavier Leroy)
+
+- #10212: Simplify and improve the Windows-specific code that connects
+ to the debugger via a socket.
+ (Antonin Décimo, review by Xavier Leroy)
+
+- #10217: Fix a segfault in a corner case of compaction (reported in #9853)
+ (Damien Doligez, report by Sadiq Jaffer, review by Stephen Dolan)
+
+- #10250, #10266: Dynamically allocate alternate signal stacks to
+ accommodate changes in Glibc 2.34.
+ (Xavier Leroy, reports by Tomasz Kłoczko and R.W.M. Jones, review by Anil
+ Madhavapeddy, Stephen Dolan, and Florian Angeletti)
+
+### Code generation and optimizations:
+
+- #1400: Add an optional invariants check on Cmm, which can be activated
+ with the -dcmm-invariants flag
+ (Vincent Laviron, with help from Sebastien Hinderer, review by Stephen Dolan
+ and David Allsopp)
+
+- #9562, #367: Allow CSE of immutable loads across stores
+ (Stephen Dolan, review by Mark Shinwell)
+
+- #9937: improvements in ARM64 code generation (constants, sign extensions)
+ (Xavier Leroy, review by Stephen Dolan)
+
+- #10228: Better code-generation for inlined comparisons
+ (Stephen Dolan, review by Alain Frisch and Xavier Leroy)
+
+- #10244: Optimise Int32.unsigned_to_int
+ (Fabian Hemmer, review by Stephen Dolan and Xavier Leroy)
+
+- #10302, #10303: Fix incorrect instruction selection for string constant loads
+ on ppc.
+ (David Allsopp, review by Stephen Dolan)
+
+- #10349: Fix destroyed_at_c_call on RISC-V
+ (Mark Shinwell, review by Nicolás Ojeda Bär)
+
+- #10419: Add %frame_pointers primitive which is true only in native code with
+ frame pointers mode enabled.
+ (David Allsopp, review by Vincent Laviron and Mark Shinwell)
+
+### Standard library:
+
+- #9448: Add String.{empty,cat} as dual of Bytes.{empty,cat},
+ String.{of,to}_bytes as aliases of Bytes.{to,of}_string,
+ Bytes.split_on_char as dual of String.split_on_char, and binary decoding
+ functions in String to match those in Bytes.
+ (David Allsopp, review by Damien Doligez, Gabriel Scherer and others)
+
+- #9487, #9489: Add Random.full_int which allows 62-bit bounds on 64-bit
+ systems.
+ (David Allsopp, request by Francois Berenger, review by Xavier Leroy and
+ Damien Doligez)
+
+- #9961: Add Array.fold_left_map.
+ (Craig Ferguson, review by Damien Doligez)
+
+- #10097: Lazy.map, Lazy.map_val: ('a -> 'b) -> 'a Lazy.t -> 'b Lazy.t
+ (map f x) is always (lazy (f (force x))), whereas (map_val f x)
+ applies f directly if x is already forced.
+ (Gabriel Scherer, review by Nicolás Ojeda Bär, Alain Frisch, Xavier Leroy,
+ Daniel Bünzli and Stephen Dolan)
+
+- #10242: Added convenience pretty printer for Either.t in the Format module.
+ (Oghenevwogaga Ebresafe, review by Nicolás Ojeda Bär,
+ Gabriel Scherer and Xavier Van de Woestyne)
+
+- #10352: Seq.(concat : 'a t t -> 'a t)
+ Seq.concat_map as an alias to Seq.flat_map,
+ (Gabriel Scherer, review by Ulugbek Abdullaev and Daniel Bünzli
+ and Nicolás Ojeda Bär and Florian Angeletti)
+
+- #882: Add fold_left, fold_right, exists and for_all to String/Bytes
+ (Yotam Barnoy, review by Alain Frisch and Jeremy Yallop)
+
+- #4070, #10398: small optimization of Stdlib.{frexp,modf}.
+ (Markus Mottl, Nicolás Ojeda Bär, review by Gabriel Scherer)
+
+- #10389, #10391, #10392: Add {Int,Int32,Int64,Nativeint}.{min,max}.
+ (Nicolás Ojeda Bär and Alain Frisch, review by Xavier Leroy)
+
+- #10430: Add Format.print_bytes and Format.pp_print_bytes.
+ (Gabriel Radanne, review by Gabriel Scherer and David Allsopp)
+
+### Other libraries:
+
+* #10084: Unix.open_process_args* functions now look up the program in the PATH.
+ This was already the case under Windows, but this is now also done under
+ Unix. Note that previously the program was interpreted relative to the current
+ directory.
+ (Nicolás Ojeda Bär, review by Gabriel Scherer and Xavier Leroy)
+
+- #10047: Add `Unix.realpath`
+ (Daniel Bünzli, review by David Allsopp, Josh Berdine and Gabriel Scherer)
+
+- #10184: Remove expensive debug assertion from dynlink.
+ (Leo White, review by David Allsopp and Xavier Leroy)
+
+- #10185: Consider that IPv6 is always enabled on Windows.
+ (Antonin Décimo, review by David Allsopp and Xavier Leroy)
+
+- #10306: Map WSA error code to Unix errno for sockopt and getsockname
+ functions (Antonin Décimo, review by David Allsopp)
+
+- #10309: Properly return EBADF on error in Unix.descr_of_{in,out}_channel on
+ Win32 and map Windows error correctly in Unix.truncate and Unix.ftruncate on
+ Win32.
+ (David Allsopp, review by Nicolás Ojeda Bär)
+
+### Tools:
+
+- #10139: Adds a -nonavbar option to ocamldoc, to remove confusing
+ 'Up', 'Previous' and 'Next' links
+ (John Whitington, review by David Allsopp)
+
+- #8645, #10363: ocamldoc: escape `<`, `>`, and `&` in html backend.
+ (Florian Angeletti, report by Wim Lewis, review by Gabriel Scherer)
+
+### Manual and documentation:
+
+- #9525, #10402: document that ocamldoc only creates paragraphs
+ at the toplevel of documentation comments
+ (Florian Angeletti, report by Hendrik Tews, review by Gabriel Scherer)
+
+- #10206: Split labels and polymorphic variants tutorials in two.
+ Moves the GADTs tutorial from the Language Extensions chapter
+ to the tutorials.
+ (John Whitington, review by Florian Angeletti and Xavier Leroy)
+
+- #9786, #10181: improved documentation of Unix.{in,out}_channel_of_descr
+ with respect to closing.
+ (Xavier Leroy, report by Jacques-Henri Jourdan, review by Guillaume
+ Munch-Maccagnoni, Gabriel Scherer, Jacques-Henri Jourdan)
+
+- #10139: Use the new -nonavbar option to improve navigation within
+ the reference manual stdlib documentation.
+ (John Whitington, review by David Allsopp)
+
+- #1351: Document `-output-complete-obj` option in the manual.
+ (François Bobot, Nicolás Ojeda Bär, review by Daniel Bünzli and Damien
+ Doligez)
+
+- #9632: Document incremental build solutions with opam
+ (Vincent Laviron, review by Daniel Bünzli and Gabriel Scherer)
+
+- #10497: Styling changes in the post-processed HTML manual (webman)
+ (Wiktor Kuchta, review by Florian Angeletti)
+
+- #10605: manual, name few css classes to ease styling and maintainability.
+ (Florian Angeletti, review by Wiktor Kuchta and Gabriel Scherer)
+
+### Compiler user-interface and warnings:
+
+- #1737, #2092, #7852, #7859, #10405, #10417: Update locations during
+ destructive substitutions
+ (Thomas Refis, review by Gabriel Radanne, report by Hugo Heuzard)
+
+- #2245: Improve error message for link order error in bytecode
+ (Pierre Chambart, review by Jérémie Dimino and Gabriel Scherer)
+
+- #8732, improved error messages for invalid private row type definitions.
+ For instance, [ type t = private [< `A > `A ] ] .
+ (Florian Angeletti, review by Jacques Garrigue, Thomas Refis,
+ and Gabriel Scherer)
+
+- #9407: optional warning for missing mli interface file
+ (Anukriti Kumar, review by Florian Angeletti)
+
+- #9960, #10619: extend ocamlc/ocamlopt's -o option to work when
+ compiling C files
+ (Sébastien Hinderer, reported by Daniel Bünzli, review by
+ Florian Angeletti and Gabriel Scherer)
+
+- #10095: minor simplifications to some syntax error messages.
+ (François Pottier, review by Gabriel Scherer and Frédéric Bour.)
+
+- #10196, #10197: better error message on empty character literals ''.
+ (Gabriel Scherer, review by David Allsopp and Florian Angeletti
+ and Daniel Bünzli, report by Robin Björklin)
+
+- #8877: Call the linker when ocamlopt is invoked with .o and .a files only.
+ (Greta Yorsh, review by Leo White)
+
+- #10207, #10312: deprecate consecutive letters in warning
+ specifications.
+ The form `-w aBcD` was equivalent to `-w -a+b-c+d`.
+ It is now deprecated to improve the coexistence with warning mnemonics.
+ However, using isolated single letter is not deprecated to allow the form
+ `-w "A-32..50-45"`.
+ (Florian Angeletti, review by Damien Doligez and Gabriel Scherer)
+
+- #10232: Warning for unused record fields.
+ (Leo White, review by Florian Angeletti)
+
+### Internal/compiler-libs changes:
+
+- #9243, simplify parser rules for array indexing operations
+ (Florian Angeletti, review by Damien Doligez and Gabriel Scherer)
+
+- #9650, #9651: keep refactoring the pattern-matching compiler
+ (Gabriel Scherer, review by Thomas Refis and Florian Angeletti)
+
+- #9827: Replace references with functions arguments in Simplif
+ (Anukriti Kumar, review by Vincent Laviron and David Allsop)
+
+- #10007: Driver.compile_common: when typing a .ml file, return the
+ compilation unit signature (inferred or from the .cmi) in addition
+ to the implementation and the coercion.
+ (Leandro Ostera, review by Gabriel Scherer and Thomas Refis)
+
+- #10045: Add libext variable to ocamltest and enable C# tests on on mingw
+ (David Allsopp, review by Gabriel Scherer)
+
+* #10061, #10078, #10187: remove library `ocamlopttoplevel`, remove modules
+ `Opttoploop`, `Opttopstart`, which are replaced by `Toploop` and `Topstart` in
+ library `ocamltoplevel`, made available in native code.
+ (Louis Gesbert, review by Jeremie Dimino, Mark Shinwell and Gabriel Radanne)
+
+- #10124: remove duplicated code from the native toplevel, split toplevel
+ implementation into the shared part (`Topcommon`, etc.) and specific ones
+ (`Topeval`, `Trace`, `Topmain`).
+ (Louis Gesbert, review by Jeremie Dimino and Gabriel Radanne)
+
+- #10086: add the commands `make list-parse-errors` and `make
+ generate-parse-errors` to generate a set of syntactically incorrect
+ sentences that covers all error states of the LR automaton. Add these
+ sentences to the test suite. This can be used to evaluate the quality of the
+ parser's syntax error messages and (in the future) to evaluate the impact of
+ changes in the parser.
+ (François Pottier, review by Gabriel Scherer and Xavier Leroy.)
+
+- #10090: Distinguished constructors for ref variables at lambda level
+ (Keryan Didier, review by Gabriel Scherer and Vincent Laviron)
+
+- #10113: add a `-timeout` option to ocamltest and use it in the test suite.
+ (Xavier Leroy and Gabriel Scherer, review by Sébastien Hinderer
+ and David Allsopp)
+
+* #10169, #10270, #10301, #10451: Use capitalized module names in the Standard
+ Library prefixing scheme to match Dune, e.g. Stdlib__String instead of
+ Stdlib__string. This is a breaking change only to code which attempted to use
+ the internal names before. The Standard Library generated by the Dune rules is
+ now equivalent to the main build (the Dune rules still do not generate a
+ distributable compiler).
+ (David Allsopp and Mark Shinwell, review by Gabriel Scherer)
+
+- #10327: Add a subdirectories variable and a copy action to ocamltest
+ (Sébastien Hinderer, review by David Allsopp)
+
+- #10358: Use a hash table for the load path.
+ (Leo White, review by Gabriel Scherer)
+
+- #8936: Per-function environment for Emit
+ (Greta Yorsh, review by Vincent Laviron and Florian Angeletti)
+
+- #10543: Fix Ast_mapper to apply the mapping function to the constants in
+ "interval" patterns `c1..c2`.
+ (Guillaume Petiot, review by Gabriel Scherer and Nicolás Ojeda Bär)
+
+### Internal typechecker changes:
+
+- #10174: Make Tsubst more robust by avoiding strange workarounds
+ (Takafumi Saikawa and Jacques Garrigue, review by Gabriel Scherer and
+ Florian Angeletti)
+
+- #10265: Move type_unboxed.unboxed into type_kind
+ (Stephen Dolan, review by Gabriel Scherer)
+
+- #10307: Refactor type_description in the typing env
+ (Nicolas Chataing, review by Takafumi Saikawa, Florian Angeletti and Thomas
+ Refis)
+
+- #10311: Separate the constraint-solving part of Typecore.type_pat into
+ specific solver functions.
+ (Jacques Garrigue and Takafumi Saikawa, review by Gabriel Scherer)
+
+- #10428: Make build_other_constrs work with names instead of tags.
+ (Nicolas Chataing, review by Florian Angeletti)
+
+### Build system:
+
+- #10332, #10333: Generate lambda/runtimedef.ml correctly in Swedish locale.
+ (the letter 'w' is not included in '[a-z]' in sv_SE.UTF-8)
+ (David Allsopp, report by Anders Jackson, review by Florian Angeletti and
+ Gabriel Scherer)
+
+- #10289, #10406: Do not print option documentation in usage messages.
+ (Pavlo Khrystenko, review by Gabriel Scherer, fix by Kate Deplaix)
+
+- #9191, #10091, #10182: take the LDFLAGS variable into account, except on
+ flexlink-using systems.
+ (Gabriel Scherer, review by Sébastien Hinderer and David Allsopp,
+ report by Ralph Seichter)
+
+- #10135: Overhaul the FlexDLL bootstrap process. It's now fully integrated
+ with the default build target and controlled by --with-flexdll which allows
+ externally downloaded sources for FlexDLL to be specified. A separate
+ non-shared version of the runtime is built, and shared artefacts are no longer
+ built twice. When bootstrapping, any flexlink in PATH is now ignored and the
+ Cygwin port also supports bootstrapping FlexDLL. flexlink.opt is automatically
+ built and installed as part of opt.opt/world.opt.
+ (David Allsopp, review by Sébastien Hinderer)
+
+- #10156: configure script: fix sockets feature detection.
+ (Lucas Pluvinage, review by David Allsopp and Damien Doligez)
+
+- #10176, #10632: By default, call the assembler through the C compiler driver
+ (Sébastien Hinderer, review by Gabriel Scherer, David Allsopp and Xavier
+ Leroy)
+
+- #10186: configure wasn't using library link flags when searching for
+ network functions on systems where they're not in libc. Fix IPv6 and
+ socklen_t detection on Windows.
+ (Antonin Décimo, review by David Allsopp and Sébastien Hinderer)
+
+- #10366: Make it possible to use the OCAMLRUN variable to specify
+ which runtime to use while building the compilers (Sébastien Hinderer,
+ review by David Allsopp)
+
+- #10451, #10635: Replace the use of iconv with a C utility to convert $(LIBDIR)
+ to a C string constant on Windows when building the runtime. Hardens the
+ generation of the constant on Unix for paths with backslashes, double-quotes
+ and newlines.
+ (David Allsopp, review by Florian Angeletti and Sébastien Hinderer)
+
+- #10471: Fix detection of arm32 architectures with musl in configure.
+ (Louis Gesbert, review by David Allsopp)
+
+### Bug fixes:
+
+- #6654, #9774, #10401: make `include` and with `constraints` handle correctly
+ the ghost components of signatures. For instance, in
+
+ include struct class c = object end end type c
+
+ the type `c` shadows the `class c` to avoid shadowing only the ghost type
+ c introduced by the class.
+ (Florian Angeletti, report by Eduardo Rafael, review by Gabriel Scherer)
+
+- #6985, #10385: remove all ghost row types from included modules
+ (Florian Angeletti, review by Gabriel Scherer)
+
+- #7453, #9828, #10416: fix #show for recursive types and modules
+ (Florian Angeletti, review by Gabriel Scherer)
+
+* #7469, #10408: Sys.time now returns processor time on Windows (previously
+ returned wall-clock time)
+ (David Allsopp, review by Nicolás Ojeda Bär)
+
+* #8857, #10220: Don't clobber GetLastError() in caml_leave_blocking_section
+ when the systhreads library is loaded.
+ (David Allsopp, report by Anton Bachin, review by Xavier Leroy)
+
+- #8575, #10362: Surprising interaction between polymorphic variants and
+ constructor disambiguation.
+ (Jacques Garrigue, report and review by Thomas Refis)
+
+- #8917, #8929, #9889, #10219: fix printing of nested recursive definitions
+ in presence of a name collision.
+ (Florian Angeletti, report by Thomas Refis, review by Gabriel Scherer)
+
+- #10005: Try expanding aliases in Ctype.nondep_type_rec
+ (Stephen Dolan, review by Gabriel Scherer, Leo White and Xavier Leroy)
+
+- #10072, #10085: Check that sizes and offsets in stack frame descriptors
+ do not overflow the 16-bit fields where they are stored.
+ (Xavier Leroy, report by Github user pveber, review by Gabriel Scherer)
+
+- #10087, #10138: In the toplevel REPL, don't use the cache
+ of included directories, so that files created or deleted while
+ the REPL is running are correctly handled.
+ (Xavier Leroy, report by Github user quakerquickoats, review by
+ Jeremie Dimino)
+
- #10294, #10295: fix an assert-failure in pattern-matching compilation
(Gabriel Scherer, review by Thomas Refis and Luc Maranget,
report by Nicolás Ojeda Bär)
-- #10310: configure's --enable-spacetime option now causes an error rather than
- being silently ignored.
- (David Allsopp, review by Gabriel Scherer)
+- #10147, #10148: Fix building runtime with GCC on macOS.
+ (David Allsopp, report by John Skaller)
+
+- #10166: Fix illegal permutation error reporting in module aliases.
+ (Matthew Ryan, review by Florian Angeletti)
+
+- #10189, #10190, #10347: Universal variables leaking through GADT equations
+ (Jacques Garrigue, report and review by Leo White)
+
+- #10205: Avoid overwriting closures while initialising recursive modules
+ (Stephen Dolan, review by Xavier Leroy, Hugo Heuzard and Vincent Laviron)
+
+- #10253, #10373: tweak error message for unknown variant constructors
+ or record fields in type-directed disambiguation
+ (Florian Angeletti, report by Hongbo Zhang, review by Gabriel Scherer)
+
+* #10277, #10383: Need to detect ambiguity recursively inside types to
+ guarantee principality (affects only principal mode)
+ (Jacques Garrigue, review by Thomas Refis, Leo White and Kate Deplaix)
+
+- #10283, #10284: Enforce right-to-left evaluation order for Lstaticraise
+ (Vincent Laviron, report by Github user Ngoguey42, review by Gabriel Scherer)
+
+- #10298, #10305: Incorrect propagation of type equalities in functor
+ application
+ (Jacques Garrigue, report and review by Didier Remy)
+
+- #10324, #10325: Prevent generation of Lsend(Cached, _) in bytecode
+ (Vincent Laviron, report by Yawar Amin and Nicolás Ojeda Bär, review by
+ Jacques Garrigue)
+
+- #10338, #10340: Translcore.push_defaults does not respect scoping
+ (Jacques Garrigue, report and review by Stephen Dolan)
- #10351: Fix DLL loading with binutils 2.36+ on mingw-w64
(David Allsopp, review by Nicolás Ojeda Bär)
+- #10339, #10354, #10387: Fix handling of exception-raising specific
+ operations during spilling and liveness analysis.
+ (This bug affects ARM and ARM64.)
+ In passing, refactor Proc.op_is_pure and Mach.operation_can_raise.
+ (Xavier Leroy, report by Richard Bornat, review by Stephen Dolan
+ and Mark Shinwell)
+
+- #10371: no longer generatd useless `.cds` file when using
+ `-output-complete-exe`.
+ (Nicolás Ojeda Bär, review by David Allsopp)
+
+- #10376: Link runtime libraries correctly on msvc64 in -output-complete-obj
+ (David Allsopp, review by Gabriel Scherer)
+
+- #10380: Correct handling of UTF-8 paths in configure on Windows
+ (David Allsopp, review by Sébastien Hinderer)
+
+- #10450, #10558: keep %apply and %revapply primitives working with abstract
+ types. This breach of backward compatibility was only present in the alpha
+ releases of OCaml 4.13.0 .
+ (Florian Angeletti, review by Thomas Refis and Leo White)
+
+- #10454: Check row_more in nondep_type_rec.
+ (Leo White, review by Thomas Refis)
+
+- #10468: Correctly pretty print local type substitution, e.g. type t := ...,
+ with -dsource
+ (Matt Else, review by Florian Angeletti)
+
+- #10461, #10498: `caml_send*` helper functions take derived pointers
+ as arguments. Those must be declared with type Addr instead of Val.
+ Moreover, poll point insertion must be disabled for `caml_send*`,
+ otherwise the derived pointer is live across a poll point.
+ (Vincent Laviron and Xavier Leroy, review by Xavier Leroy and Sadiq Jaffer)
+
+- #10511: Cygwin ports now correctly configure when flexdll is not available.
+ (David Allsopp, review by Florian Angeletti)
+
+- #10550, #10551: fix pretty-print of gadt-pattern-with-type-vars
+ (Chet Murthy, review by Gabriel Scherer)
+
+- #10584, #10856: Standard Library documentation build no longer fails if
+ optional libraries have been disabled.
+ (David Allsopp, report by Yuri Victorovich review by Florian Angeletti)
+
+- #10593: Fix untyping of patterns without named existential quantifiers. This
+ bug was only present in the beta version of OCaml 4.13.0.
+ (Ulysse Gérard, review by Florian Angeletti)
+
+- #10603, #10611: Fix if condition marked as inconstant in flambda
+ (Vincent Laviron and Pierre Chambart, report by Marcello Seri)
+
+
+OCaml 4.12, maintenance version
+-------------------------------
+
+### Bug fixes:
+
- #10442, #10446: Fix regression in the toplevel to #directory caused by
corrections and improvements to the Load_path in #9611. #directory now
adds the path to the start of the load path again (so files in the newly
(David Allsopp, report by Vasile Rotaru, review by Florian Angeletti
and Nicolás Ojeda Bär)
-- #10449: Fix major GC work accounting (the GC was running too fast).
- (Damien Doligez, report by Stephen Dolan, review by Nicolás Ojeda Bär
- and Sadiq Jaffer)
-
- #10478: Fix segfault under Windows due to a mistaken initialization of thread
ID when a thread starts.
(David Allsopp, Nicolás Ojeda Bär, review by Xavier Leroy)
reject the ocamlopt-generated code.
(Xavier Leroy, report by Dave Aitken, review by Vincent Laviron)
-### Manual and documentation
-
-- #10497: Styling changes in the post-processed HTML manual (webman)
- (Wiktor Kuchta, review by Florian Angeletti)
-
-
OCaml 4.12.0 (24 February 2021)
-------------------------------
- #9392: Visit registers at most once in Coloring.iter_preferred.
(Stephen Dolan, review by Pierre Chambart and Xavier Leroy)
+- #9412: Keep Sys.opaque_identity in Cmm and Mach
+ (Stephen Dolan, review by Mark Shinwell and Gabriel Scherer)
+
- #9549, #9557: Make -flarge-toc the default for PowerPC and introduce
-fsmall-toc to enable the previous behaviour.
(David Allsopp, report by Nathaniel Wesley Filardo, review by Xavier Leroy)
make html_doc
----
-and then opening link:./ocamldoc/stdlib_html/index.html[] in a web browser.
+and then opening link:./api_docgen/build/html/libref/index.html[] in a web browser.
=== Tools
LICENSE:: license and copyright notice
Makefile:: main Makefile
Makefile.common:: common Makefile definitions
- Makefile.tools:: used by manual/ and testsuite/ Makefiles
README.adoc:: general information on the compiler distribution
README.win32.adoc:: general information on the Windows ports of OCaml
VERSION:: version string. Run `make configure` after changing.
ocamltest/:: test driver
otherlibs/:: several additional libraries
parsing/:: syntax analysis -- see link:parsing/HACKING.adoc[]
+ release-info/:: documentation and tools to prepare releases
runtime/:: bytecode interpreter and runtime systems
stdlib/:: standard library
testsuite/:: tests -- see link:testsuite/HACKING.adoc[]
opam switch from it by running the following from the development repository:
-----
--opam switch create . --empty
--opam install .
+opam switch create . --empty
+opam install .
-----
If you want to test someone else's development version from a public
opam pin add ocaml-variants.$VERSION+branch git+https://$REPO#branch
----
+==== Incremental builds with `opam`
+
+This section documents some tips to speed up your workflow when you need to
+alternate between testing your branch and patching the compiler.
+We'll assume that you're currently in a clone of the compiler's source code.
+
+===== Initial setup
+
+For the rest of the section to work, you'll need your compiler to be
+configured in the same way as `opam` would have configured it. The simplest
+way is to run the normal commands for the switch initialization, with the extra
+`--inplace-build` flag:
+
+-----
+opam switch create . --empty
+opam install . --inplace-build
+-----
+
+However, if you need specific configuration options, you can also configure it
+manually, as long as you make sure that the configuration prefix is the one
+where `opam` would install the compiler.
+You will then need to install the compiler, either from the working directory
+(that you must build yourself) or using the regular sandboxed builds.
+
+-----
+# Example with regular opam build
+opam switch create . --empty
+opam install .
+./configure --prefix=$(opam var prefix) # put extra configuration args here
+-----
+
+-----
+# Example with installation from the current directory, installing only the
+# bytecode versions of the tools
+opam switch create . --empty
+./configure --prefix=$(opam var prefix) # put extra configuration args here
+make world && make opt
+opam install . --assume-built
+-----
+
+===== Basic workflow
+
+We will assume that the workflow alternates between work on the compiler and
+external (`opam`-related) commands.
+As an example, debugging an issue in the compiler can be done by a first step
+that triggers the issue (by installing a given `opam` package), then adding
+some logging to the compiler, re-trigger the issue, and based on the logs either
+add more logging, or try a patch, and so on.
+
+The part of this workflow that we're going to optimize is when we switch from
+working on the compiler to using the compiler. The basic way to do this is to
+run `opam install .` again, but this will recompile the compiler from scratch
+and also trigger a recompilation of all the packages in the switch.
+
+===== Using `opam-custom-install`
+
+The `opam-custom-install` plugin allows you to install a package using a custom
+command instead of the package-supplied one. It can be installed following
+instructions https://gitlab.ocamlpro.com/louis/opam-custom-install[here].
+
+In our case, we need to build the compiler, and when we've built everything
+that we need then we run `opam custom-install ocaml-variants -- make install`.
+This will make `opam` remove the previously installed version of the compiler
+(if any), then install the new one in its stead.
+
+-----
+# reinstall the compiler, and rebuild all opam packages
+opam custom-install ocaml-variants -- make install
+-----
+
+Since most `opam` packages depend on the compiler, this will trigger a
+reinstallation of all the packages in the switch.
+If you want to avoid that (for instance, your patch only adds some logging
+so you expect the core libraries and all the already compiled packages to be
+identical), you can use the additional `--no-recompilations` flag.
+There are no checks that it's safe to do so, so if your patch ends up
+changing even slightly one of the core libraries' files, you will likely
+get inconsistent assumptions errors later.
+
+-----
+# reinstall the compiler, leaving the opam packages untouched -- unsafe!
+opam custom-install --no-recompilations ocaml-variants -- make install
+-----
+
+Note aout the first installation:
+When you start from an empty switch, and install a compiler (in our case,
+tha `ocaml-variants` package provided by the compiler's `opam` file), then
+a number of additional packages are installed to ensure that the switch
+will work correctly. Mainly, the `ocaml` package needs to be installed,
+and while it's done automatically when using regular `opam` commands, the
+`custom-install` plugin will not force installation of dependencies.
+Moreover, if you try to fix the problem by manually installing the `ocaml`
+package, `opam` will try to recompile `ocaml-variants`, using the default
+instructions. You can get around this by running
+`opam reinstall --forget-pending` just after the `opam custom-install` command
+and just before the `opam install ocaml command`.
+Full example:
+
+-----
+opam switch create . --empty
+./configure --prefix=$(opam var prefix) --disable-ocamldoc --disable-ocamltest
+make world && make opt
+opam custom-install ocaml-variants -- make install
+opam reinstall --forget-pending --yes
+opam install ocaml
+# You now have a working switch, in which you can start installing packages
+-----
+
+One advantage of this plugin over a plain `make install` is that it
+correctly tracks the files associated with the compiler, so if your
+`make install` command only installs the bytecode versions of the tools,
+then with `opam-custom-install` you will end up in a state where only the
+bytecode tools are installed, whereas with a raw `make install` you will have
+stale native binaries remaining in your switch.
+Since it's significantly faster to build the bytecode version of the tools,
+and many `opam` packages will pick the native version of the compilers if
+present and the bytecode version otherwise, you can build your initial switch
+with the native versions (to get quickly to a state where a bug appears),
+then clean your working directory and start building bytecode tools only
+for the actual debugging phase.
+
+===== Without `opam-custom-install`
+
+You can achieve some improvements using built-in `opam` commands.
+
+Using `opam install . --assume-built` will simply remove the
+package for the compiler, then run the installation instructions
+(`make install`) in the working directory, tracking the installed files
+correctly. The main difference with the `opam-custom-install` version
+is that there's no way to prevent this command from triggering a full
+recompilation of your switch.
+
+You can also run `make install` manually, which will not trigger a
+recompilation, but will not remove the previous version either and can
+mess with `opam`'s tracking of installed files.
+
=== Useful Makefile targets
Besides the targets listed in link:INSTALL.adoc[] for build and
=== Continuous integration
-==== Github's CI: Travis and AppVeyor
+[#check-typo]
+==== check-typo
+
+The `tools/check-typo` script enforces various typographical rules in the
+OCaml compiler codebase.
+
+Running `./tools/check-typo` from the repository root will check all
+source files. This can be fairly slow (2 minutes for example). Use
+`./tools/check-typo <path>` to run it on some file or directory
+(recursively) only.
+
+Running `./tools/check-typo-since trunk` checks all files that changed
+in the commits since `trunk` -- this work with any git reference. It
+runs much faster than a full `./tools/check-typo`, typically instantly.
-The script that is run on Travis continuous integration servers is
-link:tools/ci/travis/travis-ci.sh[]; its configuration can be found as
-a Travis configuration file in link:.travis.yml[].
+You can also setup a git commit-hook to automatically run `check-typo`
+on the changes you commit, by copying the file
+`tools/pre-commit-githook` to `.git/hooks/pre-commit`. If changes in a commit
+alter the `configure` script, the hook also checks that committed `configure`
+script is up-to-date.
+
+Some files need special rules to opt out of `check-typo` checks; this
+is specified in the `.gitattributes` file at the root of the
+repository, using `typo.foo` attributes.
+
+==== GitHub's Continuous Integration: GitHub Actions and AppVeyor
+
+The scripts that are run on GitHub Actions are described in
+link:.github/workflows/build.yml[].
For example, if you want to reproduce the default build on your
machine, you can use the configuration values and run command taken from
-link:.travis.yml[]:
+link:tools/ci/actions/runner.sh[]:
----
-CI_KIND=build XARCH=x64 bash -ex tools/ci/travis/travis-ci.sh
+XARCH=x64 bash -ex tools/ci/actions/runner.sh configure
----
-The scripts support two other kinds of tests (values of the
-`CI_KIND` variable) which both inspect the patch submitted as part of
-a pull request. `tests` checks that the testsuite has been modified
-(hopefully, improved) by the patch, and `changes` checks that the
-link:Changes[] file has been modified (hopefully to add a new entry).
-
-These tests rely on the `$TRAVIS_COMMIT_RANGE` variable which you can
+The link:.github/workflows/hygiene.yml[] script supports other kinds of
+tests which inspect the patch submitted as part of a pull request. These
+tests rely on ancillary data generated by GitHub Actions which you have to
set explicitly to reproduce them locally.
-The `changes` check can be disabled by including "(no change
-entry needed)" in one of your commit messages -- but in general all
-patches submitted should come with a Changes entry; see the guidelines
-in link:CONTRIBUTING.md[].
+`Changes updated` checks that the link:Changes[] file has been modified
+(hopefully to add a new entry). It can be disabled by including "_(no change
+entry needed)_" in one of your commit messages -- but in general all patches
+submitted should come with a Changes entry; see the guidelines in
+link:CONTRIBUTING.md[].
+
+The Windows ports take a long time to test - INRIA's precheck service is the
+best to use when all 6 Windows ports need testing for a branch, but the
+AppVeyor scripts also support the other ports. The matrix is controlled by
+the following environment variables, which should be set in link:appveyor.yml[]:
+
+- `PORT` - this must be set on each job. Either `mingw`, `msvc` or `cygwin`
+ followed by `32` or `64`.
+- `BOOTSTRAP_FLEXDLL` - must be set on each job. Either `true` or `false`.
+ At present, must be `false` for Cygwin builds. Controls whether flexlink
+ is bootstrapped as part of the test or installed from a binary archive.
+- `FORCE_CYGWIN_UPGRADE`. Default: `0`. Set to `1` to force an upgrade of
+ Cygwin packages as part of the build. Normally a full upgrade is only
+ triggered if the packages installed require it.
+- `BUILD_MODE`. Default: `world.opt`. Either `world.opt`, `steps`, or `C`.
+ Controls whether the build uses the `world.opt` target or the classic
+ `world`, `opt`, `opt.opt` targets. The `C` build is a fast test used to
+ build just enough of the tree to cover the C sources (it's used to test
+ old MSVC compilers).
+- `SDK`. Defaults to Visual Studio 2015. Specifies the exact command to run
+ to set-up the Microsoft build environment.
+- `CYGWIN_DIST`. Default: `64`. Either `64` or `32`, selects 32-bit or 64-bit
+ Cygwin as the build environment.
==== INRIA's Continuous Integration (CI)
./configure --help
+
-Some options or variables like (LDFLAGS) may not be taken into account
+Some options or variables like LDLIBS may not be taken into account
by the OCaml build system at the moment. Please report an issue if you
discover such a variable or option and this causes troubles to you.
+
* On a Linux x86-64 host, to build a 32-bit version of OCaml:
- ./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
- CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
- PARTIALLD='ld -r -melf_i386'
+ ./configure --build=x86_64-pc-linux-gnu --host=i686-linux-gnu
* For AIX 7.x with the IBM compiler `xlc`:
* On HP 9000/700 machines under HP/UX 9, some versions of `cc` are unable to
compile correctly the runtime system (wrong code is generated for `(x - y)`
where `x` is a pointer and `y` an integer). Fix: use `gcc`.
+
+* In the unlikely case that a platform does not offer all C99 float operations
+ that the runtime needs, a configuration error will result. Users
+ can work around this problem by calling `configure` with the flag
+ `--enable-imprecise-c99-float-ops`. This will enable simple but potentially
+ imprecise implementations of C99 float operations. Users with exacting
+ requirements for mathematical accuracy, numerical precision, and proper
+ handling of mathematical corner cases and error conditions may need to
+ consider running their code on a platform with better C99 support.
# The main Makefile
ROOTDIR = .
+# NOTE: it is important that OCAMLLEX is defined *before* Makefile.common
+# gets included, so that its definition here takes precedence
+# over the one there.
+OCAMLLEX ?= $(BOOT_OCAMLLEX)
include Makefile.common
.PHONY: defaultentry
include stdlib/StdlibModules
CAMLC=$(BOOT_OCAMLC) -g -nostdlib -I boot -use-prims runtime/primitives
-CAMLOPT=$(CAMLRUN) ./ocamlopt$(EXE) -g -nostdlib -I stdlib -I otherlibs/dynlink
+CAMLOPT=$(OCAMLRUN) ./ocamlopt$(EXE) -g -nostdlib -I stdlib -I otherlibs/dynlink
ARCHES=amd64 i386 arm arm64 power s390x riscv
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I file_formats \
-I lambda -I middle_end -I middle_end/closure \
-I middle_end/flambda -I middle_end/flambda/base_types \
- -I asmcomp -I asmcomp/debug \
+ -I asmcomp \
-I driver -I toplevel
-COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \
- -warn-error A \
+COMPFLAGS=-strict-sequence -principal -absname \
+ -w +a-4-9-40-41-42-44-45-48-66-70 \
+ -warn-error +a \
-bin-annot -safe-string -strict-formats $(INCLUDES)
LINKFLAGS=
OCAML_NATDYNLINKOPTS = -ccopt "$(NATDYNLINKOPTS)"
endif
-CAMLLEX=$(CAMLRUN) boot/ocamllex
-CAMLDEP=$(CAMLRUN) boot/ocamlc -depend
+CAMLDEP=$(OCAMLRUN) boot/ocamlc -depend
DEPFLAGS=-slash
DEPINCLUDES=$(INCLUDES)
TOPLEVELSTART=toplevel/topstart.cmo
-OPTTOPLEVELSTART=toplevel/opttopstart.cmo
+TOPLEVELINIT=toplevel/toploop.cmo
+# This list is passed to expunge, which accepts both uncapitalized and
+# capitalized module names.
PERVASIVES=$(STDLIB_MODULES) outcometree topdirs toploop
LIBFILES=stdlib.cma std_exit.cmo *.cmi camlheader
COMPLIBDIR=$(LIBDIR)/compiler-libs
TOPINCLUDES=$(addprefix -I otherlibs/,$(filter-out %threads,$(OTHERLIBRARIES)))
-RUNTOP=./runtime/ocamlrun$(EXE) ./ocaml$(EXE) \
- -nostdlib -I stdlib -I toplevel \
- -noinit $(TOPFLAGS) $(TOPINCLUDES)
-NATRUNTOP=./ocamlnat$(EXE) \
- -nostdlib -I stdlib -I toplevel \
- -noinit $(TOPFLAGS) $(TOPINCLUDES)
ifeq "$(UNIX_OR_WIN32)" "unix"
EXTRAPATH=
else
EXTRAPATH = PATH="otherlibs/win32unix:$(PATH)"
endif
-BOOT_FLEXLINK_CMD=
-ifeq "$(UNIX_OR_WIN32)" "win32"
-FLEXDLL_SUBMODULE_PRESENT := $(wildcard flexdll/Makefile)
-ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+ COLDSTART_DEPS =
BOOT_FLEXLINK_CMD =
else
+ COLDSTART_DEPS = boot/ocamlruns$(EXE)
BOOT_FLEXLINK_CMD = \
- FLEXLINK_CMD="../boot/ocamlrun$(EXE) ../flexdll/flexlink.exe"
-endif
-else
+ FLEXLINK_CMD="../boot/ocamlruns$(EXE) ../boot/flexlink.byte$(EXE)"
endif
expunge := expunge$(EXE)
$(foreach program, $(programs), $(eval $(call PROGRAM_SYNONYM,$(program))))
+USE_RUNTIME_PRIMS = -use-prims ../runtime/primitives
+USE_STDLIB = -nostdlib -I ../stdlib
+
+FLEXDLL_OBJECTS = \
+ flexdll_$(FLEXDLL_CHAIN).$(O) flexdll_initer_$(FLEXDLL_CHAIN).$(O)
+FLEXLINK_BUILD_ENV = \
+ MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
+ CHAINS=$(FLEXDLL_CHAIN) ROOTDIR=..
+
+boot/ocamlruns$(EXE):
+ $(MAKE) -C runtime ocamlruns$(EXE)
+ cp runtime/ocamlruns$(EXE) boot/ocamlruns$(EXE)
+
# Start up the system from the distribution compiler
+# The process depends on whether FlexDLL is also being bootstrapped.
+# Normal procedure:
+# - Build the runtime
+# - Build the standard library using runtime/ocamlrun
+# FlexDLL procedure:
+# - Build ocamlruns
+# - Build the standard library using boot/ocamlruns
+# - Build flexlink and FlexDLL support objects
+# - Build the runtime
+# runtime/ocamlrun is then installed to boot/ocamlrun and the stdlib artefacts
+# are copied to boot/
.PHONY: coldstart
-coldstart:
+coldstart: $(COLDSTART_DEPS)
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+ $(MAKE) -C runtime all
+ $(MAKE) -C stdlib \
+ OCAMLRUN='$$(ROOTDIR)/runtime/ocamlrun$(EXE)' \
+ CAMLC='$$(BOOT_OCAMLC) $(USE_RUNTIME_PRIMS)' all
+else
+ $(MAKE) -C stdlib OCAMLRUN='$$(ROOTDIR)/boot/ocamlruns$(EXE)' \
+ CAMLC='$$(BOOT_OCAMLC)' all
+ $(MAKE) -C $(FLEXDLL_SOURCES) $(FLEXLINK_BUILD_ENV) \
+ OCAMLRUN='$$(ROOTDIR)/boot/ocamlruns$(EXE)' NATDYNLINK=false \
+ OCAMLOPT='$(value BOOT_OCAMLC) $(USE_RUNTIME_PRIMS) $(USE_STDLIB)' \
+ flexlink.exe support
+ mv $(FLEXDLL_SOURCES)/flexlink.exe boot/flexlink.byte$(EXE)
+ cp $(addprefix $(FLEXDLL_SOURCES)/, $(FLEXDLL_OBJECTS)) boot/
$(MAKE) -C runtime $(BOOT_FLEXLINK_CMD) all
+endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
- $(MAKE) -C stdlib $(BOOT_FLEXLINK_CMD) \
- CAMLC='$$(BOOT_OCAMLC) -use-prims ../runtime/primitives' all
+ cd boot; rm -f $(LIBFILES)
cd stdlib; cp $(LIBFILES) ../boot
cd boot; $(LN) ../runtime/libcamlrun.$(A) .
# Check if fixpoint reached
-CMPBYT := $(CAMLRUN) tools/cmpbyt$(EXE)
+CMPBYT := $(OCAMLRUN) tools/cmpbyt$(EXE)
.PHONY: compare
compare:
# Promote the newly compiled system to the rank of bootstrap compiler
# (Runs on the new runtime, produces code for the new runtime)
.PHONY: promote
-promote: PROMOTE = $(CAMLRUN) tools/stripdebug
+promote: PROMOTE = $(OCAMLRUN) tools/stripdebug
promote: promote-common
cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
.PHONY: opt.opt
opt.opt: checknative
$(MAKE) checkstack
- $(MAKE) runtime
- $(MAKE) core
+ $(MAKE) coreall
$(MAKE) ocaml
$(MAKE) opt-core
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
+ $(MAKE) flexlink.opt$(EXE)
+endif
$(MAKE) ocamlc.opt
$(MAKE) otherlibraries $(WITH_DEBUGGER) $(WITH_OCAMLDOC) \
$(WITH_OCAMLTEST)
# Rebuild the library (using runtime/ocamlrun ./ocamlc)
$(MAKE) library-cross
# Promote the new compiler and the new runtime
- $(MAKE) CAMLRUN=runtime/ocamlrun$(EXE) promote
+ $(MAKE) OCAMLRUN=runtime/ocamlrun$(EXE) promote
# Rebuild the core system
$(MAKE) partialclean
$(MAKE) core
# Different git mechanism displayed depending on whether this source tree came
# from a git clone or a source tarball.
-flexdll/Makefile:
- @echo In order to bootstrap FlexDLL, you need to place the sources in
- @echo flexdll.
+.PHONY: flexdll flexlink flexlink.opt
+
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+flexdll flexlink flexlink.opt:
+ @echo It is no longer necessary to bootstrap FlexDLL with a separate
+ @echo make invocation. Simply place the sources for FlexDLL in a
+ @echo sub-directory.
@echo This can either be done by downloading a source tarball from
- @echo \ http://alain.frisch.fr/flexdll.html
+ @echo \ https://github.com/alainfrisch/flexdll/releases
@if [ -d .git ]; then \
echo or by checking out the flexdll submodule with; \
echo \ git submodule update --init; \
echo or by cloning the git repository; \
echo \ git clone https://github.com/alainfrisch/flexdll.git; \
fi
+ @echo "Then pass --with-flexdll=<dir> to configure and build as normal."
@false
-.PHONY: flexdll
-flexdll: flexdll/Makefile flexlink
- $(MAKE) -C flexdll \
- OCAML_CONFIG_FILE=../Makefile.config \
- MSVC_DETECT=0 CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false support
+else
-# Bootstrapping flexlink - leaves a bytecode image of flexlink.exe in flexdll/
-FLEXLINK_OCAMLOPT = \
- ../boot/ocamlrun$(EXE) ../boot/ocamlc \
- -use-prims ../runtime/primitives -nostdlib -I ../boot
+.PHONY: flexdll
+flexdll: flexdll/Makefile
+ @echo WARNING! make flexdll is no longer required
+ @echo This target will be removed in a future release.
.PHONY: flexlink
-flexlink: flexdll/Makefile
- $(MAKE) -C runtime BOOTSTRAPPING_FLEXLINK=yes ocamlrun$(EXE)
- cp runtime/ocamlrun$(EXE) boot/ocamlrun$(EXE)
- $(MAKE) -C stdlib \
- COMPILER="../boot/ocamlc -use-prims ../runtime/primitives" \
- $(filter-out *.cmi,$(LIBFILES))
- cd stdlib && cp $(LIBFILES) ../boot/
- $(MAKE) -C flexdll MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
- CHAINS=$(FLEXDLL_CHAIN) NATDYNLINK=false \
- OCAMLOPT="$(FLEXLINK_OCAMLOPT)" \
- flexlink.exe
- $(MAKE) -C runtime clean
- $(MAKE) partialclean
+flexlink:
+ @echo Bootstrapping just flexlink.exe is no longer supported
+ @echo Bootstrapping FlexDLL is now enabled with
+ @echo ./configure --with-flexdll
+ @false
-.PHONY: flexlink.opt
-flexlink.opt:
- cd flexdll && \
- mv flexlink.exe flexlink && \
- ($(MAKE) OCAML_FLEXLINK="../boot/ocamlrun$(EXE) ./flexlink" \
- MSVC_DETECT=0 OCAML_CONFIG_FILE=../Makefile.config \
- OCAMLOPT="../ocamlopt.opt$(EXE) -nostdlib -I ../stdlib" \
- flexlink.exe || \
- (mv flexlink flexlink.exe && false)) && \
- mv flexlink.exe flexlink.opt && \
- mv flexlink flexlink.exe
-
-INSTALL_COMPLIBDIR=$(DESTDIR)$(COMPLIBDIR)
-INSTALL_FLEXDLLDIR=$(INSTALL_LIBDIR)/flexdll
-
-.PHONY: install-flexdll
-install-flexdll:
- $(INSTALL_PROG) flexdll/flexlink.exe "$(INSTALL_BINDIR)/flexlink$(EXE)"
-ifneq "$(filter-out mingw,$(TOOLCHAIN))" ""
- $(INSTALL_DATA) flexdll/default$(filter-out _i386,_$(ARCH)).manifest \
- "$(INSTALL_BINDIR)/"
+ifeq "$(wildcard ocamlopt.opt$(EXE))" ""
+ FLEXLINK_OCAMLOPT=../runtime/ocamlrun$(EXE) ../ocamlopt$(EXE)
+else
+ FLEXLINK_OCAMLOPT=../ocamlopt.opt$(EXE)
endif
- if test -n "$(wildcard flexdll/flexdll_*.$(O))" ; then \
- $(MKDIR) "$(INSTALL_FLEXDLLDIR)" ; \
- $(INSTALL_DATA) flexdll/flexdll_*.$(O) "$(INSTALL_FLEXDLLDIR)" ; \
- fi
+
+flexlink.opt$(EXE):
+ $(MAKE) -C $(FLEXDLL_SOURCES) $(FLEXLINK_BUILD_ENV) \
+ OCAML_FLEXLINK='$(value OCAMLRUN) $$(ROOTDIR)/boot/flexlink.byte$(EXE)' \
+ OCAMLOPT="$(FLEXLINK_OCAMLOPT) -nostdlib -I ../stdlib" flexlink.exe
+ mv $(FLEXDLL_SOURCES)/flexlink.exe $@
+
+partialclean::
+ rm -f flexlink.opt$(EXE)
+endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+
+INSTALL_COMPLIBDIR = $(DESTDIR)$(COMPLIBDIR)
+INSTALL_FLEXDLLDIR = $(INSTALL_LIBDIR)/flexdll
+FLEXDLL_MANIFEST = default$(filter-out _i386,_$(ARCH)).manifest
# Installation
.PHONY: install
driver/*.cmi \
toplevel/*.cmi \
"$(INSTALL_COMPLIBDIR)"
+ $(INSTALL_DATA) \
+ toplevel/byte/*.cmi \
+ "$(INSTALL_COMPLIBDIR)"
ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
$(INSTALL_DATA) \
utils/*.cmt utils/*.cmti utils/*.mli \
driver/*.cmt driver/*.cmti driver/*.mli \
toplevel/*.cmt toplevel/*.cmti toplevel/*.mli \
"$(INSTALL_COMPLIBDIR)"
+ $(INSTALL_DATA) \
+ toplevel/byte/*.cmt \
+ "$(INSTALL_COMPLIBDIR)"
endif
$(INSTALL_DATA) \
compilerlibs/*.cma \
"$(INSTALL_LIBDIR)"
ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
$(INSTALL_DATA) \
- toplevel/topdirs.cmt toplevel/topdirs.cmti \
- toplevel/topdirs.mli \
+ toplevel/topdirs.cmt \
+ toplevel/topdirs.cmti toplevel/topdirs.mli \
"$(INSTALL_LIBDIR)"
endif
$(MAKE) -C tools install
done
ifneq "$(WITH_OCAMLDOC)" ""
$(MAKE) -C ocamldoc install
+endif
+ifeq "$(WITH_OCAMLDOC)-$(STDLIB_MANPAGES)" "ocamldoc-true"
+ $(MAKE) -C api_docgen install
endif
if test -n "$(WITH_DEBUGGER)"; then \
$(MAKE) -C debugger install; \
fi
-ifeq "$(UNIX_OR_WIN32)" "win32"
- if test -n "$(FLEXDLL_SUBMODULE_PRESENT)"; then \
- $(MAKE) install-flexdll; \
- fi
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
+ifeq "$(TOOLCHAIN)" "msvc"
+ $(INSTALL_DATA) $(FLEXDLL_SOURCES)/$(FLEXDLL_MANIFEST) \
+ "$(INSTALL_BINDIR)/"
endif
+ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+ $(INSTALL_PROG) \
+ boot/flexlink.byte$(EXE) "$(INSTALL_BINDIR)/flexlink.byte$(EXE)"
+endif # ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
+ $(MKDIR) "$(INSTALL_FLEXDLLDIR)"
+ $(INSTALL_DATA) $(addprefix stdlib/flexdll/, $(FLEXDLL_OBJECTS)) \
+ "$(INSTALL_FLEXDLLDIR)"
+endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
$(INSTALL_DATA) Makefile.config "$(INSTALL_LIBDIR)"
ifeq "$(INSTALL_BYTECODE_PROGRAMS)" "true"
if test -f ocamlopt$(EXE); then $(MAKE) installopt; else \
cd "$(INSTALL_BINDIR)"; \
$(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
$(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
+ (test -f flexlink.byte$(EXE) && \
+ $(LN) flexlink.byte$(EXE) flexlink$(EXE)) || true; \
fi
else
if test -f ocamlopt$(EXE); then $(MAKE) installopt; fi
$(INSTALL_DATA) \
asmcomp/*.cmi \
"$(INSTALL_COMPLIBDIR)"
- $(INSTALL_DATA) \
- asmcomp/debug/*.cmi \
- "$(INSTALL_COMPLIBDIR)"
ifeq "$(INSTALL_SOURCE_ARTIFACTS)" "true"
$(INSTALL_DATA) \
middle_end/*.cmt middle_end/*.cmti \
asmcomp/*.cmt asmcomp/*.cmti \
asmcomp/*.mli \
"$(INSTALL_COMPLIBDIR)"
- $(INSTALL_DATA) \
- asmcomp/debug/*.cmt asmcomp/debug/*.cmti \
- asmcomp/debug/*.mli \
- "$(INSTALL_COMPLIBDIR)"
endif
$(INSTALL_DATA) \
$(OPTSTART) \
$(LN) ocamlc.byte$(EXE) ocamlc$(EXE); \
$(LN) ocamlopt.byte$(EXE) ocamlopt$(EXE); \
$(LN) ocamllex.byte$(EXE) ocamllex$(EXE); \
+ (test -f flexlink.byte$(EXE) && \
+ $(LN) flexlink.byte$(EXE) flexlink$(EXE)) || true; \
fi
else
if test -f ocamlopt.opt$(EXE); then $(MAKE) installoptopt; fi
endif
$(MAKE) -C tools installopt
- if test -f ocamlopt.opt$(EXE) -a -f flexdll/flexlink.opt ; then \
- $(INSTALL_PROG) \
- flexdll/flexlink.opt "$(INSTALL_BINDIR)/flexlink$(EXE)" ; \
- fi
.PHONY: installoptopt
installoptopt:
$(LN) ocamlc.opt$(EXE) ocamlc$(EXE); \
$(LN) ocamlopt.opt$(EXE) ocamlopt$(EXE); \
$(LN) ocamllex.opt$(EXE) ocamllex$(EXE)
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
+ $(INSTALL_PROG) flexlink.opt$(EXE) "$(INSTALL_BINDIR)"
+ cd "$(INSTALL_BINDIR)"; \
+ $(LN) flexlink.opt$(EXE) flexlink$(EXE)
+endif
$(INSTALL_DATA) \
utils/*.cmx parsing/*.cmx typing/*.cmx bytecomp/*.cmx \
file_formats/*.cmx \
middle_end/closure/*.cmx \
middle_end/flambda/*.cmx \
middle_end/flambda/base_types/*.cmx \
- asmcomp/debug/*.cmx \
"$(INSTALL_COMPLIBDIR)"
$(INSTALL_DATA) \
compilerlibs/*.cmxa compilerlibs/*.$(A) \
if test -f ocamlnat$(EXE) ; then \
$(INSTALL_PROG) ocamlnat$(EXE) "$(INSTALL_BINDIR)"; \
$(INSTALL_DATA) \
- toplevel/opttopdirs.cmi \
- "$(INSTALL_LIBDIR)"; \
- $(INSTALL_DATA) \
- $(OPTTOPLEVELSTART:.cmo=.cmx) $(OPTTOPLEVELSTART:.cmo=.$(O)) \
+ toplevel/*.cmx \
+ toplevel/native/*.cmx \
+ $(TOPLEVELSTART:.cmo=.$(O)) \
"$(INSTALL_COMPLIBDIR)"; \
fi
cd "$(INSTALL_COMPLIBDIR)" && \
utils/*.ml parsing/*.ml typing/*.ml bytecomp/*.ml driver/*.ml \
file_formats/*.ml \
lambda/*.ml \
- toplevel/*.ml middle_end/*.ml middle_end/closure/*.ml \
+ toplevel/*.ml toplevel/byte/*.ml \
+ middle_end/*.ml middle_end/closure/*.ml \
middle_end/flambda/*.ml middle_end/flambda/base_types/*.ml \
asmcomp/*.ml \
asmcmp/debug/*.ml \
.INTERMEDIATE: ocaml.tmp
ocaml.tmp: $(ocaml_dependencies)
- $(CAMLC) $(LINKFLAGS) -linkall -o $@ $^
+ $(CAMLC) $(LINKFLAGS) -I toplevel/byte -linkall -o $@ $^
ocaml$(EXE): $(expunge) ocaml.tmp
- - $(CAMLRUN) $^ $@ $(PERVASIVES)
+ - $(OCAMLRUN) $^ $@ $(PERVASIVES)
partialclean::
rm -f ocaml$(EXE)
+# Use TOPFLAGS to pass additional flags to the bytecode or native toplevel
+# when running make runtop or make natruntop
+TOPFLAGS ?=
+OC_TOPFLAGS = -nostdlib -I stdlib -I toplevel -noinit $(TOPINCLUDES) $(TOPFLAGS)
+
+# Note: Beware that, since this rule begins with a coldstart, both
+# boot/ocamlrun and runtime/ocamlrun will be the same when the toplevel
+# is run.
.PHONY: runtop
runtop:
$(MAKE) coldstart
$(MAKE) ocamlc
$(MAKE) otherlibraries
$(MAKE) ocaml
- @$(EXTRAPATH) $(RLWRAP) $(RUNTOP)
+ @$(EXTRAPATH) $(RLWRAP) $(OCAMLRUN) ./ocaml$(EXE) $(OC_TOPFLAGS)
.PHONY: natruntop
natruntop:
$(MAKE) core
$(MAKE) opt
$(MAKE) ocamlnat
- @$(FLEXLINK_ENV) $(EXTRAPATH) $(RLWRAP) $(NATRUNTOP)
+ @$(FLEXLINK_ENV) $(EXTRAPATH) $(RLWRAP) ./ocamlnat$(EXE) $(OC_TOPFLAGS)
# Native dynlink
otherlibs/dynlink/dynlink.cmxa: otherlibs/dynlink/native/dynlink.ml
$(MAKE) -C otherlibs/dynlink allopt
-# The lexer
-
-parsing/lexer.ml: parsing/lexer.mll
- $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
+# Cleanup the lexer
partialclean::
rm -f parsing/lexer.ml
asmcomp/emit.ml: asmcomp/$(ARCH)/emit.mlp $(cvt_emit)
echo \# 1 \"$(ARCH)/emit.mlp\" > $@
- $(CAMLRUN) $(cvt_emit) < $< >> $@ \
+ $(OCAMLRUN) $(cvt_emit) < $< >> $@ \
|| { rm -f $@; exit 2; }
partialclean::
# The runtime system for the bytecode compiler
+$(SAK):
+ $(MAKE) -C runtime sak$(EXE)
+
.PHONY: runtime
runtime: stdlib/libcamlrun.$(A)
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "true"
+runtime: $(addprefix stdlib/flexdll/, $(FLEXDLL_OBJECTS))
+stdlib/flexdll/flexdll%.$(O): $(FLEXDLL_SOURCES)/flexdll%.$(O) | stdlib/flexdll
+ cp $< $@
+stdlib/flexdll:
+ $(MKDIR) $@
+endif
+
.PHONY: makeruntime
makeruntime:
$(MAKE) -C runtime $(BOOT_FLEXLINK_CMD) all
.PHONY: library-cross
library-cross:
$(MAKE) -C stdlib \
- $(BOOT_FLEXLINK_CMD) CAMLRUN=../runtime/ocamlrun$(EXE) all
+ $(BOOT_FLEXLINK_CMD) OCAMLRUN=../runtime/ocamlrun$(EXE) all
.PHONY: libraryopt
libraryopt:
beforedepend:: parsing/camlinternalMenhirLib.ml \
parsing/camlinternalMenhirLib.mli \
- parsing/parser.ml parsing/parser.mli
+ parsing/parser.ml parsing/parser.mli
partialclean:: partialclean-menhir
.PHONY: html_doc
html_doc: ocamldoc
- $(MAKE) -C ocamldoc $@
- @echo "documentation is in ./ocamldoc/stdlib_html/"
+ $(MAKE) -C api_docgen html
+ @echo "documentation is in ./api_docgen/html/"
.PHONY: manpages
manpages:
- $(MAKE) -C ocamldoc $@
+ $(MAKE) -C api_docgen man
partialclean::
$(MAKE) -C ocamldoc clean
+partialclean::
+ $(MAKE) -C api_docgen clean
+
# The extra libraries
.PHONY: otherlibraries
# Check that the stack limit is reasonable (Unix-only)
.PHONY: checkstack
ifeq "$(UNIX_OR_WIN32)" "unix"
-checkstack := tools/checkstack
-checkstack: $(checkstack)$(EXE)
+checkstack: tools/checkstack$(EXE)
$<
-.INTERMEDIATE: $(checkstack)$(EXE) $(checkstack).$(O)
-$(checkstack)$(EXE): $(checkstack).$(O)
- $(MKEXE) $(OUTPUTEXE)$@ $<
+.INTERMEDIATE: tools/checkstack$(EXE) tools/checkstack.$(O)
+tools/checkstack$(EXE): tools/checkstack.$(O)
+ $(MAKE) -C tools $(BOOT_FLEXLINK_CMD) checkstack$(EXE)
else
checkstack:
@
ocamlnat$(EXE): compilerlibs/ocamlcommon.cmxa compilerlibs/ocamloptcomp.cmxa \
compilerlibs/ocamlbytecomp.cmxa \
otherlibs/dynlink/dynlink.cmxa \
- compilerlibs/ocamlopttoplevel.cmxa \
- $(OPTTOPLEVELSTART:.cmo=.cmx)
- $(CAMLOPT_CMD) $(LINKFLAGS) -linkall -o $@ $^
+ compilerlibs/ocamltoplevel.cmxa \
+ $(TOPLEVELSTART:.cmo=.cmx)
+ $(CAMLOPT_CMD) $(LINKFLAGS) -linkall -I toplevel/native -o $@ $^
+
+
+toplevel/topdirs.cmx: toplevel/topdirs.ml
+ $(CAMLOPT_CMD) $(COMPFLAGS) $(OPTCOMPFLAGS) -I toplevel/native -c $<
+
+$(TOPLEVELINIT:.cmo=.cmx): $(TOPLEVELINIT:.cmo=.ml) \
+ toplevel/native/topeval.cmx
+ $(CAMLOPT_CMD) $(COMPFLAGS) $(OPTCOMPFLAGS) -I toplevel/native -c $<
+
+$(TOPLEVELSTART:.cmo=.cmx): $(TOPLEVELSTART:.cmo=.ml) \
+ toplevel/native/topmain.cmx
+ $(CAMLOPT_CMD) $(COMPFLAGS) $(OPTCOMPFLAGS) -I toplevel/native -c $<
partialclean::
rm -f ocamlnat ocamlnat.exe
-toplevel/opttoploop.cmx: otherlibs/dynlink/dynlink.cmxa
+toplevel/native/topeval.cmx: otherlibs/dynlink/dynlink.cmxa
# The numeric opcodes
make_opcodes := tools/make_opcodes$(EXE)
bytecomp/opcodes.ml: runtime/caml/instruct.h $(make_opcodes)
- runtime/ocamlrun$(EXE) $(make_opcodes) -opcodes < $< > $@
+ $(NEW_OCAMLRUN) $(make_opcodes) -opcodes < $< > $@
bytecomp/opcodes.mli: bytecomp/opcodes.ml
$(CAMLC) -i $< > $@
# Default rules
-.SUFFIXES: .ml .mli .cmo .cmi .cmx
-
-.ml.cmo:
- $(CAMLC) $(COMPFLAGS) -c $<
+%.cmo: %.ml
+ $(CAMLC) $(COMPFLAGS) -c $< -I $(@D)
-.mli.cmi:
+%.cmi: %.mli
$(CAMLC) $(COMPFLAGS) -c $<
-.ml.cmx:
- $(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $<
+%.cmx: %.ml
+ $(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) -c $< -I $(@D)
partialclean::
for d in utils parsing typing bytecomp asmcomp middle_end file_formats \
lambda middle_end/closure middle_end/flambda \
- middle_end/flambda/base_types asmcomp/debug \
- driver toplevel tools; do \
+ middle_end/flambda/base_types \
+ driver toplevel toplevel/byte toplevel/native tools; do \
rm -f $$d/*.cm[ioxt] $$d/*.cmti $$d/*.annot $$d/*.s $$d/*.asm \
$$d/*.o $$d/*.obj $$d/*.so $$d/*.dll; \
done
depend: beforedepend
(for d in utils parsing typing bytecomp asmcomp middle_end \
lambda file_formats middle_end/closure middle_end/flambda \
- middle_end/flambda/base_types asmcomp/debug \
- driver toplevel; \
- do $(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) $$d/*.mli $$d/*.ml || exit; \
+ middle_end/flambda/base_types \
+ driver toplevel toplevel/byte toplevel/native; \
+ do \
+ $(CAMLDEP) $(DEPFLAGS) -I $$d $(DEPINCLUDES) $$d/*.mli $$d/*.ml \
+ || exit; \
done) > .depend
.PHONY: distclean
distclean: clean
rm -f boot/ocamlrun boot/ocamlrun.exe boot/camlheader \
- boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
+ boot/ocamlruns boot/ocamlruns.exe \
+ boot/flexlink.byte boot/flexlink.byte.exe \
+ boot/flexdll_*.o boot/flexdll_*.obj \
+ boot/*.cm* boot/libcamlrun.a boot/libcamlrun.lib boot/ocamlc.opt
rm -f Makefile.config Makefile.build_config
rm -f runtime/caml/m.h runtime/caml/s.h
- rm -rf autom4te.cache
+ rm -rf autom4te.cache flexdll-sources
rm -f config.log config.status libtool
rm -f tools/eventlog_metadata
rm -f tools/*.bak
@echo "- In file README.win32.adoc for Windows systems."
@echo "On Unix systems, if you've just unpacked the distribution,"
@echo "something like"
- @echo " ./configure"
- @echo " make"
- @echo " make install"
+ @echo " ./configure"
+ @echo " make"
+ @echo " make install"
@echo "should work."
@false
$(and $(USE_BEST_BINARIES),$(wildcard $(ROOTDIR)/$1.opt$(EXE)),$(strip \
$(call check_not_stale,$1$(EXE),$1.opt$(EXE)))), \
$(ROOTDIR)/$1.opt$(EXE), \
- $(CAMLRUN) $(ROOTDIR)/$1$(EXE)))
+ $(OCAMLRUN) $(ROOTDIR)/$1$(EXE)))
BEST_OCAMLC := $(call choose_best,ocamlc)
BEST_OCAMLOPT := $(call choose_best,ocamlopt)
# is not built yet, using the bootstrap compiler.
# Unlike other tools, there is no risk of mixing incompatible
-# bootrap-compiler and host-compiler object files, as ocamldep only
+# bootstrap-compiler and host-compiler object files, as ocamldep only
# produces text output.
BEST_OCAMLDEP := $(strip $(if \
$(and $(USE_BEST_BINARIES),$(wildcard $(ROOTDIR)/ocamlc.opt$(EXE)),$(strip \
# The rlwrap command (for the *runtop targets)
RLWRAP=@rlwrap@
+
+# Which document generator: odoc or ocamldoc?
+DOCUMENTATION_TOOL=@documentation_tool@
+DOCUMENTATION_TOOL_CMD=@documentation_tool_cmd@
+
+# The location of the FlexDLL sources to use (usually provided as the flexdll
+# Git submodule)
+FLEXDLL_SOURCES=@flexdir@
+BOOTSTRAPPING_FLEXDLL=@bootstrapping_flexdll@
D=d
MKDIR=mkdir -p
+# $(EMPTY) is defined in Makefile.config, but may not have been loaded
+EMPTY :=
+# $(SPACE) contains a single space
+SPACE := $(EMPTY) $(EMPTY)
+
DESTDIR ?=
INSTALL_BINDIR := $(DESTDIR)$(BINDIR)
INSTALL_LIBDIR := $(DESTDIR)$(LIBDIR)
INSTALL_STUBLIBDIR := $(DESTDIR)$(STUBLIBDIR)
INSTALL_MANDIR := $(DESTDIR)$(MANDIR)
-ifeq "$(UNIX_OR_WIN32)" "win32"
FLEXDLL_SUBMODULE_PRESENT := $(wildcard $(ROOTDIR)/flexdll/Makefile)
-else
-FLEXDLL_SUBMODULE_PRESENT =
-endif
-# Use boot/ocamlc.opt if available
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
-ifeq (0,$(shell \
+# Variables used to represent the OCaml runtime system
+# Most of the time, boot/ocamlrun and runtime/ocamlrun are the same.
+# However, under some circumstances it is important to be able to
+# distinguish one from the other, hence these two variables.
+# Boot/ocamlrun is the most frequently used in the build system, so
+# we use OCAMLRUN to designate it and keep NEW_OCAMLRUN to refer
+# to runtime/ocamlrun, because it's less frequently used.
+OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
+NEW_OCAMLRUN ?= $(ROOTDIR)/runtime/ocamlrun$(EXE)
+
+TEST_BOOT_OCAMLC_OPT = $(shell \
test $(ROOTDIR)/boot/ocamlc.opt -nt $(ROOTDIR)/boot/ocamlc; \
- echo $$?))
+ echo $$?)
+
+# Use boot/ocamlc.opt if available
+ifeq "$(TEST_BOOT_OCAMLC_OPT)" "0"
BOOT_OCAMLC = $(ROOTDIR)/boot/ocamlc.opt
else
- BOOT_OCAMLC = $(CAMLRUN) $(ROOTDIR)/boot/ocamlc
+ BOOT_OCAMLC = $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc
endif
-ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
FLEXLINK_ENV =
CAMLOPT_CMD = $(CAMLOPT)
OCAMLOPT_CMD = $(OCAMLOPT)
ocamlc_cmd = $(ocamlc)
ocamlopt_cmd = $(ocamlopt)
else
+ifeq "$(wildcard $(ROOTDIR)/flexlink.opt$(EXE))" ""
FLEXLINK_ENV = \
- OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun $(ROOTDIR)/flexdll/flexlink.exe"
+ OCAML_FLEXLINK="$(ROOTDIR)/boot/ocamlrun$(EXE) \
+ $(ROOTDIR)/boot/flexlink.byte$(EXE)"
+else
+ FLEXLINK_ENV = \
+ OCAML_FLEXLINK="$(ROOTDIR)/flexlink.opt$(EXE) -I $(ROOTDIR)/stdlib/flexdll"
+endif # ifeq "$(wildcard $(ROOTDIR)/flexlink.opt$(EXE))" ""
CAMLOPT_CMD = $(FLEXLINK_ENV) $(CAMLOPT)
OCAMLOPT_CMD = $(FLEXLINK_ENV) $(OCAMLOPT)
MKLIB_CMD = $(FLEXLINK_ENV) $(MKLIB)
ocamlc_cmd = $(FLEXLINK_ENV) $(ocamlc)
ocamlopt_cmd = $(FLEXLINK_ENV) $(ocamlopt)
-endif
+endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
OPTCOMPFLAGS=
ifeq "$(FUNCTION_SECTIONS)" "true"
OPTCOMPFLAGS += -function-sections
endif
-# By default, request ocamllex to be quiet
-OCAMLLEX_FLAGS ?= -q
# Escape special characters in the argument string.
# There are four characters that need escaping:
$(1): $(1)$(EXE)
endif
endef # PROGRAM_SYNONYM
+
+# Lexer generation
+
+BOOT_OCAMLLEX ?= $(OCAMLRUN) $(ROOTDIR)/boot/ocamllex
+
+# Default value for OCAMLLEX
+# In those directories where this needs to be overriden, the overriding
+# should take place *before* Makefile.common is included.
+
+OCAMLLEX ?= $(BEST_OCAMLLEX)
+
+OCAMLLEXFLAGS ?= -q
+
+%.ml: %.mll
+ $(OCAMLLEX) $(OCAMLLEXFLAGS) $<
+
+# Parser generation
+
+OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
+
+OCAMLYACCFLAGS ?=
+
+%.ml %.mli: %.mly
+ $(OCAMLYACC) $(OCAMLYACCFLAGS) $<
+
+SAK = $(ROOTDIR)/runtime/sak$(EXE)
+
+# stdlib/StdlibModules cannot be include'd unless $(SAK) has been built. These
+# two rules add that dependency. They have to be pattern rules since
+# Makefile.common is included before default targets.
+$(ROOTDIR)/%/sak$(EXE):
+ $(MAKE) -C $(ROOTDIR)/$* sak$(EXE)
+
+ifneq "$(REQUIRES_CONFIGURATION)" ""
+$(ROOTDIR)/%/StdlibModules: $(SAK) ;
+endif
# our own symbols):
OC_LDFLAGS=@oc_ldflags@
+LDFLAGS?=@LDFLAGS@
+
### How to invoke the C preprocessor through the C compiler
CPP=@CPP@
### Link-time options to ocamlc or ocamlopt for linking with POSIX threads
# Needed for the "systhreads" package
-PTHREAD_LINK=@pthread_link@
-PTHREAD_CAML_LINK=$(addprefix -cclib ,$(PTHREAD_LINK))
-PTHREAD_CFLAGS=@PTHREAD_CFLAGS@
+PTHREAD_LIBS=@PTHREAD_LIBS@
+PTHREAD_CAML_LIBS=$(addprefix -cclib ,$(PTHREAD_LIBS))
UNIX_OR_WIN32=@unix_or_win32@
UNIXLIB=@unixlib@
NATIVECCLIBS=@nativecclibs@
SYSTHREAD_SUPPORT=@systhread_support@
PACKLD=@PACKLD@
-IFLEXDIR=@iflexdir@
+FLEXDLL_CHAIN=@flexdll_chain@
EXTRALIBS=@extralibs@
CCOMPTYPE=@ccomptype@
TOOLCHAIN=@toolchain@
MKEXEDEBUGFLAG=@mkexedebugflag@
RUNTIMED=@debug_runtime@
-RUNTIMEI=@instrumented_runtime@
+INSTRUMENTED_RUNTIME=@instrumented_runtime@
+INSTRUMENTED_RUNTIME_LIBS=@instrumented_runtime_libs@
WITH_DEBUGGER=@with_debugger@
WITH_CAMLTEX=@with_camltex@
WITH_OCAMLDOC=@ocamldoc@
HOST=@host@
FLAMBDA=@flambda@
WITH_FLAMBDA_INVARIANTS=@flambda_invariants@
+WITH_CMM_INVARIANTS=@cmm_invariants@
FORCE_SAFE_STRING=@force_safe_string@
DEFAULT_SAFE_STRING=@default_safe_string@
WINDOWS_UNICODE=@windows_unicode@
MERGEMANIFESTEXE=test ! -f $(1).manifest \
|| mt -nologo -outputresource:$(1) -manifest $(1).manifest \
&& rm -f $(1).manifest
- MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \
- /link /subsystem:console $(OC_LDFLAGS) && ($(MERGEMANIFESTEXE))
+ MKEXE_USING_COMPILER=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OUTPUTEXE)$(1) $(2) \
+ /link /subsystem:console $(OC_LDFLAGS) $(LDFLAGS) && ($(MERGEMANIFESTEXE))
else
- MKEXE_BOOT=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_LDFLAGS) $(OUTPUTEXE)$(1) $(2)
+ MKEXE_USING_COMPILER=$(CC) $(OC_CFLAGS) $(CFLAGS) $(OC_LDFLAGS) $(LDFLAGS) \
+ $(OUTPUTEXE)$(1) $(2)
endif # ifeq "$(TOOLCHAIN)" "msvc"
# The following variables were defined only in the Windows-specific makefiles.
# in the future their definition may be moved to a more private part of
# the compiler's build system
ifeq "$(UNIX_OR_WIN32)" "win32"
- OTOPDIR=$(WINTOPDIR)
- CTOPDIR=$(WINTOPDIR)
CYGPATH=cygpath -m
DIFF=/usr/bin/diff -q --strip-trailing-cr
FIND=/usr/bin/find
SORT=/usr/bin/sort
SET_LD_PATH=PATH="$(PATH):$(LD_PATH)"
- FLEXLINK_CMD=flexlink
- FLEXDLL_CHAIN=@flexdll_chain@
- # FLEXLINK_FLAGS must be safe to insert in an OCaml string
- # (see ocamlmklibconfig.ml in tools/Makefile)
- FLEXLINK_FLAGS=@flexlink_flags@
- FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS)
else # ifeq "$(UNIX_OR_WIN32)" "win32"
# On Unix, make sure FLEXLINK is defined but empty
- FLEXLINK =
+ SORT=sort
+ CYGPATH=echo
+ SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)"
endif # ifeq "$(UNIX_OR_WIN32)" "win32"
+
+FLEXLINK_FLAGS=@flexlink_flags@
+FLEXLINK_CMD=flexlink
+FLEXLINK=$(FLEXLINK_CMD) $(FLEXLINK_FLAGS)
+
+# Deprecated variables
+
+## Variables renamed in OCaml 4.13
+
+RUNTIMEI=$(INSTRUMENTED_RUNTIME)
+
+### pthread-related variables
+
+PTHREAD_LINK=$(PTHREAD_LIBS)
+PTHREAD_CAML_LINK=$(PTHREAD_CAML_LIBS)
+
+### It is expected that the value of PTHREAD_LINK changes between OCaml
+### 4.12 and 4.13. Indeed, for OCaml 4.12 most of the time the variable
+### contained -lpthread. From 4.13 onward it will most of the time be
+### empty since we have -pthread in CFLAGS which implies -lpthread.
#* *
#**************************************************************************
-ifeq "$(MAKECMDGOALS)" ""
-MAKECMDGOALS += defaultentry
-endif
+MAKECMDGOALS ?= defaultentry
CLEAN_TARGET_NAMES=clean partialclean distclean
@$(MAKE) --no-print-directory $(AST_FILES)
CAMLC_DPARSETREE := \
- $(CAMLRUN) ./ocamlc -nostdlib -nopervasives \
- -stop-after parsing -dparsetree
+ $(OCAMLRUN) ./ocamlc -nostdlib -nopervasives \
+ -stop-after parsing -dparsetree
%.ml.ast: %.ml ocamlc
$(CAMLC_DPARSETREE) $< 2> $@ || exit 0
## Unused tokens
-# tokens COMMENT, DOCSTRING and EOL are produced by special lexer
+# The tokens COMMENT, DOCSTRING and EOL are produced by special lexer
# modes used by other consumers than the parser.
# GREATERBRACKET ">]" was added by the parser by symmetry with "[<"
unused_tokens := COMMENT DOCSTRING EOL GREATERRBRACKET
-## Menhir compilation flags
+## Menhir's flags.
-MENHIRFLAGS := --explain --dump --ocamlc "$(CAMLC) $(COMPFLAGS)" --infer \
- --lalr --strict --table -lg 1 -la 1 \
- $(addprefix --unused-token ,$(unused_tokens)) --fixed-exception
+# The basic flags influence the analysis of the grammar and the construction
+# of the automaton. The complete set of flags includes extra flags that
+# influence type inference and code production.
+
+MENHIRBASICFLAGS := \
+ --lalr \
+ --explain \
+ --dump \
+ --require-aliases \
+ --strict \
+ -lg 1 \
+ -la 1 \
+ $(addprefix --unused-token ,$(unused_tokens)) \
+
+MENHIRFLAGS := \
+ $(MENHIRBASICFLAGS) \
+ --infer \
+ --ocamlc "$(CAMLC) $(COMPFLAGS)" \
+ --fixed-exception \
+ --table \
+ --strategy simplified \
## promote-menhir
partialclean-menhir::
rm -f \
$(addprefix parsing/parser.,ml mli) \
- $(addprefix parsing/camlinternalMenhirLib.,ml mli)
+ $(addprefix parsing/camlinternalMenhirLib.,ml mli) \
+ $(addprefix parsing/parser.,automaton conflicts) \
+ $(addprefix parsing/parser.,auto.messages) \
clean-menhir: partialclean-menhir
interpret-menhir:
@ echo "Please wait, I am building the LALR automaton..."
- @ $(MENHIR) $(MENHIRFLAGS) parsing/parser.mly \
+ @ $(MENHIR) $(MENHIRBASICFLAGS) parsing/parser.mly \
--interpret \
--interpret-show-cst \
--trace \
+
+## list-parse-errors
+
+# This rule runs Menhir's reachability analysis, which produces a list of all
+# states where a syntax error can be detected (and a corresponding list of of
+# erroneous sentences). This data is stored in parsing/parser.auto.messages.
+# This analysis requires about 3 minutes and 6GB of RAM.
+
+# The analysis is performed on a copy of the grammar where every block
+# of text comprised between the markers BEGIN AVOID and END AVOID has
+# been removed. This allows us to avoid certain syntactic forms in the
+# sentences that we produce. See parser.mly for more explanations.
+
+# Because of this, we must run Menhir twice: once on a modified copy of the
+# grammar to produce the sentences, and once on the original grammar to update
+# the auto-comments (which would otherwise be incorrect).
+
+.PHONY: list-parse-errors
+list-parse-errors:
+ @ tmp=`mktemp -d /tmp/parser.XXXX` && \
+ sed -e '/BEGIN AVOID/,/END AVOID/d' \
+ parsing/parser.mly > $$tmp/parser.mly && \
+ $(MENHIR) $(MENHIRBASICFLAGS) $$tmp/parser.mly \
+ --list-errors -la 2 \
+ > parsing/parser.auto.messages && \
+ rm -rf $$tmp
+ @ cp parsing/parser.auto.messages parsing/parser.auto.messages.bak
+ @ $(MENHIR) $(MENHIRBASICFLAGS) parsing/parser.mly \
+ --update-errors parsing/parser.auto.messages.bak \
+ > parsing/parser.auto.messages
+ @ rm -f parsing/parser.auto.messages.bak
+
+## generate-parse-errors
+
+# This rule assumes that [make list-parse-errors] has been run first.
+
+# This rule turns the error sentences stored in parsing/parser.auto.messages
+# into one .ml file.
+
+# (It would in principle be preferable to create one file per sentence, but
+# that would be much slower. We abuse the ability of the OCaml toplevel to
+# resynchronize after an error, and put all sentences into a single file.)
+
+# This requires Menhir 20201214 or newer.
+
+GPE_DIR := tests/generated-parse-errors
+GPE_ML := errors.ml
+GPE_REF := errors.compilers.reference
+GPE_START := implementation use_file toplevel_phrase
+
+.PHONY: generate-parse-errors
+generate-parse-errors:
+ @ \
+ mkdir -p testsuite/$(GPE_DIR) && \
+ $(MENHIR) $(MENHIRBASICFLAGS) parsing/parser.mly \
+ --echo-errors-concrete parsing/parser.auto.messages 2>/dev/null | \
+ (cd testsuite/$(GPE_DIR) && touch $(GPE_REF) && ( \
+ echo "(* TEST\n * toplevel\n*)" && \
+ while IFS= read -r symbolic ; do \
+ IFS= read -r concrete ; \
+ concrete=$${concrete#### Concrete syntax: } ; \
+ : '$$symbolic is the sentence in symbolic form' ; \
+ : '$$concrete is the sentence in concrete form' ; \
+ case "$$symbolic" in \
+ *": SEMISEMI"*) \
+ : 'If the sentence begins with SEMISEMI, ignore it. Our hack' ; \
+ : 'does not support these sentences, and there are only 6 of' ; \
+ : 'them anyway.' ; \
+ continue ;; \
+ *) \
+ case "$$symbolic" in \
+ *"EOF") \
+ : 'If the sentence ends with EOF, replace it on the fly' ; \
+ : 'with some other token (say, WHEN).' ; \
+ echo "#0 \"$${symbolic%%EOF}WHEN\"" ; \
+ echo "$$concrete when" ; \
+ echo ";;" ;; \
+ *) \
+ : 'Emit a # directive containing the symbolic sentence.' ; \
+ echo "#0 \"$$symbolic\"" ; \
+ : 'Emit the concrete sentence.' ; \
+ echo "$$concrete" ; \
+ : 'Emit a double semicolon to allow resynchronization.' ; \
+ echo ";;" ;; \
+ esac \
+ esac \
+ done) \
+ > $(GPE_ML) && \
+ : 'Count how many sentences we have emitted, per start symbol.' ; \
+ for symbol in $(GPE_START) ; do \
+ count=$$(grep -h -e "$$symbol:" $(GPE_ML) | wc -l) && \
+ echo "$$count sentences whose start symbol is $$symbol." ; \
+ done \
+ )
+ @ \
+ read -p "Re-generate the expected output for this test? " -n 1 -r && \
+ echo && \
+ if [[ $$REPLY =~ ^[Yy]$$ ]] ; then \
+ make -C testsuite promote DIR=$(GPE_DIR) >/dev/null 2>&1 && \
+ echo "Done." ; \
+ make classify-parse-errors ; \
+ else \
+ echo "OK, stop." ; \
+ fi
+
+.PHONY: classify-parse-errors
+classify-parse-errors:
+ @ ( \
+ cd testsuite/$(GPE_DIR) && \
+ echo "The parser's output can be described as follows:" && \
+ c=$$(grep "^Error: Syntax error" $(GPE_REF) | wc -l) && \
+ echo "$${c} syntax errors reported." && \
+ c=$$(grep "^Error: Syntax error$$" $(GPE_REF) | wc -l) && \
+ echo "$${c} errors without an explanation." && \
+ c=$$(grep "^Error: Syntax" $(GPE_REF) | grep expected | wc -l) && \
+ echo "$${c} errors with an indication of what was expected." && \
+ c=$$(grep "might be unmatched" $(GPE_REF) | wc -l) && \
+ echo "$${c} errors with an indication of an unmatched delimiter." && \
+ true)
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Xavier Clerc, SED, INRIA Rocquencourt *
-#* *
-#* Copyright 2010 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This makefile provides variables for using the in-tree compiler,
-# interpreter, lexer and other associated tools. It is intended to be
-# included within other makefiles.
-# See manual/tools/Makefile and manual/manual/tutorials/Makefile as examples.
-# Note that these makefile should define the $(TOPDIR) variable on their
-# own.
-
-WINTOPDIR=`cygpath -m "$(TOPDIR)"`
-
-# TOPDIR is the root directory of the OCaml sources, in Unix syntax.
-# WINTOPDIR is the same directory, in Windows syntax.
-
-OTOPDIR=$(TOPDIR)
-CTOPDIR=$(TOPDIR)
-CYGPATH=echo
-DIFF=diff -q
-SORT=sort
-SET_LD_PATH=CAML_LD_LIBRARY_PATH="$(LD_PATH)"
-
-# The variables above may be overridden by .../Makefile.config
-# OTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
-# arguments given to the OCaml compiler.
-# CTOPDIR is either TOPDIR or WINTOPDIR, whichever is appropriate for
-# arguments given to the C and Fortran compilers.
-# CYGPATH is the command that translates unix-style file names into
-# whichever syntax is appropriate for arguments of OCaml programs.
-# DIFF is a "diff -q" command that ignores trailing CRs under Windows.
-# SORT is the Unix "sort" command. Usually a simple command, but may be an
-# absolute name if the Windows "sort" command is in the PATH.
-# SET_LD_PATH is a command prefix that sets the path for dynamic libraries
-# (CAML_LD_LIBRARY_PATH for Unix, PATH for Windows) using the LD_PATH shell
-# variable. Note that for Windows we add Unix-syntax directory names in
-# PATH, and Cygwin will translate it to Windows syntax.
-
-# TOPDIR is legacy, our makefiles should use ROOTDIR now
-ROOTDIR=$(TOPDIR)
-include $(ROOTDIR)/Makefile.config_if_required
-
-# Make sure USE_RUNTIME is defined
-USE_RUNTIME ?=
-
-ifneq ($(USE_RUNTIME),)
-#Check USE_RUNTIME value
-ifeq ($(findstring $(USE_RUNTIME),d i),)
-$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) \
- or "i" (instrumented runtime))
-endif
-
-RUNTIME_VARIANT=-I $(OTOPDIR)/runtime \
- -runtime-variant $(USE_RUNTIME)
-export OCAMLRUNPARAM?=v=0
-endif
-
-OCAMLRUN=$(TOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE)
-
-OCFLAGS=-nostdlib -I $(OTOPDIR)/stdlib $(COMPFLAGS)
-OCOPTFLAGS=
-
-ifeq ($(SUPPORTS_SHARED_LIBRARIES),false)
- CUSTOM = -custom
-else
- CUSTOM =
-endif
-
-OCAML=$(OCAMLRUN) $(OTOPDIR)/ocaml$(EXE) $(OCFLAGS) -noinit
-ifeq "$(FLEXLINK)" ""
- FLEXLINK_PREFIX=
-else
- ifeq "$(wildcard $(TOPDIR)/flexdll/Makefile)" ""
- FLEXLINK_PREFIX=
- else
- EMPTY=
- FLEXLINK_PREFIX=OCAML_FLEXLINK="$(WINTOPDIR)/boot/ocamlrun$(EXE) \
- $(WINTOPDIR)/flexdll/flexlink.exe" $(EMPTY)
- endif
-endif
-OCAMLC=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlc$(EXE) \
- $(CUSTOM) $(OCFLAGS) $(RUNTIME_VARIANT)
-OCAMLOPT=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/ocamlopt$(EXE) $(OCFLAGS) \
- $(RUNTIME_VARIANT)
-OCAMLDOC=$(OCAMLRUN) $(OTOPDIR)/ocamldoc/ocamldoc$(EXE)
-OCAMLLEX=$(OCAMLRUN) $(OTOPDIR)/lex/ocamllex$(EXE)
-OCAMLMKLIB=$(FLEXLINK_PREFIX)$(OCAMLRUN) $(OTOPDIR)/tools/ocamlmklib$(EXE) \
- -ocamlc "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
- $(OTOPDIR)/ocamlc$(EXE) $(OCFLAGS) $(RUNTIME_VARIANT)" \
- -ocamlopt "$(OTOPDIR)/runtime/ocamlrun$(USE_RUNTIME)$(EXE) \
- $(OTOPDIR)/ocamlopt$(EXE) $(OCFLAGS) $(RUNTIME_VARIANT)"
-OCAMLYACC=$(TOPDIR)/yacc/ocamlyacc$(EXE)
-DUMPOBJ=$(OCAMLRUN) $(OTOPDIR)/tools/dumpobj$(EXE)
-OBJINFO=$(OCAMLRUN) $(OTOPDIR)/tools/ocamlobjinfo$(EXE)
-
-#FORTRAN_COMPILER=
-#FORTRAN_LIBRARY=
-
-UNIXLIBVAR=`case "$(OTHERLIBRARIES)" in *win32unix*) echo win32;; esac`
|=====
-| Branch `trunk` | Branch `4.11` | Branch `4.10` | Branch `4.09` | Branch `4.08` | Branch `4.07` | Branch `4.06` | Branch `4.05`
+| Branch `trunk` | Branch `4.12` | Branch `4.11` | Branch `4.10`
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=trunk["TravisCI Build Status (trunk branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
+| image:https://github.com/ocaml/ocaml/workflows/Build/badge.svg?branch=trunk["Github CI Build Status (trunk branch)",
+ link="https://github.com/ocaml/ocaml/actions?query=workflow%3ABuild"]
+ image:https://github.com/ocaml/ocaml/workflows/Hygiene/badge.svg?branch=trunk["Github CI Hygiene Status (trunk branch)",
+ link="https://github.com/ocaml/ocaml/actions?query=workflow%3AHygiene"]
image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=trunk&svg=true["AppVeyor Build Status (trunk branch)",
link="https://ci.appveyor.com/project/avsm/ocaml"]
+| image:https://github.com/ocaml/ocaml/workflows/main/badge.svg?branch=4.12["Github CI Build Status (4.12 branch)",
+ link="https://github.com/ocaml/ocaml/actions?query=workflow%3Amain"]
+ image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.12&svg=true["AppVeyor Build Status (4.12 branch)",
+ link="https://ci.appveyor.com/project/avsm/ocaml"]
| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.11["TravisCI Build Status (4.11 branch)",
link="https://travis-ci.org/ocaml/ocaml"]
image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.11&svg=true["AppVeyor Build Status (4.11 branch)",
link="https://travis-ci.org/ocaml/ocaml"]
image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.10&svg=true["AppVeyor Build Status (4.10 branch)",
link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.09["TravisCI Build Status (4.09 branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
- image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.09&svg=true["AppVeyor Build Status (4.09 branch)",
- link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.08["TravisCI Build Status (4.08 branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
- image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.08&svg=true["AppVeyor Build Status (4.08 branch)",
- link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.07["TravisCI Build Status (4.07 branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
- image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.07&svg=true["AppVeyor Build Status (4.07 branch)",
- link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.06["TravisCI Build Status (4.06 branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
- image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.06&svg=true["AppVeyor Build Status (4.06 branch)",
- link="https://ci.appveyor.com/project/avsm/ocaml"]
-| image:https://travis-ci.org/ocaml/ocaml.svg?branch=4.05["TravisCI Build Status (4.05 branch)",
- link="https://travis-ci.org/ocaml/ocaml"]
- image:https://ci.appveyor.com/api/projects/status/github/ocaml/ocaml?branch=4.05&svg=true["AppVeyor Build Status (4.05 branch)",
- link="https://ci.appveyor.com/project/avsm/ocaml"]
|=====
= README =
== Overview
-OCaml is an implementation of the ML language, based on the Caml Light
-dialect extended with a complete class-based object system and a powerful
-module system in the style of Standard ML.
+OCaml is a functional, statically-typed programming language from the
+ML family, offering a powerful module system extending that of
+Standard ML and a feature-rich, class-based object system.
OCaml comprises two compilers. One generates bytecode which is then
-interpreted by a C program. This compiler runs quickly, generates compact
-code with moderate memory requirements, and is portable to essentially any
-32 or 64 bit Unix platform. Performance of generated programs is quite good
-for a bytecoded implementation. This compiler can be used either as a
-standalone, batch-oriented compiler that produces standalone programs, or as
-an interactive, toplevel-based system.
+interpreted by a C program. This compiler runs quickly, generates
+compact code with moderate memory requirements, and is portable to
+many 32 or 64 bit platforms. Performance of generated programs is
+quite good for a bytecoded implementation. This compiler can be used
+either as a standalone, batch-oriented compiler that produces
+standalone programs, or as an interactive REPL system.
The other compiler generates high-performance native code for a number of
processors. Compilation takes longer and generates bigger code, but the
| ARM 64 bits | Linux, macOS | FreeBSD
| ARM 32 bits | Linux | FreeBSD, NetBSD, OpenBSD
| Power 64 bits | Linux |
-| Power 32 bits | | Linux
+| Power 32 bits | Linux |
| RISC-V 64 bits | Linux |
| IBM Z (s390x) | Linux |
|====
== Copyright
All files marked "Copyright INRIA" in this distribution are
-Copyright (C) 1996-2020 Institut National de Recherche en Informatique et
+Copyright (C) 1996-2021 Institut National de Recherche en Informatique et
en Automatique (INRIA) and distributed under the conditions stated in
file LICENSE.
== Installation
See the file link:INSTALL.adoc[] for installation instructions on
-machines running Unix, Linux, OS X and Cygwin. For native Microsoft
+machines running Unix, Linux, macOS and Cygwin. For native Microsoft
Windows, see link:README.win32.adoc[].
== Documentation
== Keeping in Touch with the Caml Community
+There is an active and friendly discussion forum at
+
+https://discuss.ocaml.org/
+
The OCaml mailing list is the longest-running forum for OCaml users.
You can email it at
https://inbox.ocaml.org/
-You can also access a newer discussion forum at
-
-https://discuss.ocaml.org/
-
There also exist other mailing lists, chat channels, and various other forums
around the internet for getting in touch with the OCaml and ML family language
community. These can be accessed at
Only the `make` Cygwin package is required. `diffutils` is required if you wish
to be able to run the test suite.
-Unless you are also compiling the Cygwin port of OCaml, you should not install
-the `gcc-core` or `flexdll` packages. If you do, care may be required to ensure
-that a particular build is using the correct installation of `flexlink`.
+Unless you are also compiling the Cygwin port of OCaml, you do not need the
+`gcc-core` or `flexdll` packages. If you do install them, care may be required
+to ensure that a particular build is using the correct installation of
+`flexlink`.
[[bmflex]]
In addition to Cygwin, FlexDLL must also be installed, which is available from
install FlexDLL is included in your `PATH` environment variable. Note: binary
distributions of FlexDLL are compatible only with Visual Studio 2013 and
earlier; for Visual Studio 2015 and later, you will need to compile the C
-objects from source, or build ocaml using the flexdll target.
+objects from source, or configure ocaml with the `--with-flexdll` option.
The base bytecode system (ocamlc, ocaml, ocamllex, ocamlyacc, ...) of all three
ports runs without any additional tools.
for 32-bit, or:
- ./configure --build=x86_64-unknown-cygwin --host=x86_64-pc-windows
+ ./configure --build=x86_64-pc-cygwin --host=x86_64-pc-windows
for 64-bit.
`mingw64-i686-gcc-core` package for 32-bit and the `mingw64-x86_64-gcc-core`
package for 64-bit.
- - Do not try to use the Cygwin version of flexdll for this port.
+ - The Cygwin version of flexdll does not work with this port.
- The standalone mingw toolchain from the Mingw-w64 project
(http://mingw-w64.org/) is not supported. Please use the version packaged in
for 32-bit, or:
- ./configure --build=x86_64-unknown-cygwin --host=x86_64-w64-mingw32
+ ./configure --build=x86_64-pc-cygwin --host=x86_64-w64-mingw32
for 64-bit.
to build entirely from sources. Since OCaml 4.03 and FlexDLL 0.35, it is now
possible to bootstrap the two programs simultaneously. The process is identical
for both ports. If you choose to compile this way, it is not necessary to
-install FlexDLL separately -- indeed, if you do install FlexDLL separately, you
-may need to be careful to ensure that `ocamlopt` picks up the correct `flexlink`
-in your `PATH`.
+install FlexDLL separately.
-You must place the FlexDLL sources for Version 0.35 or later in the directory
+You must extract the FlexDLL sources for Version 0.35 or later in the directory
`flexdll/` at the top-level directory of the OCaml distribution. This can be
done in one of three ways:
+
git submodule update --init
-OCaml is then compiled as normal for the port you require, except that before
-building the compiler itself, you must compile `flexdll`, i.e.:
+OCaml is then compiled normally for the port you require.
- make flexdll
make
- make flexlink.opt
make install
- * You should ignore the error messages that say ocamlopt was not found.
* `make install` will install FlexDLL by placing `flexlink.exe`
(and the default manifest file for the Microsoft port) in `bin/` and the
FlexDLL object files in `lib/`.
- * If you don't include `make flexlink.opt`, `flexlink.exe` will be a
- bytecode program. `make install` always installs the "best"
- `flexlink.exe` (i.e. there is never a `flexlink.opt.exe` installed).
- * If you have populated `flexdll/`, you *must* run
- `make flexdll`. If you wish to revert to using an externally
- installed FlexDLL, you must erase the contents of `flexdll/` before
- compiling.
+ * If you have populated `flexdll/`, the build will always use it, ignoring
+ any externally installed FlexDLL. You can override this behaviour by either
+ erasing the contents of `flexdll/` or passing the `--without-flexdll` option
+ to `configure`.
== Unicode support
-4.12.1
+4.13.0
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli
#endif]
)],
[AC_CACHE_VAL([ocaml_cv_cc_vendor],
- [ocaml_cv_cc_vendor=`grep ['^[a-z]'] conftest.i | tr -s ' ' '-'`])],
+ [ocaml_cv_cc_vendor=`grep ['^[a-z]'] conftest.i | tr -s ' ' '-' \
+ | tr -d '\r'`])],
[AC_MSG_FAILURE([unexpected preprocessor failure])])
AC_MSG_RESULT([$ocaml_cv_cc_vendor])
])
saved_CC="$CC"
saved_CFLAGS="$CFLAGS"
saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
saved_ac_ext="$ac_ext"
saved_ac_compile="$ac_compile"
# Move the content of confdefs.h to another file so it does not
CPPFLAGS="$saved_CPPFLAGS"
CFLAGS="$saved_CFLAGS"
CC="$saved_CC"
+ LIBS="$saved_LIBS"
])
AC_DEFUN([OCAML_AS_HAS_DEBUG_PREFIX_MAP], [
LDFLAGS="$SAVED_LDFLAGS"
CFLAGS="$SAVED_CFLAGS"
])
+
+AC_DEFUN([OCAML_TEST_FLEXLINK], [
+ OCAML_CC_SAVE_VARIABLES
+
+ AC_MSG_CHECKING([whether $1 works])
+
+ AC_COMPILE_IFELSE(
+ [AC_LANG_SOURCE([int answer = 42;])],
+ [# Create conftest1.$ac_objext as a symlink on Cygwin to ensure that native
+ # flexlink can cope. The reverse test is unnecessary (a Cygwin-compiled
+ # flexlink can read anything).
+ mv conftest.$ac_objext conftest1.$ac_objext
+ AS_CASE([$4],[*-pc-cygwin],
+ [ln -s conftest1.$ac_objext conftest2.$ac_objext],
+ [cp conftest1.$ac_objext conftest2.$ac_objext])
+
+ CC="$1 -chain $2 -exe"
+ LIBS="conftest2.$ac_objext"
+ CPPFLAGS="$3 $CPPFLAGS"
+ AC_LINK_IFELSE(
+ [AC_LANG_SOURCE([int main() { return 0; }])],
+ [AC_MSG_RESULT([yes])],
+ [AC_MSG_RESULT([no])
+ AC_MSG_ERROR([$1 does not work])])],
+ [AC_MSG_RESULT([unexpected compile error])
+ AC_MSG_ERROR([error calling the C compiler])])
+
+ OCAML_CC_RESTORE_VARIABLES
+])
+
+AC_DEFUN([OCAML_TEST_FLEXDLL_H], [
+ OCAML_CC_SAVE_VARIABLES
+
+ AS_IF([test -n "$1"],[CPPFLAGS="-I $1 $CPPFLAGS"])
+ have_flexdll_h=no
+ AC_CHECK_HEADER([flexdll.h],[have_flexdll_h=yes],[have_flexdll_h=no])
+ AS_IF([test x"$have_flexdll_h" = 'xno'],
+ [AS_IF([test -n "$1"],
+ [AC_MSG_ERROR([$1/flexdll.h appears unusable])])])
+
+ OCAML_CC_RESTORE_VARIABLES
+])
+
+AC_DEFUN([OCAML_TEST_FLEXLINK_WHERE], [
+ OCAML_CC_SAVE_VARIABLES
+
+ AC_MSG_CHECKING([if "$1 -where" includes flexdll.h])
+ flexlink_where="$($1 -where | tr -d '\r')"
+ CPPFLAGS="$CPPFLAGS -I \"$flexlink_where\""
+ cat > conftest.c <<"EOF"
+#include <flexdll.h>
+int main (void) {return 0;}
+EOF
+ cat > conftest.Makefile <<EOF
+all:
+ $CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.c $LIBS
+EOF
+ AS_IF([make -f conftest.Makefile >/dev/null 2>/dev/null],
+ [have_flexdll_h=yes
+ AC_MSG_RESULT([yes])],
+ [AC_MSG_RESULT([no])])
+
+ OCAML_CC_RESTORE_VARIABLES
+])
+
+AC_DEFUN([OCAML_HOST_IS_EXECUTABLE], [
+ AC_MSG_CHECKING([whether host executables can be run in the build])
+ old_cross_compiling="$cross_compiling"
+ cross_compiling='no'
+ AC_RUN_IFELSE(
+ [AC_LANG_SOURCE([[int main (void) {return 0;}]])],
+ [AC_MSG_RESULT([yes])
+ host_runnable=true],
+ [AC_MSG_RESULT([no])
+ host_runnable=false],
+ # autoconf displays a warning if this parameter is missing, but
+ # cross-compilation mode was disabled above.
+ [assert=false])
+ cross_compiling="$old_cross_compiling"
+])
+
+# This is AC_RUN_IFELSE but taking $host_runnable into account (i.e. if the
+# program can be run, then it is run)
+AC_DEFUN([OCAML_RUN_IFELSE], [
+ old_cross_compiling="$cross_compiling"
+ AS_IF([test "x$host_runnable" = 'xtrue'], [cross_compiling='no'])
+ AC_RUN_IFELSE([$1],[$2],[$3],[$4])
+ cross_compiling="$old_cross_compiling"
+])
+
+AC_DEFUN([OCAML_C99_CHECK_ROUND], [
+ AC_MSG_CHECKING([whether round works])
+ OCAML_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <math.h>
+int main (void) {
+ static volatile double d = 0.49999999999999994449;
+ return (fpclassify(round(d)) != FP_ZERO);
+}
+ ]])],
+ [AC_MSG_RESULT([yes])
+ AC_DEFINE([HAS_WORKING_ROUND])],
+ [AC_MSG_RESULT([no])
+ AS_CASE([$enable_imprecise_c99_float_ops,$target],
+ [no,*], [hard_error=true],
+ [yes,*], [hard_error=false],
+ [*,x86_64-w64-mingw32], [hard_error=false],
+ [hard_error=true])
+ AS_IF([test x"$hard_error" = "xtrue"],
+ [AC_MSG_ERROR(m4_normalize([
+ round does not work, enable emulation with
+ --enable-imprecise-c99-float-ops]))],
+ [AC_MSG_WARN(m4_normalize([
+ round does not work; emulation enabled]))])],
+ [AS_CASE([$target],
+ [x86_64-w64-mingw32],[AC_MSG_RESULT([cross-compiling; assume not])],
+ [AC_MSG_RESULT([cross-compiling; assume yes])
+ AC_DEFINE([HAS_WORKING_ROUND])])])
+])
+
+AC_DEFUN([OCAML_C99_CHECK_FMA], [
+ AC_MSG_CHECKING([whether fma works])
+ OCAML_RUN_IFELSE(
+ [AC_LANG_SOURCE([[
+#include <math.h>
+int main (void) {
+ /* Tests 264-266 from testsuite/tests/fma/fma.ml. These tests trigger the
+ broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
+ The static volatile variables aim to thwart GCC's constant folding. */
+ static volatile double x, y, z;
+ double t264, t265, t266;
+ x = 0x3.bd5b7dde5fddap-496;
+ y = 0x3.bd5b7dde5fddap-496;
+ z = -0xd.fc352bc352bap-992;
+ t264 = fma(x, y, z);
+ x = 0x3.bd5b7dde5fddap-504;
+ y = 0x3.bd5b7dde5fddap-504;
+ z = -0xd.fc352bc352bap-1008;
+ t265 = fma(x, y, z);
+ x = 0x8p-540;
+ y = 0x4p-540;
+ z = 0x4p-1076;
+ t266 = fma(x, y, z);
+ return (!(t264 == 0x1.0989687cp-1044 ||
+ t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
+ t264 == 0x0.00000428p-1022)
+ || !(t265 == 0x1.0988p-1060 ||
+ t265 == 0x0.0000000004278p-1022 || /* Acceptable emulated values */
+ t265 == 0x0.000000000428p-1022)
+ || !(t266 == 0x8p-1076));
+}
+ ]])],
+ [AC_MSG_RESULT([yes])
+ AC_DEFINE([HAS_WORKING_FMA])],
+ [AC_MSG_RESULT([no])
+ AS_CASE([$enable_imprecise_c99_float_ops,$target],
+ [no,*], [hard_error=true],
+ [yes,*], [hard_error=false],
+ [*,x86_64-w64-mingw32|*,x86_64-*-cygwin*], [hard_error=false],
+ [AS_CASE([$ocaml_cv_cc_vendor],
+ [msvc-*], [AS_IF([test "${ocaml_cv_cc_vendor#msvc-}" -lt 1920 ],
+ [hard_error=false],
+ [hard_error=true])],
+ [hard_error=true])])
+ AS_IF([test x"$hard_error" = "xtrue"],
+ [AC_MSG_ERROR(m4_normalize([
+ fma does not work, enable emulation with
+ --enable-imprecise-c99-float-ops]))],
+ [AC_MSG_WARN(m4_normalize([
+ fma does not work; emulation enabled]))])],
+ [AS_CASE([$target],
+ [x86_64-w64-mingw32|x86_64-*-cygwin*],
+ [AC_MSG_RESULT([cross-compiling; assume not])],
+ [AC_MSG_RESULT([cross-compiling; assume yes])
+ AC_DEFINE([HAS_WORKING_FMA])])])
+])
--- /dev/null
+{1 Warning}
+ This library is part of the internal OCaml compiler API, and is
+not the language standard library.
+ There are no compatibility guarantees between releases, so code written
+against these modules must be willing to depend on specific OCaml compiler
+versions.
--- /dev/null
+{1 Principles}
+
+Line breaking is based on three concepts:
+
+{ul {- {b boxes} : a box is a logical pretty-printing unit, which
+ defines a behaviour of the pretty-printing engine to display the
+ material inside the box.}
+ {- {b break hints}: a break hint is a directive to the
+ pretty-printing engine that proposes to break the line here, if it is
+ necessary to properly print the rest of the material.
+ Otherwise, the pretty-printing engine never break lines (except
+ "in case of emergency" to avoid very bad output).
+ In short, a break hint tells the pretty printer that a line break here
+ may be appropriate.}
+ {- {b indentation rules}:
+ When a line break occurs, the pretty-printing engines fixes the
+ indentation (or amount of leading spaces) of the new line using
+ indentation rules, as follows:
+ {ul {- A box can state the extra indentation of every new line opened in
+ its scope. This extra indentation is named
+ {b box breaking indentation}.}
+ {- A break hint can also set the additional indentation of the new line
+ it may fire. This extra indentation is named {b hint breaking
+ indentation}.}
+ {- If break hint [bh] fires a new line within box
+ [b], then the indentation of the new line is simply the sum of:
+ the current indentation of box [b]
+ +
+ the additional box breaking indentation, as defined by box [b]
+ +
+ the additional hint breaking indentation, as defined by break
+ hint [bh].}}}}
+
+{1 Boxes}
+
+There are 4 types of boxes. (The most often used is the "hov" box type, so skip
+the rest at first reading).
+
+ - {b horizontal box} ({i h} box, as obtained by the
+ {!open_hbox} procedure): within this box, break hints do not
+ lead to line breaks.
+ - {b vertical box} ({i v} box, as obtained by the
+ {!open_vbox} procedure): within this box, every break hint lead
+ to a new line.
+ - {b vertical/horizontal box} ({i hv} box, as obtained by
+ the {!open_hvbox} procedure): if it is possible, the entire box
+ is written on a single line; otherwise, every break hint within the box
+ leads to a new line.
+ - {b vertical or horizontal box} ({i hov} box, as obtained
+ by the {!open_box} or {!open_hovbox} procedures): within this box, break
+ hints are used to cut the line when there is no more room on the line.
+ There are two kinds of "hov" boxes, you can find the details
+ below. In first approximation, let me
+ consider these two kinds of "hov" boxes as equivalent and
+ obtained by calling the {!open_box} procedure.
+
+Let me give an example. Suppose we can write 10 chars before
+the right margin (that indicates no more room). We represent any
+char as a [-] sign; characters [\[] and [\]]
+indicates the opening and closing of a box and [b] stands
+for a break hint given to the pretty-printing engine.
+
+The output "--b--b--" is displayed like this (the [b] symbol
+stands for the value of the break that is explained below):
+
+Within a "h" box:
+
+{[
+--b--b--
+]}
+
+Within a "v" box:
+
+{[
+--b
+--b
+--
+]}
+
+Within a "hv" box:
+
+If there is enough room to print the box on the line:
+
+{[
+--b--b--
+]}
+
+But "---b---b---" that cannot fit on the line is written
+
+{[
+---b
+---b
+---
+]}
+
+Within a "hov" box:
+
+If there is enough room to print the box on the line:
+
+{[
+--b--b--
+]}
+
+But if "---b---b---" cannot fit on the line, it is written as
+
+{[
+---b---b
+---
+]}
+
+The first break hint does not lead to a new line, since there is enough room on
+the line. The second one leads to a new line since there is no more room to
+print the material following it. If the room left on the line were even
+shorter, the first break hint may lead to a new line and "---b---b---" is
+written as:
+
+{[
+---b
+---b
+---
+]}
+
+{1 Printing spaces}
+
+Break hints are also used to output spaces (if the line is not split when the
+break is encountered, otherwise the new line indicates properly the separation
+between printing items). You output a break hint using [print_break sp indent],
+and this sp integer is used to print "sp" spaces. Thus [print_break sp ...] may
+be thought as: print [sp] spaces or output a new line.
+
+For instance, if b is [break 1 0] in the output "--b--b--", we get
+
+within a "h" box:
+
+{[
+-- -- --
+]}
+
+within a "v" box:
+
+{[
+--
+--
+--
+]}
+
+within a "hv" box:
+{[
+-- -- --
+]}
+
+or, according to the remaining room on the line:
+
+{[
+--
+--
+--
+]}
+
+and similarly for "hov" boxes.
+
+Generally speaking, a printing routine using "format", should not directly
+output white spaces: the routine should use break hints instead. (For instance
+[print_space ()] that is a convenient abbreviation for [print_break 1 0] and
+outputs a single space or break the line.)
+
+{1 Indentation of new lines}
+
+The user gets 2 ways to fix the indentation of new lines:
+
+{b When defining the box}: when you open a box, you can fix the indentation
+added to each new line opened within that box.
+
+For instance: [open_hovbox 1] opens a "hov" box with new lines indented 1 more
+than the initial indentation of the box. With output "---\[--b--b--b--", we
+get:
+
+{[
+---\[--b--b
+ --b--
+]}
+
+with open_hovbox 2, we get
+
+{[
+---\[--b--b
+ --b--
+]}
+
+Note: the \[ sign in the display is not visible on the screen, it is just there
+to materialise the aperture of the pretty-printing box. Last "screen" stands
+for:
+
+{[
+-----b--b
+ --b--
+]}
+
+{b When defining the break that makes the new line}. As said above, you output
+a break hint using [print_break sp indent]. The [indent] integer is used to fix
+the additional indentation of the new line. Namely, it is added to the default
+indentation offset of the box where the break occurs.
+
+For instance, if \[ stands for the opening of a "hov" box with 1 as extra
+indentation (as obtained by [open_hovbox 1]), and b is [print_break 1 2], then
+ from output "---\[--b--b--b--", we get:
+
+{[
+ ---\[-- --
+ --
+ --
+]}
+
+{1 Refinement on "hov" boxes}
+
+The "hov" box type is refined into two categories.
+
+- {b the vertical or horizontal {i packing} box} (as obtained by the
+{!open_hovbox} procedure): break hints are used to cut the line when there is no
+more room on the line; no new line occurs if there is enough room on the line.
+- {b vertical or horizontal {i structural} box} (as obtained by the {!open_box}
+procedure): similar to the "hov" packing box, the break hints are used to cut
+the line when there is no more room on the line; in addition, break hints that
+can show the box structure lead to new lines even if there is enough room on
+the current line.
+
+The difference between a packing and a structural "hov" box is shown by a
+routine that closes boxes and parentheses at the end of printing: with packing
+boxes, the closure of boxes and parentheses do not lead to new lines if there
+is enough room on the line, whereas with structural boxes each break hint will
+lead to a new line. For instance, when printing
+"\[(---\[(----\[(---b)\]b)\]b)\]", where "b" is a break hint without extra
+indentation ([print_cut ()]). If "\[" means opening of a packing "hov" box
+({!open_hovbox}), "\[(---\[(----\[(---b)\]b)\]b)\]" is printed as follows:
+
+{[
+(---
+ (----
+ (---)))
+]}
+
+If we replace the packing boxes by structural boxes ({!open_box}), each break
+hint that precedes a closing parenthesis can show the boxes structure, if it
+leads to a new line; hence "\[(---\[(----\[(---b)\]b)\]b)\]" is printed like
+this:
+
+{[
+(---
+ (----
+ (---
+ )
+ )
+)
+]}
+
+{1 Practical advice}
+
+When writing a pretty-printing routine, follow these simple rules:
+
++ Boxes must be opened and closed consistently ([open_*] and {!close_box} must
+be nested like parentheses).
++ Never hesitate to open a box.
++ Output many break hints, otherwise the pretty-printer is in a bad situation
+where it tries to do its best, which is always "worse than your bad".
++ Do not try to force spacing using explicit spaces in the character strings.
+For each space you want in the output emit a break hint ([print_space ()]),
+unless you explicitly don't want the line to be broken here. For instance,
+imagine you want to pretty print an OCaml definition, more precisely a [let rec
+ident = expression] value definition. You will probably treat the first three
+spaces as "unbreakable spaces" and write them directly in the string constants
+for keywords, and print ["let rec"] before the identifier, and similarly write
+[=] to get an unbreakable space after the identifier; in contrast, the space
+after the [=] sign is certainly a break hint, since breaking the line after [=]
+is a usual (and elegant) way to indent the expression part of a definition. In
+short, it is often necessary to print unbreakable spaces; however, most of the
+time a space should be considered a break hint.
++ Do not try to force new lines, let the pretty-printer do it for you: that's
+its only job. In particular, do not use {!force_newline}: this procedure
+effectively leads to a newline, but it also as the unfortunate side effect to
+partially reinitialise the pretty-printing engine, so that the rest of the
+printing material is noticeably messed up.
++ Never put newline characters directly in the strings to be printed: pretty
+printing engine will consider this newline character as any other character
+written on the current line and this will completely mess up the output.
+Instead of new line characters use line break hints: if those break hints must
+always result in new lines, it just means that the surrounding box must be a
+vertical box!
++ End your main program by a [print_newline ()] call, that flushes the
+pretty-printer tables (hence the output). (Note that the top-level loop of the
+interactive system does it as well, just before a new input.)
+
+{1 Printing to stdout: using printf}
+
+The format module provides a general printing facility "a la" printf. In
+addition to the usual conversion facility provided by printf, you can write
+pretty-printing indications directly inside the format string (opening and
+closing boxes, indicating breaking hints, etc).
+
+Pretty-printing annotations are introduced by the [@] symbol, directly into the
+string format. Almost any function of the [Format] module can be called from
+within a [printf] format string. For instance
+
+- "[@\[]" open a box (open_box 0). You may precise the type as an extra
+argument. For instance [@\[<hov n>] is equivalent to [open_hovbox n].
+- "[@\]]" close a box ([close_box ()]).
+- "[@ ]" output a breakable space ([print_space ()]).
+- "[@,]" output a break hint ([print_cut ()]).
+- "[@;<n m>]" emit a "full" break hint ([print_break n m]).
+- "[@.]" end the pretty-printing, closing all the boxes still opened
+([print_newline ()]).
+
+For instance
+
+{v
+printf "@\[<1>%s@ =@ %d@ %s@\]@." "Prix TTC" 100 "Euros";;
+Prix TTC = 100 Euros
+- : unit = ()
+v}
+
+{1 A concrete example}
+
+Let me give a full example: the shortest non trivial example you could imagine,
+that is the lambda calculus :)
+
+Thus the problem is to pretty-print the values of a concrete data type that
+models a language of expressions that defines functions and their applications
+to arguments.
+
+First, I give the abstract syntax of lambda-terms:
+
+{v
+type lambda =
+ | Lambda of string * lambda
+ | Var of string
+ | Apply of lambda * lambda
+;;
+v}
+
+I use the format library to print the lambda-terms:
+
+{v
+open Format;;
+
+let ident = print_string;;
+let kwd = print_string;;
+val ident : string -> unit = <fun>
+val kwd : string -> unit = <fun>
+
+let rec print_exp0 = function
+| Var s -> ident s
+| lam -> open_hovbox 1; kwd "("; print_lambda lam; kwd ")"; close_box ()
+
+and print_app = function
+| e -> open_hovbox 2; print_other_applications e; close_box ()
+
+and print_other_applications f =
+ match f with
+ | Apply (f, arg) -> print_app f; print_space (); print_exp0 arg
+ | f -> print_exp0 f
+
+and print_lambda = function
+| Lambda (s, lam) ->
+ open_hovbox 1;
+ kwd "\\"; ident s; kwd "."; print_space(); print_lambda lam;
+ close_box()
+ | e -> print_app e;;
+val print_app : lambda -> unit = <fun>
+val print_other_applications : lambda -> unit = <fun>
+val print_lambda : lambda -> unit = <fun>
+v}
+
+{2 Most general pretty-printing: using fprintf}
+
+We use the [fprintf] function to write the most versatile version of the
+pretty-printing functions for lambda-terms. Now, the functions get an extra
+argument, namely a pretty-printing formatter (the ppf argument) where printing
+will occur. This way the printing routines are more general, since they can
+print on any formatter defined in the program (either printing to a file, or to
+[stdout], to [stderr], or even to a string). Furthermore, the pretty-printing
+functions are now compositional, since they may be used in conjunction with the
+special [%a] conversion, that prints a [fprintf] argument with a user's supplied
+function (these user's supplied functions also have a formatter as first
+argument).
+
+Using [fprintf], the lambda-terms printing routines can be written as follows:
+
+{v
+open Format;;
+
+let ident ppf s = fprintf ppf "%s" s;;
+let kwd ppf s = fprintf ppf "%s" s;;
+val ident : Format.formatter -> string -> unit
+val kwd : Format.formatter -> string -> unit
+
+let rec pr_exp0 ppf = function
+| Var s -> fprintf ppf "%a" ident s
+| lam -> fprintf ppf "@\[<1>(%a)@\]" pr_lambda lam
+
+and pr_app ppf = function
+| e -> fprintf ppf "@\[<2>%a@\]" pr_other_applications e
+
+and pr_other_applications ppf f =
+match f with
+| Apply (f, arg) -> fprintf ppf "%a@ %a" pr_app f pr_exp0 arg
+| f -> pr_exp0 ppf f
+
+and pr_lambda ppf = function
+| Lambda (s, lam) ->
+fprintf ppf "@\[<1>%a%a%a@ %a@\]" kwd "\\" ident s kwd "." pr_lambda lam
+| e -> pr_app ppf e
+;;
+val pr_app : Format.formatter -> lambda -> unit
+val pr_other_applications : Format.formatter -> lambda -> unit
+val pr_lambda : Format.formatter -> lambda -> unit
+v}
+
+Given those general printing routines, procedures to print to [stdout] or
+[stderr] is just a matter of partial application:
+
+{v
+let print_lambda = pr_lambda std_formatter;;
+let eprint_lambda = pr_lambda err_formatter;;
+val print_lambda : lambda -> unit
+val eprint_lambda : lambda -> unit
+v}
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+ROOTDIR = ..
+-include $(ROOTDIR)/Makefile.build_config
+
+ifeq ($(DOCUMENTATION_TOOL),odoc)
+ include odoc/Makefile
+else
+ include ocamldoc/Makefile
+endif
+
+odoc-%:
+ $(MAKE) -C odoc $* ROOTDIR=../..
+
+ocamldoc-%:
+ $(MAKE) -C ocamldoc $* ROOTDIR=../..
+
+clean:
+ rm -rf build odoc/build ocamldoc/build
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+ROOTDIR = ..
+DOCGEN= $(ROOTDIR)/api_docgen
+
+include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/stdlib/StdlibModules
+include $(ROOTDIR)/Makefile.best_binaries
+include $(DOCGEN)/Makefile.docfiles
+
+DOC_COMPILERLIBS_DIRS= $(addprefix $(ROOTDIR)/,\
+ parsing utils typing bytecomp driver file_formats lambda)
+
+DOC_STDLIB_DIRS = $(addprefix $(ROOTDIR)/, stdlib \
+ otherlibs/str otherlibs/$(UNIXLIB) otherlibs/dynlink \
+ otherlibs/systhreads)
+
+.PHONY: all
+all: html pdf man
+
+DIRS = $(addprefix build/,libref compilerlibref man latex texi \
+ html html/libref html/compilerlibref)
+
+$(DIRS):
+ $(MKDIR) $@
+
+pdf: build/latex/alldoc.pdf
+latex:
+man:
+html:
+build/latex/alldoc.pdf: build/latex/stdlib_input.tex \
+ build/latex/compilerlibs_input.tex | build/latex/ifocamldoc.tex
+
+$(DOCGEN)/build/Compiler_libs.mld: $(DOCGEN)/Compiler_libs.pre.mld
+ cp $< $@ && echo "{!modules:$(compilerlibref_C)}" >> $@
+
+build/latex/ifocamldoc.tex: $(ROOTDIR)/Makefile.config | build/latex
+
+build/latex/alldoc.tex:$(DOCGEN)/alldoc.tex | build/latex
+ cp $< $@
+
+$(compilerlibref_TEXT:%=build/%.mld) $(libref_TEXT:%=build/%.mld): \
+build/%.mld:$(DOCGEN)/%.mld
+ cp $< $@
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# Capitalize first letter of argument
+define up
+$(shell echo $(1) | cut -c1 | tr '[:lower:]' '[:upper:]')
+endef
+
+define capitalize_one
+$(call up,$(1))$(shell echo $(1) | cut -c2-)
+endef
+
+define capitalize
+$(foreach m,$(1),$(call capitalize_one,$m))
+endef
+
+define sort
+$(shell $(BEST_OCAMLDEP) -sort $(1))
+endef
+
+
+str_MLIS := str.mli
+unix_MLIS := unix.mli unixLabels.mli
+dynlink_MLIS := dynlink.mli
+thread_MLIS := \
+ thread.mli condition.mli mutex.mli event.mli \
+ threadUnix.mli semaphore.mli
+
+STDLIB=$(filter-out stdlib__Pervasives, $(STDLIB_MODULES))
+
+stdlib_UNPREFIXED=$(filter-out pervasives, $(STDLIB_MODULE_BASENAMES))
+
+otherlibref := $(dynlink_MLIS:%.mli=%)
+
+ifneq "$(filter str,$(OTHERLIBRARIES))" ""
+otherlibref += $(str_MLIS:%.mli=%)
+endif
+
+ifneq "$(filter %unix,$(OTHERLIBRARIES))" ""
+otherlibref += $(unix_MLIS:%.mli=%)
+endif
+
+ifneq "$(filter systhreads,$(OTHERLIBRARIES))" ""
+otherlibref += $(thread_MLIS:%.mli=%)
+endif
+
+libref_EXTRA=stdlib__pervasives
+libref_TEXT=Ocaml_operators Format_tutorial
+libref_C=$(call capitalize,$(libref) $(libref_EXTRA))
+
+PARSING_MLIS := $(call sort, \
+ $(notdir $(wildcard $(ROOTDIR)/parsing/*.mli))\
+)
+UTILS_MLIS := $(call sort,$(notdir $(wildcard $(ROOTDIR)/utils/*.mli)))
+DRIVER_MLIS := pparse.mli
+
+compilerlibref_MLIS= \
+ $(PARSING_MLIS) \
+ $(UTILS_MLIS) \
+ $(DRIVER_MLIS)
+compilerlibref=$(compilerlibref_MLIS:%.mli=%)
+compilerlibref_TEXT=Compiler_libs
+compilerlibref_C=$(call capitalize,$(compilerlibref))
+
+ALL_LIBREF= $(libref_TEXT:%=libref/%) $(libref:%=libref/%)
+ALL_COMPILERLIBREF= \
+ $(compilerlibref_TEXT:%=compilerlibref/%) \
+ $(compilerlibref:%=compilerlibref/%)
+ALL_DOC= $(ALL_LIBREF) $(ALL_COMPILERLIBREF)
--- /dev/null
+Precedence level and associativity of operators
+
+The following table lists the precedence level of all operator classes
+from the highest to the lowest precedence. A few other syntactic constructions
+are also listed as references.
+
+{%latex:
+%
+% Note: the tables below should be kept in sync with the one in
+% manual/src/refman/expr.etex .
+%
+\begin{tabular}{cc}
+\hline
+Operator class & Associativity \\
+\hline
+$!\ldots$ $\tilde{}\ldots$ & -- \\
+$.\cdots()$ $.\cdots[]$ $.\cdots$\textbraceleft\textbraceright& -- \\
+\#\ldots & left \\
+function application & left \\
+- -. & -- \\
+$**\ldots$ lsl lsr asr & right \\
+$*\ldots$ /\ldots \%\ldots mod land lor lxor & left \\
++\ldots -\ldots & left \\
+:: & right \\
+@\ldots \textasciicircum\ldots & right \\
+=\ldots <\ldots >\ldots |\ldots \&\ldots \$\ldots != & left \\
+\& \&\& & right \\
+or || & right \\
+, & -- \\
+<- := & right \\
+if & -- \\
+; & right \\
+\hline
+\end{tabular}
+%}
+
+{%html:
+<table align=center border=1>
+<thead><tr><th>Operator class</th><th>Associativity </th></tr></thead>
+<tr><td><code class=code>!… ~…</code> </td><td>–</td></tr>
+<tr><td><code class=code>.…() .…[] .…{} </code>
+ </td><td>–</td></tr>
+<tr><td><code class=code>#…</code> </td><td> left </td></tr>
+<tr><td><code class=code>function application</code> </td><td> left </td></tr>
+<tr><td><code class=code>- -.</code> </td><td>–</td></tr>
+<tr><td><code class=code>**… lsl lsr asr </code></td><td> right </td></tr>
+<tr><td><code class=code>*… /… %… mod land lor lxor</code>
+ </td><td> left </td></tr>
+<tr><td><code class=code>+… -…</code> </td><td> left </td></tr>
+<tr><td><code class=code>::</code> </td><td> right </td></tr>
+<tr><td><code class=code>@… ^… </td><td> right </td></tr>
+<tr><td><code class=code>=… <…
+>… |… &… $… !=</code> </td><td> left </td></tr>
+<tr><td><code class=code>& &&</code> </td><td> right </td></tr>
+<tr><td><code class=code>or || </code> </td><td> right </td></tr>
+<tr><td><code class=code>,</code> </td><td>–</td></tr>
+<tr><td><code class=code><- :=</code> </td><td> right </td></tr>
+<tr><td><code class=code>if</code> </td><td>–</td></tr>
+<tr><td><code class=code>;</code> </td><td> right </td></tr>
+</table>
+%}
+
+{%man:
+.IP Associativity
+Operator class
+.IP -
+!.. ~..
+.IP -
+\&.() .[] .{}
+.IP left
+#..
+.IP left
+function application
+.IP -
+- -.
+.IP right
+**.. lsl lsr asr
+.IP left
+*.. /.. %.. mod land lor lxor
+.IP left
++.. -..
+.IP right
+::
+.IP right
+@.. ^..
+.IP left
+=.. <.. >.. |.. &.. $.. !=
+.IP right
+& &&
+.IP right
+or ||
+.IP -
+,
+.IP right
+<- :=
+.IP -
+if
+.IP right
+;
+%}
--- /dev/null
+\documentclass{book}
+
+\usepackage[colorlinks=true,breaklinks=true]{hyperref}
+\usepackage{color}
+\usepackage{lmodern}
+\usepackage[T1]{fontenc}
+\usepackage[strings,nohyphen]{underscore}
+\input{ifocamldoc}
+\ifocamldoc
+\usepackage{ocamldoc}
+\usepackage{textcomp}
+\else
+\usepackage{changepage}
+\usepackage{longtable}
+\usepackage{listings}
+\newcommand{\ocamlcodefragment}[1]{{\ttfamily\setlength{\parindent}{0cm}%
+\raggedright#1}}
+\newcommand{\ocamlinlinecode}[1]{{\ttfamily#1}}
+\newcommand{\bold}[1]{{\bfseries#1}}
+\newenvironment{ocamlexception}{\bfseries}{}
+\newenvironment{ocamlextension}{\bfseries}{}
+\newenvironment{ocamlarrow}{}
+
+\newcommand{\ocamltag}[2]{\begin{ocaml#1}#2\end{ocaml#1}}
+\newenvironment{ocamlkeyword}{\bfseries}{}
+\newenvironment{ocamlconstructor}{\bfseries}{}
+\newenvironment{ocamltype-var}{\itshape\ttfamily}{}
+
+\newcommand{\ocamlhighlight}{\bfseries\uline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+
+\definecolor{lightgray}{gray}{0.97}
+\definecolor{gray}{gray}{0.5}
+\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
+\newcommand{\ocamlstring}{\color{gray}\bfseries}
+\newenvironment{ocamlindent}{\begin{adjustwidth}{2em}{0pt}}{\end{adjustwidth}}
+\newenvironment{ocamltabular}[2][l]{\begin{tabular}{#2}}%
+{\end{tabular}}
+
+\lstnewenvironment{ocamlcodeblock}{
+ \lstset{
+ backgroundcolor = \color{lightgray},
+ basicstyle=\ttfamily,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ commentstyle=\ocamlcomment,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ moredelim=[is][\ocamlhighlight]{<<}{>>},
+ moredelim=[s][\ocamlstring]{\{|}{|\}},
+ moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
+ keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
+ belowskip=0\baselineskip,
+ upquote=true,
+ literate={'"'}{\textquotesingle "\textquotesingle}3
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+ }
+}{}
+\fi
+
+\ifocamldoc
+\newcommand{\docitem}[2]{\input{#2}}
+\else
+\newcommand{\docitem}[2]{\input{#1/#2}}
+\fi
+
+\begin{document}
+\chapter{Stdlib}
+\docitem{libref}{Stdlib.tex}
+\input{stdlib_input}
+\docitem{libref}{Ocaml_operators.tex}
+\chapter{Dynlink}
+\docitem{libref}{Dynlink.tex}
+\chapter{Str}
+\docitem{libref}{Str.tex}
+\chapter{Thread}
+\docitem{libref}{Condition.tex}
+\docitem{libref}{Event.tex}
+\docitem{libref}{Mutex.tex}
+\docitem{libref}{Thread.tex}
+\docitem{libref}{ThreadUnix.tex}
+\docitem{libref}{Semaphore.tex}
+\chapter{Unix}
+\docitem{libref}{UnixLabels.tex}
+\docitem{libref}{Unix.tex}
+\chapter{Compilerlibs}
+\docitem{compilerlibref}{Compiler_libs.tex}
+\input{compilerlibs_input.tex}
+\end{document}
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+include $(ROOTDIR)/api_docgen/Makefile.common
+include $(ROOTDIR)/ocamldoc/Makefile.best_ocamldoc
+vpath %.mli $(ROOTDIR)/stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
+
+
+man: build/man/Stdlib.3o
+latex: build/latex/Stdlib.tex
+html: \
+ build/html/libref/Stdlib.html \
+ build/html/compilerlibref/Compiler_libs.html
+texi: build/texi/stdlib.texi
+
+DOC_STDLIB_INCLUDES= $(addprefix -I , $(DOC_STDLIB_DIRS))
+
+DOC_ALL_INCLUDES = \
+ $(DOC_STDLIB_INCLUDES) \
+ $(addprefix -I ,$(DOC_COMPILERLIBS_DIRS))
+
+libref=$(stdlib_UNPREFIXED) $(otherlibref)
+
+ALL_MAN= $(ALL_DOC:%=build/man/%.3o)
+ALL_LATEX= $(ALL_DOC:%=build/latex/%.tex)
+
+build/latex/ifocamldoc.tex: | build/latex
+ printf '\\newif\ifocamldoc\ocamldoctrue\n' > $@
+
+$(libref:%=build/libref/%.odoc): build/libref/%.odoc: %.mli | build/libref
+ $(OCAMLDOC_RUN) -nostdlib -hide Stdlib -lib Stdlib \
+ -pp \
+"$(AWK) -v ocamldoc=true -f $(ROOTDIR)/stdlib/expand_module_aliases.awk" \
+ $(DOC_STDLIB_INCLUDES) $< -dump $@
+
+$(compilerlibref:%=build/compilerlibref/%.odoc):\
+build/compilerlibref/%.odoc: %.mli | build/compilerlibref
+ $(OCAMLDOC_RUN) -nostdlib -hide Stdlib \
+ $(DOC_ALL_INCLUDES) $< -dump $@
+
+$(compilerlibref_TEXT:%=build/compilerlibref/%.odoc):\
+build/compilerlibref/%.odoc: $(DOCGEN)/build/%.mld | build/compilerlibref
+ $(OCAMLDOC_RUN) $(DOC_ALL_INCLUDES) -text $< -dump $@
+
+$(libref_TEXT:%=build/libref/%.odoc):\
+build/libref/%.odoc: $(DOCGEN)/%.mld | build/libref
+ $(OCAMLDOC_RUN) $(DOC_STDLIB_INCLUDES) -text $< -dump $@
+
+ALL_COMPILED_DOC=$(ALL_DOC:%=build/%.odoc)
+build/man/Stdlib.3o: $(ALL_COMPILED_DOC) | build/man
+ $(OCAMLDOC_RUN) -man -d build/man -man-mini \
+ -nostdlib -hide Stdlib -lib Stdlib -t "OCaml library" \
+ $(addprefix -load , $(ALL_COMPILED_DOC))
+
+HTML_OPTIONS= -charset="utf8" -colorize-code -nonavbar
+
+build/html/libref/Stdlib.html: $(ALL_LIBREF:%=build/%.odoc) | build/html/libref
+ $(OCAMLDOC_RUN) -html -d build/html/libref \
+ $(HTML_OPTIONS) \
+ -nostdlib -hide Stdlib -lib Stdlib -t "OCaml library" \
+ $(addprefix -load , $(ALL_LIBREF:%=build/%.odoc))
+
+build/html/compilerlibref/Compiler_libs.html: \
+ $(ALL_COMPILERLIBREF:%=build/%.odoc) | build/html/compilerlibref
+ $(OCAMLDOC_RUN) -html -d build/html/compilerlibref \
+ -nostdlib -hide Stdlib -t "OCaml compiler library" \
+ $(HTML_OPTIONS) \
+ -intro $(DOCGEN)/build/Compiler_libs.mld \
+ $(addprefix -load , $(ALL_COMPILERLIBREF:%=build/%.odoc))
+
+build/texi/stdlib.texi: $(ALL_COMPILED_DOC) | build/texi
+ $(OCAMLDOC_RUN) -texi -o $@ \
+ -nostdlib -hide Stdlib -lib Stdlib -t "OCaml library" \
+ $(addprefix -load , $(ALL_COMPILED_DOC))
+
+build/latex/Stdlib.tex: $(ALL_COMPILED_DOC) | build/latex
+ $(OCAMLDOC_RUN) -latex -o build/latex/all.tex \
+ -hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
+ -sepfiles \
+ -latextitle "1,subsection*" \
+ -latextitle "2,subsubsection*" \
+ -latex-type-prefix "TYP" \
+ -latex-module-prefix "" \
+ -latex-module-type-prefix "" \
+ -latex-value-prefix "" \
+ -nostdlib -hide Stdlib -lib Stdlib -t "OCaml library" \
+ $(addprefix -load , $(ALL_COMPILED_DOC))
+
+build/latex/alldoc.pdf: build/latex/Stdlib.tex build/latex/alldoc.tex \
+ | build/latex
+ cd build/latex && \
+ TEXINPUTS=$${TEXINPUTS}:$(ROOTDIR)/ocamldoc pdflatex alldoc
+ cd build/latex && \
+ TEXINPUTS=$${TEXINPUTS}:$(ROOTDIR)/ocamldoc pdflatex alldoc
+
+stdlib_INPUT=$(foreach module,\
+$(filter-out stdlib.mli camlinternal%,$(stdlib_UNPREFIXED)),\
+\\input{$(call capitalize,$(module)).tex}\
+)
+build/latex/stdlib_input.tex: | build/latex
+ echo $(stdlib_INPUT) > $@
+
+compilerlibs_INPUT=$(foreach module,\
+$(filter-out camlinternal%,$(compilerlibref)),\
+\\input{$(call capitalize,$(module)).tex})
+build/latex/compilerlibs_input.tex: | build/latex
+ echo $(compilerlibs_INPUT) > $@
+
+INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
+.PHONY:install
+install:
+ $(MKDIR) "$(INSTALL_MANODIR)"
+ if test -d build/man; then \
+ $(INSTALL_DATA) build/man/*.3o "$(INSTALL_MANODIR)"; \
+ else : ; fi
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+include $(ROOTDIR)/api_docgen/Makefile.common
+
+vpath %.cmti $(ROOTDIR)/stdlib $(DOC_COMPILERLIBS_DIRS) $(DOC_STDLIB_DIRS)
+vpath %.cmt $(ROOTDIR)/stdlib
+
+ifeq ($(DOCUMENTATION_TOOL),odoc)
+ odoc ?= $(DOCUMENTATION_TOOL_CMD)
+else
+ odoc ?= odoc
+endif
+
+libref = $(STDLIB) $(otherlibref)
+
+# odoc needs a "page-" prefix for a mld documentation file
+define page_name
+ $(dir $1)page-$(notdir $1)
+endef
+
+define stdlib_prefix
+ $(if $(filter-out stdlib camlinternal%,$1),\
+ Stdlib.$(call capitalize,$1),\
+ $(call capitalize, $1))
+endef
+
+# define the right conditional for the manual
+build/latex/ifocamldoc.tex: | build/latex
+ printf '\\newif\ifocamldoc\ocamldocfalse\n' > $@
+
+
+# \input{} all modules in the stdlib for the latex api manual
+stdlib_INPUT= $(foreach module,\
+$(filter-out stdlib camlinternal%, $(STDLIB:stdlib__%=%)),\
+\\input{libref/Stdlib.$(call capitalize,$(module)).tex}\
+)
+
+build/latex/stdlib_input.tex: | build/latex
+ echo $(stdlib_INPUT)> $@
+
+build/latex/compilerlibs_input.tex: | build/latex
+ echo $(compilerlibref_C:%=\\input{compilerlibref/%})> $@
+
+# The build process for odoc has 3 phases:
+# 1. generation of internal individual documentation files (.odoc)
+# 2. generation of linked documentation files (.odocl)
+# 3. generation of the actual (.tex,.html,.3o) documentation
+
+# rules for the mld files
+$(libref_TEXT:%=build/libref/page-%.odoc):
+build/libref/page-%.odoc:$(DOCGEN)/%.mld | build/libref
+ $(odoc) compile -I build/libref --package libref $< -o $@
+
+$(compilerlibref_TEXT:%=build/compilerlibref/page-%.odoc):\
+build/compilerlibref/page-%.odoc:$(DOCGEN)/build/%.mld | build/compilerlibref
+ $(odoc) compile -I build/libref --package compilerlibref $< -o $@
+
+# rules for the stdlib and otherlibs .doc files
+$(libref:%=build/libref/%.odoc):\
+build/libref/%.odoc: %.cmti | build/libref
+ $(odoc) compile -I build/libref --package libref $< -o $@
+
+# pervasives is handled separatedly due to the lack of cmti file
+$(libref_EXTRA:%=build/libref/%.odoc):build/libref/%.odoc:%.cmt
+ $(odoc) compile -I build/libref --package libref $< -o $@
+
+# rules for the compilerlib documentation
+$(compilerlibref:%=build/compilerlibref/%.odoc):\
+build/compilerlibref/%.odoc: %.cmti $(libref:%=build/libref/%.odoc) \
+| build/compilerlibref
+ $(odoc) compile -I build/libref -I build/compilerlibref \
+ --package compilerlibref $< -o $@
+
+ALL_TEXT = $(libref_TEXT:%=libref/%) $(compilerlibref_TEXT:%=compilerlibref/%)
+ALL_PAGE_TEXT=$(foreach mld,$(ALL_TEXT),$(call page_name,$(mld)))
+TARGET_UNITS= \
+ $(compilerlibref:%=compilerlibref/%) \
+ libref/stdlib $(otherlibref:%=libref/%) \
+ $(addprefix libref/,$(filter camlinternal%,$(STDLIB)))
+ALL_UNITS = $(compilerlibref:%=compilerlibref/%) $(libref:%=libref/%)
+ALL_PAGED_DOC = $(TARGET_UNITS) $(ALL_PAGE_TEXT)
+
+# rules for odocl generation
+# Note that we are using a dependency on the whole phase 1 rather than tracking
+# the individual file dependencies
+$(ALL_UNITS:%=build/%.odocl):%.odocl:%.odoc \
+ | $(ALL_PAGED_DOC:%=build/%.odoc)
+ $(odoc) link -I build/libref -I build/compilerlibref $<
+
+$(ALL_PAGE_TEXT:%=build/%.odocl):%.odocl:%.odoc \
+ | $(ALL_PAGED_DOC:%=build/%.odoc)
+ $(odoc) link -I build/libref -I build/compilerlibref $<
+
+# Rules for all three backends:
+
+ALL_HTML = $(ALL_PAGED_DOC:%=build/%.html.stamp)
+ALL_MAN = $(ALL_PAGED_DOC:%=build/%.3o.stamp)
+ALL_LATEX = $(ALL_PAGED_DOC:%=build/%.tex.stamp)
+
+build/libref/stdlib.html.stamp: $(STDLIB:%=build/libref/%.odocl) | build/libref
+build/libref/stdlib.3o.stamp: $(STDLIB:%=build/libref/%.odocl) | build/libref
+build/libref/stdlib.tex.stamp: $(STDLIB:%=build/libref/%.odocl) | build/libref
+
+man: $(ALL_MAN)
+html: $(ALL_HTML) build/html/odoc.css
+html: build/libref/index.html.stamp build/compilerlibref/index.html.stamp
+
+# Html rules
+$(ALL_HTML): %.html.stamp: %.odocl | build/html
+ $(odoc) html-generate --output-dir build/html $<
+ touch $@
+
+build/html/odoc.css: | build/html
+ $(odoc) support-files --output-dir build/html
+
+$(build/libref.html.stamp build/compilerlibref.html.stamp):
+%.html.stamp: %.mld | build/
+ $(odoc) html-generate --output-dir build/html $<
+ touch $@
+
+# Html indexes for the api documentation
+
+# The stdlib index is generated from the list of stdlib modules.
+stdlib_INDEX=\
+ $(foreach m,$(stdlib_UNPREFIXED),$(call stdlib_prefix,$m))\
+ $(call capitalize, $(otherlibref))
+build/libref.mld:
+ echo {0 OCaml standard library} {!modules:$(stdlib_INDEX)} > $@
+
+build/libref/index.html.stamp: $(ALL_HTML) build/libref.mld | build/libref
+ $(odoc) compile --package libref build/libref.mld
+ $(odoc) link -I build/libref build/page-libref.odoc
+ $(odoc) html-generate build/page-libref.odocl --output-dir build/html
+ mv build/html/libref/libref.html build/html/libref/index.html
+ touch $@
+
+build/compilerlibref/index.html.stamp: $(ALL_HTML) \
+ build/compilerlibref/page-Compiler_libs.html.stamp | build/compilerlibref
+ cp build/html/compilerlibref/Compiler_libs.html \
+ build/html/compilerlibref/index.html
+ touch $@
+
+# Latex rules
+
+latex: $(ALL_LATEX)
+
+
+build/latex/alldoc.pdf: $(ALL_LATEX) build/latex/alldoc.tex \
+build/latex/stdlib_input.tex build/latex/compilerlibs_input.tex \
+| build/latex
+ cd build/latex && pdflatex alldoc.tex
+ cd build/latex && pdflatex alldoc.tex
+
+# We include children pages directly except for the root Stdlib module
+NOT_STDLIB=$(filter-out libref/stdlib,$(ALL_PAGED_DOC))
+$(NOT_STDLIB:%=build/%.tex.stamp):\
+build/%.tex.stamp: build/%.odocl | build/
+ $(odoc) latex-generate --with-children=true --output-dir build/latex $<
+ touch $@
+
+# Stdlib latex page: we manually integrate stdlib module
+build/libref/stdlib.tex.stamp: build/libref/stdlib.odocl | build/libref
+ $(odoc) latex-generate --with-children=false --output-dir build/latex $<
+ touch $@
+
+# Man pages
+$(ALL_PAGED_DOC:%=build/%.3o.stamp):build/%.3o.stamp:build/%.odocl | build/
+ $(odoc) man-generate --output-dir build/man $<
+ touch $@
+
+# Man pages are the only installed documentation
+INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
+.PHONY:install
+install:
+ $(MKDIR) "$(INSTALL_MANODIR)"
+ if test -d build/man/libref ; then \
+ $(INSTALL_DATA) build/man/libref/* "$(INSTALL_MANODIR)"; \
+ else : ; fi
+ if test -d build/man/compilerlibref ; then \
+ $(INSTALL_DATA) build/man/libref/* "$(INSTALL_MANODIR)"; \
+ else : ; fi
CYG_ROOT: C:/cygwin64
CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/
CYG_CACHE: C:/cygwin64/var/cache/setup
- FLEXDLL_VERSION: 0.38
+ FLEXDLL_VERSION: 0.39
OCAMLRUNPARAM: v=0,b
+ FORCE_CYGWIN_UPGRADE: 0
+ BUILD_MODE: world.opt
matrix:
- PORT: mingw32
+ BOOTSTRAP_FLEXDLL: true
- PORT: msvc64
+ BOOTSTRAP_FLEXDLL: false
+ BUILD_MODE: steps
+ - PORT: msvc32
+ BOOTSTRAP_FLEXDLL: false
+ BUILD_MODE: C
+ SDK: |-
+ "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x86
matrix:
fast_finish: true
type op_class =
| Op_pure (* pure arithmetic, produce one or several result *)
| Op_checkbound (* checkbound-style: no result, can raise an exn *)
- | Op_load (* memory load *)
+ | Op_load of Asttypes.mutable_flag (* memory load *)
| Op_store of bool (* memory store, false = init, true = assign *)
| Op_other (* anything else that does not allocate nor store in memory *)
Map.Make(struct type t = rhs let compare = Stdlib.compare end)
type 'a t =
- { load_equations : 'a Rhs_map.t;
+ { mutable_load_equations : 'a Rhs_map.t;
other_equations : 'a Rhs_map.t }
let empty =
- { load_equations = Rhs_map.empty;
+ { mutable_load_equations = Rhs_map.empty;
other_equations = Rhs_map.empty }
let add op_class op v m =
match op_class with
- | Op_load ->
- { m with load_equations = Rhs_map.add op v m.load_equations }
+ | Op_load Mutable ->
+ { m with mutable_load_equations =
+ Rhs_map.add op v m.mutable_load_equations }
| _ ->
{ m with other_equations = Rhs_map.add op v m.other_equations }
let find op_class op m =
match op_class with
- | Op_load ->
- Rhs_map.find op m.load_equations
+ | Op_load Mutable ->
+ Rhs_map.find op m.mutable_load_equations
| _ ->
Rhs_map.find op m.other_equations
- let remove_loads m =
- { load_equations = Rhs_map.empty;
+ let remove_mutable_loads m =
+ { mutable_load_equations = Rhs_map.empty;
other_equations = m.other_equations }
end
(* Keep only the equations satisfying the given predicate. *)
-let remove_load_numbering n =
- { n with num_eqs = Equations.remove_loads n.num_eqs }
+let remove_mutable_load_numbering n =
+ { n with num_eqs = Equations.remove_mutable_loads n.num_eqs }
(* Forget everything we know about registers of type [Addr]. *)
| Imove | Ispill | Ireload -> assert false (* treated specially *)
| Iconst_int _ | Iconst_float _ | Iconst_symbol _ -> Op_pure
| Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ -> assert false (* treated specially *)
+ | Iextcall _ | Iopaque -> assert false (* treated specially *)
| Istackoffset _ -> Op_other
- | Iload(_,_) -> Op_load
+ | Iload(_,_,mut) -> Op_load mut
| Istore(_,_,asg) -> Op_store asg
- | Ialloc _ -> assert false (* treated specially *)
+ | Ialloc _ | Ipoll _ -> assert false (* treated specially *)
| Iintop(Icheckbound) -> Op_checkbound
| Iintop _ -> Op_pure
| Iintop_imm(Icheckbound, _) -> Op_checkbound
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Ifloatofint | Iintoffloat -> Op_pure
| Ispecific _ -> Op_other
- | Iname_for_debugger _ -> Op_pure
(* Operations that are so cheap that it isn't worth factoring them. *)
| Iconst_int _ -> true
| _ -> false
-(* Forget all equations involving memory loads. Performed after a
- non-initializing store *)
+(* Forget all equations involving mutable memory loads.
+ Performed after a non-initializing store *)
method private kill_loads n =
- remove_load_numbering n
+ remove_mutable_load_numbering n
(* Perform CSE on the given instruction [i] and its successors.
[n] is the value numbering current at the beginning of [i]. *)
arguments is always a memory load. For simplicity, we
just forget everything. *)
{i with next = self#cse empty_numbering i.next}
- | Iop (Ialloc _) ->
+ | Iop Iopaque ->
+ (* Assume arbitrary side effects from Iopaque *)
+ {i with next = self#cse empty_numbering i.next}
+ | Iop (Ialloc _) | Iop (Ipoll _) ->
(* For allocations, we must avoid extending the live range of a
pseudoregister across the allocation if this pseudoreg
is a derived heap pointer (a pointer into the heap that does
not point to the beginning of a Caml block). PR#6484 is an
example of this situation. Such pseudoregs have type [Addr].
Pseudoregs with types other than [Addr] can be kept.
- Moreover, allocation can trigger the asynchronous execution
+ Moreover, allocations and polls can trigger the asynchronous execution
of arbitrary Caml code (finalizer, signal handler, context
switch), which can contain non-initializing stores.
- Hence, all equations over loads must be removed. *)
+ Hence, all equations over mutable loads must be removed. *)
let n1 = kill_addr_regs (self#kill_loads n) in
let n2 = set_unknown_regs n1 i.res in
{i with next = self#cse n2 i.next}
| Iop op ->
begin match self#class_of_operation op with
- | (Op_pure | Op_checkbound | Op_load) as op_class ->
+ | (Op_pure | Op_checkbound | Op_load _) as op_class ->
let (n1, varg) = valnum_regs n i.arg in
let n2 = set_unknown_regs n1 (Proc.destroyed_at_oper i.desc) in
begin match find_equation op_class n1 (op, varg) with
{i with next = self#cse n2 i.next}
| Op_store true ->
(* A non-initializing store can invalidate
- anything we know about prior loads. *)
+ anything we know about prior mutable loads. *)
let n1 = set_unknown_regs n (Proc.destroyed_at_oper i.desc) in
let n2 = set_unknown_regs n1 i.res in
let n3 = self#kill_loads n2 in
type op_class =
| Op_pure (* pure, produce one result *)
| Op_checkbound (* checkbound-style: no result, can raise an exn *)
- | Op_load (* memory load *)
+ | Op_load of Asttypes.mutable_flag (* memory load *)
| Op_store of bool (* memory store, false = init, true = assign *)
| Op_other (* anything else that does not allocate nor store in memory *)
| Ilea _ | Isextend32 | Izextend32 -> Op_pure
| Istore_int(_, _, is_asg) -> Op_store is_asg
| Ioffset_loc(_, _) -> Op_store true
- | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load
+ | Ifloatarithmem _ | Ifloatsqrtf _ -> Op_load Mutable
| Ibswap _ | Isqrtf -> super#class_of_operation op
end
| _ -> super#class_of_operation op
| Izextend32 ->
fprintf ppf "zextend32 %a" printreg arg.(0)
+(* Are we using the Windows 64-bit ABI? *)
+
let win64 =
match Config.system with
| "win64" | "mingw64" | "cygwin" -> true
| _ -> false
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+ | Ilea _ | Ibswap _ | Isqrtf | Isextend32 | Izextend32 -> true
+ | Ifloatarithmem _ | Ifloatsqrtf _ -> true
+ | _ -> false
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false
open Mach
open Linear
open Emitaux
+open Emitenv
open X86_ast
open X86_proc
let fp = Config.with_frame_pointers
-(* Tradeoff between code size and code speed *)
-
-let fastcode_flag = ref true
-
-(* Layout of the stack frame *)
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let frame_required = ref false
-
-let frame_size () = (* includes return address *)
- if !frame_required then begin
+let frame_size env = (* includes return address *)
+ if env.f.fun_frame_required then begin
let sz =
- (!stack_offset + 8 * (num_stack_slots.(0) + num_stack_slots.(1)) + 8
+ (env.stack_offset
+ + 8 * (env.f.fun_num_stack_slots.(0) + env.f.fun_num_stack_slots.(1))
+ + 8
+ (if fp then 8 else 0))
in Misc.align sz 16
end else
- !stack_offset + 8
+ env.stack_offset + 8
-let slot_offset loc cl =
+let slot_offset env loc cl =
match loc with
- | Incoming n -> frame_size() + n
+ | Incoming n -> (frame_size env) + n
| Local n ->
if cl = 0
- then !stack_offset + n * 8
- else !stack_offset + (num_stack_slots.(0) + n) * 8
+ then env.stack_offset + n * 8
+ else env.stack_offset + (env.f.fun_num_stack_slots.(0) + n) * 8
| Outgoing n -> n
(* Symbols *)
let def_label ?typ s =
D.label ?typ (emit_label s)
-let emit_Llabel fallthrough lbl =
- if not fallthrough && !fastcode_flag then D.align 4;
+let emit_Llabel env fallthrough lbl =
+ if not fallthrough && env.f.fun_fast then D.align 4;
def_label lbl
(* Output a pseudo-register *)
-let reg = function
+let reg env = function
| { loc = Reg.Reg r } -> register_name r
| { loc = Stack s; typ = Float } as r ->
- let ofs = slot_offset s (register_class r) in
+ let ofs = slot_offset env s (register_class r) in
mem64 REAL8 ofs RSP
| { loc = Stack s } as r ->
- let ofs = slot_offset s (register_class r) in
+ let ofs = slot_offset env s (register_class r) in
mem64 QWORD ofs RSP
| { loc = Unknown } ->
assert false
| { loc = Reg.Reg r } -> int_reg_name.(r)
| _ -> assert false
-
-let res i n = reg i.res.(n)
-
-let arg i n = reg i.arg.(n)
-
+let arg env i n = reg env i.arg.(n)
+let res env i n = reg env i.res.(n)
(* Output a reference to the lower 8, 16 or 32 bits of a register *)
let reg_low_8_name = Array.map (fun r -> Reg8L r) int_reg_name
let reg_low_16_name = Array.map (fun r -> Reg16 r) int_reg_name
let reg_low_32_name = Array.map (fun r -> Reg32 r) int_reg_name
-let emit_subreg tbl typ r =
+let emit_subreg env tbl typ r =
match r.loc with
| Reg.Reg r when r < 13 -> tbl.(r)
- | Stack s -> mem64 typ (slot_offset s (register_class r)) RSP
+ | Stack s -> mem64 typ (slot_offset env s (register_class r)) RSP
| _ -> assert false
-let arg8 i n = emit_subreg reg_low_8_name BYTE i.arg.(n)
-let arg16 i n = emit_subreg reg_low_16_name WORD i.arg.(n)
-let arg32 i n = emit_subreg reg_low_32_name DWORD i.arg.(n)
let arg64 i n = reg64 i.arg.(n)
-let res16 i n = emit_subreg reg_low_16_name WORD i.res.(n)
-let res32 i n = emit_subreg reg_low_32_name DWORD i.res.(n)
-
(* Output an addressing mode *)
let addressing addr typ i n =
(* Record live pointers at call points -- see Emitaux *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := ((r lsl 1) + 1) :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ()
)
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in
def_label lbl
-(* Record calls to the GC -- we've moved them out of the way *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame: label; (* Label of frame descriptor *)
- }
-
-let call_gc_sites = ref ([] : gc_call list)
-
let emit_call_gc gc =
def_label gc.gc_lbl;
emit_call "caml_call_gc";
- def_label gc.gc_frame;
+ def_label gc.gc_frame_lbl;
I.jmp (label gc.gc_return_lbl)
-(* Record calls to caml_ml_array_bound_error.
- In -g mode we maintain one call to
- caml_ml_array_bound_error per bound check site. Without -g, we can share
- a single call. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame: label; (* Label of frame descriptor *)
- (* As for [gc_call]. *)
- }
-
-let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_call = ref 0
-
-let bound_error_label dbg =
+let bound_error_label env dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
- { bd_lbl = lbl_bound_error; bd_frame = lbl_frame; } :: !bound_error_sites;
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <- { bd_lbl = lbl_bound_error; bd_frame = lbl_frame; }
+ :: env.bound_error_sites;
lbl_bound_error
end else begin
- if !bound_error_call = 0 then bound_error_call := new_label();
- !bound_error_call
+ match env.bound_error_call with
+ | None ->
+ let lbl = new_label () in
+ env.bound_error_call <- Some lbl;
+ lbl
+ | Some lbl -> lbl
end
let emit_call_bound_error bd =
emit_call "caml_ml_array_bound_error";
def_label bd.bd_frame
-let emit_call_bound_errors () =
- List.iter emit_call_bound_error !bound_error_sites;
- if !bound_error_call > 0 then begin
- def_label !bound_error_call;
+let emit_call_bound_errors env =
+ List.iter emit_call_bound_error env.bound_error_sites;
+ match env.bound_error_call with
+ | Some lbl ->
+ def_label lbl;
emit_call "caml_ml_array_bound_error"
- end
+ | None -> ()
(* Names for instructions *)
(* Output an = 0 or <> 0 test. *)
-let output_test_zero arg =
+let output_test_zero env arg =
match arg.loc with
- | Reg.Reg _ -> I.test (reg arg) (reg arg)
- | _ -> I.cmp (int 0) (reg arg)
+ | Reg.Reg _ -> I.test (reg env arg) (reg env arg)
+ | _ -> I.cmp (int 0) (reg env arg)
(* Output a floating-point compare and branch *)
-let emit_float_test cmp i lbl =
+let emit_float_test env cmp i lbl =
+ let arg = arg env in
(* Effect of comisd on flags and conditional branches:
ZF PF CF cond. branches taken
unordered 1 1 1 je, jb, jbe, jp
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue f =
- if !frame_required then begin
- let n = frame_size() - 8 - (if fp then 8 else 0) in
+let output_epilogue env f =
+ if env.f.fun_frame_required then begin
+ let n = (frame_size env) - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
I.add (int n) rsp;
(* Output the assembly code for an instruction *)
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-
(* Emit an instruction *)
-let emit_instr fallthrough i =
+let emit_instr env fallthrough i =
+ let arg8 i n = emit_subreg env reg_low_8_name BYTE i.arg.(n) in
+ let arg16 i n = emit_subreg env reg_low_16_name WORD i.arg.(n) in
+ let arg32 i n = emit_subreg env reg_low_32_name DWORD i.arg.(n) in
+ let res16 i n = emit_subreg env reg_low_16_name WORD i.res.(n) in
+ let res32 i n = emit_subreg env reg_low_32_name DWORD i.res.(n) in
+ let arg = arg env in
+ let res = res env in
emit_debug_info i.dbg;
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (!prologue_required);
+ assert (env.f.fun_prologue_required);
if fp then begin
I.push rbp;
cfi_adjust_cfa_offset 8;
I.mov rsp rbp;
end;
- if !frame_required then begin
- let n = frame_size() - 8 - (if fp then 8 else 0) in
+ if env.f.fun_frame_required then begin
+ let n = (frame_size env) - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
I.sub (int n) rsp;
let src = i.arg.(0) and dst = i.res.(0) in
if src.loc <> dst.loc then
begin match src.typ, src.loc, dst.loc with
- | Float, Reg.Reg _, Reg.Reg _ -> I.movapd (reg src) (reg dst)
- | Float, _, _ -> I.movsd (reg src) (reg dst)
- | _ -> I.mov (reg src) (reg dst)
+ | Float, Reg.Reg _, Reg.Reg _ -> I.movapd (reg env src) (reg env dst)
+ | Float, _, _ -> I.movsd (reg env src) (reg env dst)
+ | _ -> I.mov (reg env src) (reg env dst)
end
| Lop(Iconst_int n) ->
if n = 0n then begin
load_symbol_addr s (res i 0)
| Lop(Icall_ind) ->
I.call (arg i 0);
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Icall_imm { func; }) ->
add_used_symbol func;
emit_call func;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Itailcall_ind) ->
- output_epilogue (fun () -> I.jmp (arg i 0))
+ output_epilogue env (fun () -> I.jmp (arg i 0))
| Lop(Itailcall_imm { func; }) ->
begin
- if func = !function_name then
- I.jmp (label !tailrec_entry_point)
+ if func = env.f.fun_name then
+ I.jmp (label env.f.fun_tailrec_entry_point_label)
else begin
- output_epilogue begin fun () ->
+ output_epilogue env begin fun () ->
add_used_symbol func;
emit_jump func
end
if alloc then begin
load_symbol_addr func rax;
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg);
+ record_frame env i.live (Dbg_other i.dbg);
if system <> S_win64 then begin
(* TODO: investigate why such a diff.
This comes from:
then I.sub (int n) rsp;
if n <> 0
then cfi_adjust_cfa_offset n;
- stack_offset := !stack_offset + n
- | Lop(Iload(chunk, addr)) ->
+ env.stack_offset <- env.stack_offset + n
+ | Lop(Iload(chunk, addr, _mut)) ->
let dest = res i 0 in
begin match chunk with
| Word_int | Word_val ->
end
| Lop(Ialloc { bytes = n; dbginfo }) ->
assert (n <= (Config.max_young_wosize + 1) * Arch.size_addr);
- if !fastcode_flag then begin
+ if env.f.fun_fast then begin
I.sub (int n) r15;
I.cmp (domain_field Domainstate.Domain_young_limit) r15;
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo)
+ record_frame_label env i.live (Dbg_alloc dbginfo)
in
I.jb (label lbl_call_gc);
let lbl_after_alloc = new_label() in
def_label lbl_after_alloc;
I.lea (mem64 NONE 8 R15) (res i 0);
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame = lbl_frame; } :: !call_gc_sites
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites
end else begin
begin match n with
| 16 -> emit_call "caml_alloc1"
I.sub (int n) r15;
emit_call "caml_allocN"
end;
- let label = record_frame_label i.live (Dbg_alloc dbginfo) in
+ let label = record_frame_label env i.live (Dbg_alloc dbginfo) in
def_label label;
I.lea (mem64 NONE 8 R15) (res i 0)
end
+ | Lop(Ipoll { return_label }) ->
+ I.cmp (domain_field Domainstate.Domain_young_limit) r15;
+ let gc_call_label = new_label () in
+ let lbl_after_poll = match return_label with
+ | None -> new_label()
+ | Some(lbl) -> lbl in
+ let lbl_frame =
+ record_frame_label env i.live (Dbg_alloc [])
+ in
+ begin match return_label with
+ | None -> I.jbe (label gc_call_label)
+ | Some return_label -> I.ja (label return_label)
+ end;
+ env.call_gc_sites <-
+ { gc_lbl = gc_call_label;
+ gc_return_lbl = lbl_after_poll;
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites;
+ begin match return_label with
+ | None -> def_label lbl_after_poll
+ | Some _ -> I.jmp (label gc_call_label)
+ end
| Lop(Iintop(Icomp cmp)) ->
I.cmp (arg i 1) (arg i 0);
I.set (cond cmp) al;
I.set (cond cmp) al;
I.movzx al (res i 0)
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
I.cmp (arg i 1) (arg i 0);
I.jbe (label lbl)
| Lop(Iintop_imm(Icheckbound, n)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
I.cmp (int n) (arg i 0);
I.jbe (label lbl)
| Lop(Iintop(Idiv | Imod)) ->
I.cvtsi2sd (arg i 0) (res i 0)
| Lop(Iintoffloat) ->
I.cvttsd2si (arg i 0) (res i 0)
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific(Ilea addr)) ->
I.lea (addressing addr NONE i 0) (res i 0)
| Lop(Ispecific(Istore_int(n, addr, _))) ->
I.movsxd (arg32 i 0) (res i 0)
| Lop(Ispecific(Izextend32)) ->
I.mov (arg32 i 0) (res32 i 0)
- | Lop (Iname_for_debugger _) -> ()
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue begin fun () ->
+ output_epilogue env begin fun () ->
I.ret ()
end
| Llabel lbl ->
- emit_Llabel fallthrough lbl
+ emit_Llabel env fallthrough lbl
| Lbranch lbl ->
I.jmp (label lbl)
| Lcondbranch(tst, lbl) ->
let lbl = label lbl in
begin match tst with
| Itruetest ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.jne lbl
| Ifalsetest ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.je lbl
| Iinttest cmp ->
I.cmp (arg i 1) (arg i 0);
I.j (cond cmp) lbl
| Iinttest_imm((Isigned Ceq | Isigned Cne |
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.j (cond cmp) lbl
| Iinttest_imm(cmp, n) ->
I.cmp (int n) (arg i 0);
I.j (cond cmp) lbl
| Ifloattest cmp ->
- emit_float_test cmp i lbl
+ emit_float_test env cmp i lbl
| Ioddtest ->
I.test (int 1) (arg8 i 0);
I.jne lbl
then (phys_reg 4 (*rdx*), phys_reg 0 (*rax*))
else (phys_reg 0 (*rax*), phys_reg 4 (*rdx*)) in
- I.lea (mem64_rip NONE lbl) (reg tmp1);
+ I.lea (mem64_rip NONE lbl) (reg env tmp1);
I.movsxd (mem64 DWORD 0 (arg64 i 0) ~scale:4 ~base:(reg64 tmp1))
- (reg tmp2);
- I.add (reg tmp2) (reg tmp1);
- I.jmp (reg tmp1);
+ (reg env tmp2);
+ I.add (reg env tmp2) (reg env tmp1);
+ I.jmp (reg env tmp1);
begin match system with
| S_mingw64 | S_cygwin -> D.section [".rdata"] (Some "dr") []
- | S_macosx | S_win64 -> () (* with LLVM/OS X and MASM, use the text segment *)
+ | S_macosx | S_win64 -> ()
+ (* with LLVM/OS X and MASM, use the text segment *)
| _ -> D.section [".rodata"] None []
end;
D.align 4;
D.long (ConstSub (ConstLabel(emit_label jumptbl.(i)),
ConstLabel lbl))
done;
- emit_named_text_section !function_name
+ emit_named_text_section env.f.fun_name
| Lentertrap ->
()
| Ladjust_trap_depth { delta_traps; } ->
(* each trap occupies 16 bytes on the stack *)
let delta = 16 * delta_traps in
cfi_adjust_cfa_offset delta;
- stack_offset := !stack_offset + delta
+ env.stack_offset <- env.stack_offset + delta
| Lpushtrap { lbl_handler; } ->
let load_label_addr s arg =
if !Clflags.pic_code then
I.push (domain_field Domainstate.Domain_exception_pointer);
cfi_adjust_cfa_offset 8;
I.mov rsp (domain_field Domainstate.Domain_exception_pointer);
- stack_offset := !stack_offset + 16;
+ env.stack_offset <- env.stack_offset + 16;
| Lpoptrap ->
I.pop (domain_field Domainstate.Domain_exception_pointer);
cfi_adjust_cfa_offset (-8);
I.add (int 8) rsp;
cfi_adjust_cfa_offset (-8);
- stack_offset := !stack_offset - 16
+ env.stack_offset <- env.stack_offset - 16
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
I.mov (int 0) (domain_field Domainstate.Domain_backtrace_pos);
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_notrace ->
I.mov (domain_field Domainstate.Domain_exception_pointer) rsp;
I.pop (domain_field Domainstate.Domain_exception_pointer);
I.jmp r11
end
-let rec emit_all fallthrough i =
+let rec emit_all env fallthrough i =
match i.desc with
| Lend -> ()
| _ ->
- emit_instr fallthrough i;
- emit_all (Linear.has_fallthrough i.desc) i.next
+ emit_instr env fallthrough i;
+ emit_all env (Linear.has_fallthrough i.desc) i.next
let all_functions = ref []
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- fastcode_flag := fundecl.fun_fast;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- bound_error_call := 0;
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- frame_required := fundecl.fun_frame_required;
+ let env = mk_env fundecl in
all_functions := fundecl :: !all_functions;
- emit_named_text_section !function_name;
+ emit_named_text_section fundecl.fun_name;
D.align 16;
add_def_symbol fundecl.fun_name;
if system = S_macosx
D.label (emit_symbol fundecl.fun_name);
emit_debug_info fundecl.fun_dbg;
cfi_startproc ();
- emit_all true fundecl.fun_body;
- List.iter emit_call_gc !call_gc_sites;
- emit_call_bound_errors ();
- if !frame_required then begin
- let n = frame_size() - 8 - (if fp then 8 else 0) in
+ emit_all env true fundecl.fun_body;
+ List.iter emit_call_gc env.call_gc_sites;
+ emit_call_bound_errors env;
+ if fundecl.fun_frame_required then begin
+ let n = (frame_size env) - 8 - (if fp then 8 else 0) in
if n <> 0
then begin
cfi_adjust_cfa_offset (-n);
3. C callee-saved registers.
This translates to the set { r10, r11 }. These registers hence cannot
be used for OCaml parameter passing and must also be marked as
- destroyed across [Ialloc] (otherwise a call to caml_call_gc@PLT might
- clobber these two registers before the assembly stub saves them into
- the GC regs block).
+ destroyed across [Ialloc] and [Ipoll] (otherwise a call to
+ caml_call_gc@PLT might clobber these two registers before the assembly
+ stub saves them into the GC regs block).
*)
let max_arguments_for_tailcalls = 10
100;101;102;103;104;105;106;107;
108;109;110;111;112;113;114;115])
-let destroyed_at_alloc =
+let destroyed_at_alloc_or_poll =
if X86_proc.use_plt then
destroyed_by_plt_stub
else
| Iop(Iintop(Idiv | Imod)) | Iop(Iintop_imm((Idiv | Imod), _))
-> [| rax; rdx |]
| Iop(Istore(Single, _, _)) -> [| rxmm15 |]
- | Iop(Ialloc _) -> destroyed_at_alloc
+ | Iop(Ialloc _ | Ipoll _) -> destroyed_at_alloc_or_poll
| Iop(Iintop(Imulh | Icomp _) | Iintop_imm((Icomp _), _))
-> [| rax |]
| Iswitch(_, _) -> [| rax; rdx |]
if fp then [| 3; 0 |] else [| 4; 0 |]
| Iintop(Idiv | Imod) | Iintop_imm((Idiv | Imod), _) ->
if fp then [| 10; 16 |] else [| 11; 16 |]
- | Ialloc _ ->
+ | Ialloc _ | Ipoll _ ->
if fp then [| 11 - num_destroyed_by_plt_stub; 16 |]
else [| 12 - num_destroyed_by_plt_stub; 16 |]
| Iintop(Icomp _) | Iintop_imm((Icomp _), _) ->
if fp then [| 12; 15 |] else [| 13; 15 |]
| _ -> if fp then [| 12; 16 |] else [| 13; 16 |]
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
- | Ispecific(Ilea _|Isextend32|Izextend32) -> true
- | Ispecific _ -> false
- | _ -> true
-
(* Layout of the stack frame *)
let frame_required fd =
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f =
+ (new selector)#emit_fundecl ~future_funcnames f
s := !s + 2
done;
!s <= m
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+ | Ishiftcheckbound _ -> false
+ | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+ | Ishiftcheckbound _ -> true
+ | _ -> false
open Mach
open Linear
open Emitaux
-
-(* Tradeoff between code size and code speed *)
-
-let fastcode_flag = ref true
+open Emitenv
(* Output a label *)
{loc = Reg r} -> emit_string (register_name r)
| _ -> fatal_error "Emit_arm.emit_reg"
-(* Layout of the stack frame *)
-
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let contains_calls = ref false
-
-let frame_size () =
+let frame_size env =
let sz =
- !stack_offset +
- 4 * num_stack_slots.(0) +
- 8 * num_stack_slots.(1) +
- 8 * num_stack_slots.(2) +
- (if !contains_calls then 4 else 0)
+ env.stack_offset +
+ 4 * env.f.fun_num_stack_slots.(0) +
+ 8 * env.f.fun_num_stack_slots.(1) +
+ 8 * env.f.fun_num_stack_slots.(2) +
+ (if env.f.fun_contains_calls then 4 else 0)
in Misc.align sz 8
-let slot_offset loc cl =
+let slot_offset env loc cl =
match loc with
Incoming n ->
assert (n >= 0);
- frame_size() + n
+ frame_size env + n
| Local n ->
if cl = 0
- then !stack_offset + n * 4
- else !stack_offset + num_stack_slots.(0) * 4 + n * 8
+ then env.stack_offset + n * 4
+ else env.stack_offset + env.f.fun_num_stack_slots.(0) * 4 + n * 8
| Outgoing n ->
assert (n >= 0);
n
(* Output a stack reference *)
-let emit_stack r =
+let emit_stack env r =
match r.loc with
| Stack s ->
- let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`
+ let ofs = slot_offset env s (register_class r) in `[sp, #{emit_int ofs}]`
| _ -> fatal_error "Emit_arm.emit_stack"
(* Output an addressing mode *)
(* Record live pointers at call points *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := ((r lsl 1) + 1) :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ())
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in `{emit_label lbl}:`
-
-(* Record calls to the GC -- we've moved them out of the way *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame_lbl: label } (* Label of frame descriptor *)
-
-let call_gc_sites = ref ([] : gc_call list)
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in `{emit_label lbl}:`
let emit_call_gc gc =
`{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`;
`{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
-(* Record calls to caml_ml_array_bound_error.
- In debug mode, we maintain one call to caml_ml_array_bound_error
- per bound check site. Otherwise, we can share a single call. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame_lbl: label } (* Label of frame descriptor *)
-
-let bound_error_sites = ref ([] : bound_error_call list)
-
-let bound_error_label dbg =
- if !Clflags.debug || !bound_error_sites = [] then begin
+let bound_error_label env dbg =
+ if !Clflags.debug || env.bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <-
{ bd_lbl = lbl_bound_error;
- bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+ bd_frame = lbl_frame;
+ } :: env.bound_error_sites;
lbl_bound_error
end else begin
- let bd = List.hd !bound_error_sites in bd.bd_lbl
+ let bd = List.hd env.bound_error_sites in bd.bd_lbl
end
let emit_call_bound_error bd =
`{emit_label bd.bd_lbl}: {emit_call "caml_ml_array_bound_error"}\n`;
- `{emit_label bd.bd_frame_lbl}:\n`
+ `{emit_label bd.bd_frame}:\n`
(* Negate a comparison *)
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue f =
- let n = frame_size() in
+let output_epilogue env f =
+ let n = frame_size env in
if n > 0 then begin
let ninstr = emit_stack_adjustment n in
let ninstr = ninstr + f () in
end else
f ()
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-(* Pending floating-point literals *)
-let float_literals = ref ([] : (int64 * label) list)
-(* Pending relative references to the global offset table *)
-let gotrel_literals = ref ([] : (label * label) list)
-(* Pending symbol literals *)
-let symbol_literals = ref ([] : (string * label) list)
-(* Total space (in words) occupied by pending literals *)
-let size_literals = ref 0
-
-(* Pending offset computations : {lbl; dst; src;} --> lbl: .word dst-(src+N) *)
-type offset_computation =
- { lbl : label;
- dst : label;
- src : label;
- }
-let offset_literals = ref ([] : offset_computation list)
-
(* Label a floating-point literal *)
-let float_literal f =
+let float_literal env fl =
try
- List.assoc f !float_literals
+ let x = List.find (fun x -> Int64.equal x.fl fl) env.float_literals in
+ x.lbl
with Not_found ->
let lbl = new_label() in
- size_literals := !size_literals + 2;
- float_literals := (f, lbl) :: !float_literals;
+ env.size_literals <- env.size_literals + 2;
+ env.float_literals <- { fl; lbl } :: env.float_literals;
lbl
(* Label a GOTREL literal *)
-let gotrel_literal l =
- let lbl = new_label() in
- size_literals := !size_literals + 1;
- gotrel_literals := (l, lbl) :: !gotrel_literals;
- lbl
+let gotrel_literal env lbl_pic =
+ let lbl_got = new_label() in
+ env.size_literals <- env.size_literals + 1;
+ env.gotrel_literals <- { lbl_got; lbl_pic } :: env.gotrel_literals;
+ lbl_got
(* Label a symbol literal *)
-let symbol_literal s =
+let symbol_literal env sym =
try
- List.assoc s !symbol_literals
+ let sl = List.find (fun x -> String.equal x.sym sym) env.symbol_literals in
+ sl.lbl
with Not_found ->
let lbl = new_label() in
- size_literals := !size_literals + 1;
- symbol_literals := (s, lbl) :: !symbol_literals;
+ env.size_literals <- env.size_literals + 1;
+ env.symbol_literals <- { sym; lbl } :: env.symbol_literals;
lbl
(* Add an offset computation *)
-let offset_literal dst src =
+let offset_literal env dst src =
let lbl = new_label() in
- size_literals := !size_literals + 1;
- offset_literals := { lbl; dst; src; } :: !offset_literals;
+ env.size_literals <- env.size_literals + 1;
+ env.offset_literals <- { lbl; dst; src; } :: env.offset_literals;
lbl
(* Emit all pending literals *)
-let emit_literals() =
- if !float_literals <> [] then begin
+let emit_literals env =
+ if env.float_literals <> [] then begin
` .align 3\n`;
List.iter
- (fun (f, lbl) ->
- `{emit_label lbl}:`; emit_float64_split_directive ".long" f)
- !float_literals;
- float_literals := []
+ (fun {fl; lbl} ->
+ `{emit_label lbl}:`; emit_float64_split_directive ".long" fl)
+ env.float_literals;
+ env.float_literals <- []
end;
- if !symbol_literals <> [] then begin
+ if env.symbol_literals <> [] then begin
let offset = if !thumb then 4 else 8 in
let suffix = if !Clflags.pic_code then "(GOT)" else "" in
` .align 2\n`;
List.iter
- (fun (l, lbl) ->
- `{emit_label lbl}: .word _GLOBAL_OFFSET_TABLE_-({emit_label l}+{emit_int offset})\n`)
- !gotrel_literals;
+ (fun { lbl_got; lbl_pic } ->
+ `{emit_label lbl_pic}: .word _GLOBAL_OFFSET_TABLE_-({emit_label lbl_got}+{emit_int offset})\n`)
+ env.gotrel_literals;
List.iter
- (fun (s, lbl) ->
- `{emit_label lbl}: .word {emit_symbol s}{emit_string suffix}\n`)
- !symbol_literals;
- gotrel_literals := [];
- symbol_literals := []
+ (fun { sym; lbl } ->
+ `{emit_label lbl}: .word {emit_symbol sym}{emit_string suffix}\n`)
+ env.symbol_literals;
+ env.gotrel_literals <- [];
+ env.symbol_literals <- []
end;
- if !offset_literals <> [] then begin
+ if env.offset_literals <> [] then begin
(* Additions using the pc register read a value 4 or 8 bytes greater than
the instruction's address, depending on the Thumb setting. However in
Thumb mode we must follow interworking conventions and ensure that the
List.iter
(fun { lbl; dst; src; } ->
`{emit_label lbl}: .word {emit_label dst}-({emit_label src}+{emit_int offset})\n`)
- !offset_literals;
- offset_literals := []
+ env.offset_literals;
+ env.offset_literals <- []
end;
- size_literals := 0
+ env.size_literals <- 0
(* Emit code to load the address of a symbol *)
-let emit_load_symbol_addr dst s =
+let emit_load_symbol_addr env dst s =
if !Clflags.pic_code then begin
let lbl_pic = new_label() in
- let lbl_got = gotrel_literal lbl_pic in
- let lbl_sym = symbol_literal s in
+ let lbl_got = gotrel_literal env lbl_pic in
+ let lbl_sym = symbol_literal env s in
(* Both r3 and r12 are marked as clobbered in PIC mode (cf. proc.ml),
so use r12 as temporary scratch register unless the destination is
r12, then we use r3 instead. *)
`{emit_label lbl_pic}: add {emit_reg tmp}, pc, {emit_reg tmp}\n`;
` ldr {emit_reg dst}, [{emit_reg tmp}, {emit_reg dst}] @ {emit_symbol s}\n`;
4
- end else if !arch > ARMv6 && not !Clflags.dlcode && !fastcode_flag then begin
+ end else if !arch > ARMv6 && not !Clflags.dlcode && env.f.fun_fast then begin
` movw {emit_reg dst}, #:lower16:{emit_symbol s}\n`;
` movt {emit_reg dst}, #:upper16:{emit_symbol s}\n`;
2
end else begin
- let lbl = symbol_literal s in
+ let lbl = symbol_literal env s in
` ldr {emit_reg dst}, {emit_label lbl} @ {emit_symbol s}\n`;
1
end
end
(* Emit code to load the address of a label in the lr register *)
-let emit_load_handler_address handler =
+let emit_load_handler_address env handler =
(* PIC code *)
let lbl_src = new_label() in
- let lbl_offset = offset_literal handler lbl_src in
+ let lbl_offset = offset_literal env handler lbl_src in
` ldr lr, {emit_label lbl_offset}\n`;
`{emit_label lbl_src}:\n`;
` add lr, pc, lr\n`;
(* Output the assembly code for an instruction *)
-let emit_instr i =
+let emit_instr env i =
emit_debug_info i.dbg;
match i.desc with
| Lend -> 0
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env in
let num_instrs =
if n > 0 then begin
let num_instrs = emit_stack_adjustment (-n) in
- if !contains_calls then begin
+ if env.f.fun_contains_calls then begin
cfi_offset ~reg:14 (* lr *) ~offset:(-4);
` str lr, [sp, #{emit_int(n - 4)}]\n`;
num_instrs + 1
0
end
in
- `{emit_label !tailrec_entry_point}:\n`;
+ `{emit_label env.f.fun_tailrec_entry_point_label}:\n`;
num_instrs
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
| {loc = Reg _}, {loc = Reg _} ->
` mov {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _; typ = Float}, _ ->
- ` fstd {emit_reg src}, {emit_stack dst}\n`
+ ` fstd {emit_reg src}, {emit_stack env dst}\n`
| {loc = Reg _}, _ ->
- ` str {emit_reg src}, {emit_stack dst}\n`
+ ` str {emit_reg src}, {emit_stack env dst}\n`
| {typ = Float}, _ ->
- ` fldd {emit_reg dst}, {emit_stack src}\n`
+ ` fldd {emit_reg dst}, {emit_stack env src}\n`
| _ ->
- ` ldr {emit_reg dst}, {emit_stack src}\n`
+ ` ldr {emit_reg dst}, {emit_stack env src}\n`
end; 1
end
| Lop(Iconst_int n) ->
and ninstr_high = emit_intconst i.res.(1) high_bits in
ninstr_low + ninstr_high
end else begin
- let lbl = float_literal f in
+ let lbl = float_literal env f in
` ldr {emit_reg i.res.(0)}, {emit_label lbl}\n`;
` ldr {emit_reg i.res.(1)}, {emit_label lbl} + 4\n`;
2
end
| Lop(Iconst_float f) when !fpu = VFPv2 ->
- let lbl = float_literal f in
+ let lbl = float_literal env f in
` fldd {emit_reg i.res.(0)}, {emit_label lbl}\n`;
1
| Lop(Iconst_float f) ->
end in
begin match encode f with
None ->
- let lbl = float_literal f in
+ let lbl = float_literal env f in
` fldd {emit_reg i.res.(0)}, {emit_label lbl}\n`
| Some imm8 ->
` fconstd {emit_reg i.res.(0)}, #{emit_int imm8}\n`
end; 1
| Lop(Iconst_symbol s) ->
- emit_load_symbol_addr i.res.(0) s
+ emit_load_symbol_addr env i.res.(0) s
| Lop(Icall_ind) ->
if !arch >= ARMv5 then begin
` blx {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`; 1
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`; 1
end else begin
` mov lr, pc\n`;
` bx {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`; 2
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`; 2
end
| Lop(Icall_imm { func; }) ->
` {emit_call func}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`; 1
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`; 1
| Lop(Itailcall_ind) ->
- output_epilogue begin fun () ->
- if !contains_calls then
+ output_epilogue env begin fun () ->
+ if env.f.fun_contains_calls then
` ldr lr, [sp, #{emit_int (-4)}]\n`;
` bx {emit_reg i.arg.(0)}\n`; 2
end
| Lop(Itailcall_imm { func; }) ->
- if func = !function_name then begin
- ` b {emit_label !tailrec_entry_point}\n`; 1
+ if func = env.f.fun_name then begin
+ ` b {emit_label env.f.fun_tailrec_entry_point_label}\n`; 1
end else begin
- output_epilogue begin fun () ->
- if !contains_calls then
+ output_epilogue env begin fun () ->
+ if env.f.fun_contains_calls then
` ldr lr, [sp, #{emit_int (-4)}]\n`;
` {emit_jump func}\n`; 2
end
| Lop(Iextcall { func; alloc = false; }) ->
` {emit_call func}\n`; 1
| Lop(Iextcall { func; alloc = true; }) ->
- let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) func in
+ let ninstr = emit_load_symbol_addr env (phys_reg 7 (* r7 *)) func in
` {emit_call "caml_c_call"}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`;
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`;
1 + ninstr
| Lop(Istackoffset n) ->
assert (n mod 8 = 0);
let ninstr = emit_stack_adjustment (-n) in
- stack_offset := !stack_offset + n;
+ env.stack_offset <- env.stack_offset + n;
ninstr
- | Lop(Iload(Single, addr)) when !fpu >= VFPv2 ->
+ | Lop(Iload(Single, addr, _mut)) when !fpu >= VFPv2 ->
` flds s14, {emit_addressing addr i.arg 0}\n`;
` fcvtds {emit_reg i.res.(0)}, s14\n`; 2
- | Lop(Iload((Double | Double_u), addr)) when !fpu = Soft ->
+ | Lop(Iload((Double | Double_u), addr, _mut)) when !fpu = Soft ->
(* Use LDM or LDRD if possible *)
begin match i.res.(0), i.res.(1), addr with
{loc = Reg rt}, {loc = Reg rt2}, Iindexed 0
` ldr {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
end; 2
end
- | Lop(Iload(size, addr)) ->
+ | Lop(Iload(size, addr, _mut)) ->
let r = i.res.(0) in
let instr =
match size with
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
| Lop(Ialloc { bytes = n; dbginfo }) ->
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo)
+ record_frame_label env i.live (Dbg_alloc dbginfo)
in
- if !fastcode_flag then begin
+ if env.f.fun_fast then begin
let ninstr = decompose_intconst
(Int32.of_int n)
(fun i ->
let lbl_after_alloc = new_label() in
`{emit_label lbl_after_alloc}:`;
` add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame_lbl = lbl_frame } :: !call_gc_sites;
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites;
4 + ninstr
end else begin
let ninstr =
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, alloc_ptr, #4\n`;
1 + ninstr
end
+ | Lop(Ipoll { return_label }) ->
+ begin match return_label with
+ None -> 0
+ | Some lbl -> ` b {emit_label lbl}\n`; 1
+ end
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
1 + emit_set_condition cmp i.res.(0)
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
1 + emit_set_condition cmp i.res.(0)
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` bls {emit_label lbl}\n`; 2
| Lop(Iintop_imm(Icheckbound, n)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` cmp {emit_reg i.arg.(0)}, #{emit_int n}\n`;
` bls {emit_label lbl}\n`; 2
| Lop(Ispecific(Ishiftcheckbound(shiftop, n))) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
let op = name_for_shift_operation shiftop in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, {emit_string op} #{emit_int n}\n`;
` bcs {emit_label lbl}\n`; 2
| Lop(Iintoffloat) ->
` ftosizd s14, {emit_reg i.arg.(0)}\n`;
` fmrs {emit_reg i.res.(0)}, s14\n`; 2
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc); 0
| Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->
let instr = (match op with
Iaddf -> "faddd"
| _ ->
assert false
end
- | Lop (Iname_for_debugger _) -> 0
| Lreloadretaddr ->
- let n = frame_size() in
+ let n = frame_size env in
` ldr lr, [sp, #{emit_int(n-4)}]\n`; 1
| Lreturn ->
- output_epilogue begin fun () ->
+ output_epilogue env begin fun () ->
` bx lr\n`; 1
end
| Llabel lbl ->
(* each trap occupies 8 bytes on the stack *)
let delta = 8 * delta_traps in
cfi_adjust_cfa_offset delta;
- stack_offset := !stack_offset + delta; 0
+ env.stack_offset <- env.stack_offset + delta; 0
| Lpushtrap { lbl_handler; } ->
- let s = emit_load_handler_address lbl_handler in
- stack_offset := !stack_offset + 8;
+ let s = emit_load_handler_address env lbl_handler in
+ env.stack_offset <- env.stack_offset + 8;
` push \{trap_ptr, lr}\n`;
cfi_adjust_cfa_offset 8;
` mov trap_ptr, sp\n`; s + 2
| Lpoptrap ->
` pop \{trap_ptr, lr}\n`;
cfi_adjust_cfa_offset (-8);
- stack_offset := !stack_offset - 8; 1
+ env.stack_offset <- env.stack_offset - 8; 1
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
` mov r12, #0\n`;
` str r12, [domain_state_ptr, {emit_int offset}]\n`;
` {emit_call "caml_raise_exn"}\n`;
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 3
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`; 3
| Lambda.Raise_reraise ->
` {emit_call "caml_raise_exn"}\n`;
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`; 1
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`; 1
| Lambda.Raise_notrace ->
` mov sp, trap_ptr\n`;
` pop \{trap_ptr, pc}\n`; 2
(* Emission of an instruction sequence *)
-let rec emit_all ninstr fallthrough i =
+let rec emit_all env ninstr fallthrough i =
(* ninstr = number of 32-bit code words emitted since last constant island *)
(* fallthrough is true if previous instruction can fall through *)
if i.desc = Lend then () else begin
(* Make sure literals not yet emitted remain addressable,
or emit them in a new constant island. *)
(* fldd can address up to +/-1KB, ldr can address up to +/-4KB *)
- let limit = (if !fpu >= VFPv2 && !float_literals <> []
+ let limit = (if !fpu >= VFPv2 && env.float_literals <> []
then 127
else 511) in
- let limit = limit - !size_literals - max_instruction_size i in
+ let limit = limit - env.size_literals - max_instruction_size i in
let ninstr' =
if ninstr >= limit - 64 && not fallthrough then begin
- emit_literals();
+ emit_literals env;
0
- end else if !size_literals != 0 && ninstr >= limit then begin
+ end else if env.size_literals != 0 && ninstr >= limit then begin
let lbl = new_label() in
` b {emit_label lbl}\n`;
- emit_literals();
+ emit_literals env;
`{emit_label lbl}:\n`;
0
end else
ninstr in
- let n = emit_instr i in
- emit_all (ninstr' + n) (has_fallthrough i.desc) i.next
+ let n = emit_instr env i in
+ emit_all env (ninstr' + n) (has_fallthrough i.desc) i.next
end
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- fastcode_flag := fundecl.fun_fast;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- float_literals := [];
- gotrel_literals := [];
- symbol_literals := [];
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- contains_calls := fundecl.fun_contains_calls;
- prologue_required := fundecl.fun_prologue_required;
- emit_named_text_section !function_name;
+ let env = mk_env fundecl in
+ emit_named_text_section fundecl.fun_name;
` .align 2\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
if !arch > ARMv6 && !thumb then
`{emit_symbol fundecl.fun_name}:\n`;
emit_debug_info fundecl.fun_dbg;
cfi_startproc();
- emit_all 0 true fundecl.fun_body;
- emit_literals();
- List.iter emit_call_gc !call_gc_sites;
- List.iter emit_call_bound_error !bound_error_sites;
+ emit_all env 0 true fundecl.fun_body;
+ emit_literals env;
+ List.iter emit_call_gc env.call_gc_sites;
+ List.iter emit_call_bound_error env.bound_error_sites;
cfi_endproc();
` .type {emit_symbol fundecl.fun_name}, %function\n`;
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`
| Iop(Iintop (Icomp _) | Iintop_imm(Icomp _, _))
when !arch >= ARMv8 && !thumb ->
[| phys_reg 3 |] (* r3 destroyed *)
- | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
+ | Iop(Iintoffloat | Ifloatofint
+ | Iload(Single, _, _) | Istore(Single, _, _)) ->
[| phys_reg 107 |] (* d7 (s14-s15) destroyed *)
| _ -> [||]
| Ialloc _ -> if abi = EABI then [| 7; 0; 0 |] else [| 7; 8; 8 |]
| Iconst_symbol _ when !Clflags.pic_code -> [| 7; 16; 32 |]
| Iintoffloat | Ifloatofint
- | Iload(Single, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
+ | Iload(Single, _, _) | Istore(Single, _, _) -> [| 9; 15; 31 |]
| Iintop Imulh when !arch < ARMv6 -> [| 8; 16; 32 |]
| _ -> [| 9; 16; 32 |]
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
- | Ispecific(Ishiftcheckbound _) -> false
- | _ -> true
-
(* Layout of the stack *)
let frame_required fd =
(* Loads have a latency of two cycles in general *)
Iconst_symbol _
| Iconst_float _
- | Iload(_, _)
+ | Iload(_, _, _)
| Ireload
| Ifloatofint (* mcr/mrc count as memory access *)
| Iintoffloat -> 2
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f =
+ (new selector)#emit_fundecl ~future_funcnames f
(* Do not introduce a dependency to Cmm *)
type specific_operation =
+ | Ifar_poll of { return_label: cmm_label option }
| Ifar_alloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
| Ifar_intop_checkbound
| Ifar_intop_imm_checkbound of { bound : int; }
| Isqrtf (* floating-point square root *)
| Ibswap of int (* endianness conversion *)
| Imove32 (* 32-bit integer move *)
+ | Isignext of int (* sign extension *)
and arith_operation =
Ishiftadd
let print_specific_operation printreg op ppf arg =
match op with
+ | Ifar_poll _ ->
+ fprintf ppf "(far) poll"
| Ifar_alloc { bytes; } ->
fprintf ppf "(far) alloc %i" bytes
| Ifar_intop_checkbound ->
| Imove32 ->
fprintf ppf "move32 %a"
printreg arg.(0)
+ | Isignext n ->
+ fprintf ppf "signext%d %a"
+ n printreg arg.(0)
+
+(* Recognition of logical immediate arguments *)
+
+(* An automaton to recognize ( 0+1+0* | 1+0+1* )
+
+ 0 1 0
+ / \ / \ / \
+ \ / \ / \ /
+ -0--> [1] --1--> [2] --0--> [3]
+ /
+ [0]
+ \
+ -1--> [4] --0--> [5] --1--> [6]
+ / \ / \ / \
+ \ / \ / \ /
+ 1 0 1
+
+The accepting states are 2, 3, 5 and 6. *)
+
+let auto_table = [| (* accepting?, next on 0, next on 1 *)
+ (* state 0 *) (false, 1, 4);
+ (* state 1 *) (false, 1, 2);
+ (* state 2 *) (true, 3, 2);
+ (* state 3 *) (true, 3, 7);
+ (* state 4 *) (false, 5, 4);
+ (* state 5 *) (true, 5, 6);
+ (* state 6 *) (true, 7, 6);
+ (* state 7 *) (false, 7, 7) (* error state *)
+|]
+
+let rec run_automata nbits state input =
+ let (acc, next0, next1) = auto_table.(state) in
+ if nbits <= 0
+ then acc
+ else run_automata (nbits - 1)
+ (if Nativeint.logand input 1n = 0n then next0 else next1)
+ (Nativeint.shift_right_logical input 1)
+
+(* The following function determines a length [e]
+ such that [x] is a repetition [BB...B] of a bit pattern [B] of length [e].
+ [e] ranges over 64, 32, 16, 8, 4, 2. The smaller [e] the better. *)
+
+let logical_imm_length x =
+ (* [test n] checks that the low [2n] bits of [x] are of the
+ form [BB], that is, two occurrences of the same [n] bits *)
+ let test n =
+ let mask = Nativeint.(sub (shift_left 1n n) 1n) in
+ let low_n_bits = Nativeint.(logand x mask) in
+ let next_n_bits = Nativeint.(logand (shift_right_logical x n) mask) in
+ low_n_bits = next_n_bits in
+ (* If [test n] fails, we know that the length [e] is
+ at least [2n]. Hence we test with decreasing values of [n]:
+ 32, 16, 8, 4, 2. *)
+ if not (test 32) then 64
+ else if not (test 16) then 32
+ else if not (test 8) then 16
+ else if not (test 4) then 8
+ else if not (test 2) then 4
+ else 2
+
+(* A valid logical immediate is
+- neither [0] nor [-1];
+- composed of a repetition [BBBBB] of a bit-pattern [B] of length [e]
+- the low [e] bits of the number, that is, [B], match [0+1+0*] or [1+0+1*].
+*)
+
+let is_logical_immediate x =
+ x <> 0n && x <> -1n && run_automata (logical_imm_length x) 0 x
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+ | Ifar_alloc _
+ | Ifar_intop_checkbound
+ | Ifar_intop_imm_checkbound _
+ | Ishiftcheckbound _
+ | Ifar_shiftcheckbound _ -> false
+ | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+ | Ifar_alloc _
+ | Ifar_intop_checkbound
+ | Ifar_intop_imm_checkbound _
+ | Ishiftcheckbound _
+ | Ifar_shiftcheckbound _ -> true
+ | _ -> false
open Mach
open Linear
open Emitaux
-
-(* Tradeoff between code size and code speed *)
-
-let fastcode_flag = ref true
+open Emitenv
(* Names for special regs *)
-let reg_domain_state_ptr = phys_reg 22
-let reg_trap_ptr = phys_reg 23
-let reg_alloc_ptr = phys_reg 24
-let reg_alloc_limit = phys_reg 25
-let reg_tmp1 = phys_reg 26
-let reg_x8 = phys_reg 8
+let reg_domain_state_ptr = phys_reg 25 (* x28 *)
+let reg_trap_ptr = phys_reg 23 (* x26 *)
+let reg_alloc_ptr = phys_reg 24 (* x27 *)
+let reg_tmp1 = phys_reg 26 (* x16 *)
+let reg_x8 = phys_reg 8 (* x8 *)
(* Output a label *)
{loc = Reg r} -> emit_string int_reg_name_w.(r)
| _ -> fatal_error "Emit.emit_wreg"
-(* Layout of the stack frame *)
-
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
+let initial_stack_offset f =
+ 8 * f.fun_num_stack_slots.(0) +
+ 8 * f.fun_num_stack_slots.(1) +
+ (if f.fun_contains_calls then 8 else 0)
-let contains_calls = ref false
-
-let initial_stack_offset () =
- 8 * num_stack_slots.(0) +
- 8 * num_stack_slots.(1) +
- (if !contains_calls then 8 else 0)
-
-let frame_size () =
+let frame_size env =
let sz =
- !stack_offset +
- initial_stack_offset ()
+ env.stack_offset + initial_stack_offset env.f
in Misc.align sz 16
-let slot_offset loc cl =
+let slot_offset env loc cl =
match loc with
Incoming n ->
assert (n >= 0);
- frame_size() + n
+ frame_size env + n
| Local n ->
- !stack_offset +
+ env.stack_offset +
(if cl = 0
then n * 8
- else num_stack_slots.(0) * 8 + n * 8)
+ else env.f.fun_num_stack_slots.(0) * 8 + n * 8)
| Outgoing n ->
assert (n >= 0);
n
(* Output a stack reference *)
-let emit_stack r =
+let emit_stack env r =
match r.loc with
| Stack s ->
- let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`
+ let ofs = slot_offset env s (register_class r) in `[sp, #{emit_int ofs}]`
| _ -> fatal_error "Emit.emit_stack"
(* Output an addressing mode *)
(* Record live pointers at call points *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := ((r lsl 1) + 1) :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ())
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in `{emit_label lbl}:`
-
-(* Record calls to the GC -- we've moved them out of the way *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame_lbl: label } (* Label of frame descriptor *)
-
-let call_gc_sites = ref ([] : gc_call list)
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in `{emit_label lbl}:`
let emit_call_gc gc =
`{emit_label gc.gc_lbl}: bl {emit_symbol "caml_call_gc"}\n`;
`{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
-(* Record calls to caml_ml_array_bound_error.
- In debug mode, we maintain one call to caml_ml_array_bound_error
- per bound check site. Otherwise, we can share a single call. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame_lbl: label } (* Label of frame descriptor *)
-
-let bound_error_sites = ref ([] : bound_error_call list)
-
-let bound_error_label dbg =
- if !Clflags.debug || !bound_error_sites = [] then begin
+let bound_error_label env dbg =
+ if !Clflags.debug || env.bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <-
{ bd_lbl = lbl_bound_error;
- bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+ bd_frame = lbl_frame;
+ } :: env.bound_error_sites;
lbl_bound_error
end else begin
- let bd = List.hd !bound_error_sites in bd.bd_lbl
+ let bd = List.hd env.bound_error_sites in bd.bd_lbl
end
let emit_call_bound_error bd =
`{emit_label bd.bd_lbl}: bl {emit_symbol "caml_ml_array_bound_error"}\n`;
- `{emit_label bd.bd_frame_lbl}:\n`
+ `{emit_label bd.bd_frame}:\n`
(* Names of various instructions *)
| Iasr -> "asr"
| _ -> assert false
+(* Decompose an integer constant into four 16-bit shifted fragments.
+ Omit the fragments that are equal to "default" (16 zeros or 16 ones). *)
+
+let decompose_int default n =
+ let rec decomp n pos =
+ if pos >= 64 then [] else begin
+ let frag = Nativeint.logand n 0xFFFFn
+ and rem = Nativeint.shift_right_logical n 16 in
+ if frag = default
+ then decomp rem (pos + 16)
+ else (frag, pos) :: decomp rem (pos + 16)
+ end
+ in decomp n 0
+
(* Load an integer constant into a register *)
+let emit_movk dst (f, p) =
+ ` movk {emit_reg dst}, #{emit_nativeint f}, lsl #{emit_int p}\n`
+
let emit_intconst dst n =
- let rec emit_pos first shift =
- if shift < 0 then begin
- if first then ` mov {emit_reg dst}, xzr\n`
- end else begin
- let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
- if s = 0n then emit_pos first (shift - 16) else begin
- if first then
- ` movz {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`
- else
- ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
- emit_pos false (shift - 16)
- end
- end
- and emit_neg first shift =
- if shift < 0 then begin
- if first then ` movn {emit_reg dst}, #0\n`
+ if is_logical_immediate n then
+ ` orr {emit_reg dst}, xzr, #{emit_nativeint n}\n`
+ else begin
+ let dz = decompose_int 0x0000n n
+ and dn = decompose_int 0xFFFFn n in
+ if List.length dz <= List.length dn then begin
+ match dz with
+ | [] ->
+ ` mov {emit_reg dst}, xzr\n`
+ | (f, p) :: l ->
+ ` movz {emit_reg dst}, #{emit_nativeint f}, lsl #{emit_int p}\n`;
+ List.iter (emit_movk dst) l
end else begin
- let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
- if s = 0xFFFFn then emit_neg first (shift - 16) else begin
- if first then
- ` movn {emit_reg dst}, #{emit_nativeint (Nativeint.logxor s 0xFFFFn)}, lsl #{emit_int shift}\n`
- else
- ` movk {emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;
- emit_neg false (shift - 16)
- end
+ match dn with
+ | [] ->
+ ` movn {emit_reg dst}, #0\n`
+ | (f, p) :: l ->
+ let nf = Nativeint.logxor f 0xFFFFn in
+ ` movn {emit_reg dst}, #{emit_nativeint nf}, lsl #{emit_int p}\n`;
+ List.iter (emit_movk dst) l
end
- in
- if n < 0n then emit_neg true 48 else emit_pos true 48
+ end
let num_instructions_for_intconst n =
- let num_instructions = ref 0 in
- let rec count_pos first shift =
- if shift < 0 then begin
- if first then incr num_instructions
- end else begin
- let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
- if s = 0n then count_pos first (shift - 16) else begin
- incr num_instructions;
- count_pos false (shift - 16)
- end
- end
- and count_neg first shift =
- if shift < 0 then begin
- if first then incr num_instructions
- end else begin
- let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in
- if s = 0xFFFFn then count_neg first (shift - 16) else begin
- incr num_instructions;
- count_neg false (shift - 16)
- end
- end
- in
- if n < 0n then count_neg true 48 else count_pos true 48;
- !num_instructions
+ if is_logical_immediate n then 1 else begin
+ let dz = decompose_int 0x0000n n
+ and dn = decompose_int 0xFFFFn n in
+ max 1 (min (List.length dz) (List.length dn))
+ end
(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:
"a normalized binary floating point encoding with 1 sign bit, 4
(* Deallocate the stack frame and reload the return address
before a return or tail call *)
-let output_epilogue f =
- let n = frame_size() in
- if !contains_calls then
+let output_epilogue env f =
+ let n = frame_size env in
+ if env.f.fun_contains_calls then
` ldr x30, [sp, #{emit_int (n-8)}]\n`;
if n > 0 then
emit_stack_adjustment n;
then ` cmp {emit_reg rs}, #{emit_int n}\n`
else ` cmn {emit_reg rs}, #{emit_int (-n)}\n`
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-(* Pending floating-point literals *)
-let float_literals = ref ([] : (int64 * label) list)
-
(* Label a floating-point literal *)
-let float_literal f =
+let float_literal env fl =
try
- List.assoc f !float_literals
+ let x = List.find (fun x -> Int64.equal x.fl fl) env.float_literals in
+ x.lbl
with Not_found ->
let lbl = new_label() in
- float_literals := (f, lbl) :: !float_literals;
+ env.float_literals <- { fl; lbl } :: env.float_literals;
lbl
(* Emit all pending literals *)
-let emit_literals() =
- if !float_literals <> [] then begin
+let emit_literals env =
+ if env.float_literals <> [] then begin
if macosx then
` .section __TEXT,__literal8,8byte_literals\n`;
` .align 3\n`;
List.iter
- (fun (f, lbl) ->
- `{emit_label lbl}:`; emit_float64_directive ".quad" f)
- !float_literals;
- float_literals := []
+ (fun { fl; lbl } ->
+ `{emit_label lbl}:`; emit_float64_directive ".quad" fl)
+ env.float_literals;
+ env.float_literals <- []
end
(* Emit code to load the address of a symbol *)
call GC and bounds check points emitted out-of-line from the function
body. See branch_relaxation.mli. *)
-let num_call_gc_and_check_bound_points instr =
+let num_call_gc_and_check_bound_points env =
let rec loop instr ((call_gc, check_bound) as totals) =
match instr.desc with
| Lend -> totals
- | Lop (Ialloc _) when !fastcode_flag ->
+ | Lop (Ialloc _) when env.f.fun_fast ->
+ loop instr.next (call_gc + 1, check_bound)
+ | Lop (Ipoll _) ->
loop instr.next (call_gc + 1, check_bound)
| Lop (Iintop Icheckbound)
| Lop (Iintop_imm (Icheckbound, _))
(* The following four should never be seen, since this function is run
before branch relaxation. *)
| Lop (Ispecific (Ifar_alloc _))
+ | Lop (Ispecific (Ifar_poll _))
| Lop (Ispecific Ifar_intop_checkbound)
| Lop (Ispecific (Ifar_intop_imm_checkbound _))
| Lop (Ispecific (Ifar_shiftcheckbound _)) -> assert false
| _ -> loop instr.next totals
in
- loop instr (0, 0)
+ loop env.f.fun_body (0, 0)
let max_out_of_line_code_offset ~num_call_gc ~num_check_bound =
if num_call_gc < 1 && num_check_bound < 1 then 0
let classify_instr = function
| Lop (Ialloc _)
+ | Lop (Ipoll _)
| Lop (Iintop Icheckbound)
| Lop (Iintop_imm (Icheckbound, _))
| Lop (Ispecific (Ishiftcheckbound _)) -> Some Bcc
let offset_pc_at_branch = 0
- let prologue_size () =
- (if initial_stack_offset () > 0 then 2 else 0)
- + (if !contains_calls then 1 else 0)
+ let prologue_size f =
+ (if initial_stack_offset f > 0 then 2 else 0)
+ + (if f.fun_contains_calls then 1 else 0)
- let epilogue_size () =
- if !contains_calls then 3 else 2
+ let epilogue_size f =
+ if f.fun_contains_calls then 3 else 2
- let instr_size = function
+ let instr_size f = function
| Lend -> 0
- | Lprologue -> prologue_size ()
+ | Lprologue -> prologue_size f
| Lop (Imove | Ispill | Ireload) -> 1
| Lop (Iconst_int n) ->
num_instructions_for_intconst n
| Lop (Iconst_symbol _) -> 2
| Lop (Icall_ind) -> 1
| Lop (Icall_imm _) -> 1
- | Lop (Itailcall_ind) -> epilogue_size ()
+ | Lop (Itailcall_ind) -> epilogue_size f
| Lop (Itailcall_imm { func; _ }) ->
- if func = !function_name then 1 else epilogue_size ()
+ if func = f.fun_name then 1 else epilogue_size f
| Lop (Iextcall { alloc = false; }) -> 1
| Lop (Iextcall { alloc = true; }) -> 3
| Lop (Istackoffset _) -> 2
- | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) ->
+ | Lop (Iload (size, addr, _)) | Lop (Istore (size, addr, _)) ->
let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in
based + begin match size with Single -> 2 | _ -> 1 end
- | Lop (Ialloc {bytes = num_bytes}) when !fastcode_flag ->
- if num_bytes <= 0xFFF then 4 else 5
- | Lop (Ispecific (Ifar_alloc {bytes = num_bytes})) when !fastcode_flag ->
- if num_bytes <= 0xFFF then 5 else 6
+ | Lop (Ialloc _) when f.fun_fast -> 5
+ | Lop (Ispecific (Ifar_alloc _)) when f.fun_fast -> 6
+ | Lop (Ipoll _) -> 3
+ | Lop (Ispecific (Ifar_poll _)) -> 4
| Lop (Ialloc { bytes = num_bytes; _ })
| Lop (Ispecific (Ifar_alloc { bytes = num_bytes; _ })) ->
begin match num_bytes with
| Lop (Iintop_imm _) -> 1
| Lop (Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf) -> 1
| Lop (Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf) -> 1
+ | Lop (Iopaque) -> 0
| Lop (Ispecific (Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf)) -> 1
| Lop (Ispecific (Ishiftarith _)) -> 1
| Lop (Ispecific (Imuladd | Imulsub)) -> 1
| Lop (Ispecific (Ibswap 16)) -> 2
| Lop (Ispecific (Ibswap _)) -> 1
| Lop (Ispecific Imove32) -> 1
- | Lop (Iname_for_debugger _) -> 0
+ | Lop (Ispecific (Isignext _)) -> 1
| Lreloadretaddr -> 0
- | Lreturn -> epilogue_size ()
+ | Lreturn -> epilogue_size f
| Llabel _ -> 0
| Lbranch _ -> 1
| Lcondbranch (tst, _) ->
| Lambda.Raise_notrace -> 4
end
+ let relax_poll ~return_label =
+ Lop (Ispecific (Ifar_poll { return_label }))
+
let relax_allocation ~num_bytes ~dbginfo =
Lop (Ispecific (Ifar_alloc { bytes = num_bytes; dbginfo }))
(* Output the assembly code for allocation. *)
-let assembly_code_for_allocation i ~n ~far ~dbginfo =
+let assembly_code_for_allocation env i ~n ~far ~dbginfo =
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo)
+ record_frame_label env i.live (Dbg_alloc dbginfo)
in
- if !fastcode_flag then begin
+ if env.f.fun_fast then begin
let lbl_after_alloc = new_label() in
let lbl_call_gc = new_label() in
(* n is at most Max_young_whsize * 8, i.e. currently 0x808,
so it is reasonable to assume n < 0x1_000. This makes
the generated code simpler. *)
assert (16 <= n && n < 0x1_000 && n land 0x7 = 0);
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` ldr {emit_reg reg_tmp1}, [{emit_reg reg_domain_state_ptr}, #{emit_int offset}]\n`;
` sub {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;
- ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;
+ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp1}\n`;
if not far then begin
` b.lo {emit_label lbl_call_gc}\n`
end else begin
end;
`{emit_label lbl_after_alloc}:`;
` add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame_lbl = lbl_frame } :: !call_gc_sites
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites
end else begin
begin match n with
| 16 -> ` bl {emit_symbol "caml_alloc1"}\n`
`{emit_label lbl_frame}: add {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`
end
+let assembly_code_for_poll env i ~far ~return_label =
+ let lbl_frame = record_frame_label env i.live (Dbg_alloc []) in
+ let lbl_call_gc = new_label() in
+ let lbl_after_poll = match return_label with
+ | None -> new_label()
+ | Some lbl -> lbl in
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` ldr {emit_reg reg_tmp1}, [{emit_reg reg_domain_state_ptr}, #{emit_int offset}]\n`;
+ ` cmp {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp1}\n`;
+ if not far then begin
+ match return_label with
+ | None ->
+ ` b.ls {emit_label lbl_call_gc}\n`;
+ `{emit_label lbl_after_poll}:\n`
+ | Some return_label ->
+ ` b.hi {emit_label return_label}\n`;
+ ` b {emit_label lbl_call_gc}\n`;
+ end else begin
+ match return_label with
+ | None ->
+ ` b.hi {emit_label lbl_after_poll}\n`;
+ ` b {emit_label lbl_call_gc}\n`;
+ `{emit_label lbl_after_poll}:\n`
+ | Some return_label ->
+ let lbl = new_label () in
+ ` b.ls {emit_label lbl}\n`;
+ ` b {emit_label return_label}\n`;
+ `{emit_label lbl}: b {emit_label lbl_call_gc}\n`
+ end;
+ env.call_gc_sites <-
+ { gc_lbl = lbl_call_gc;
+ gc_return_lbl = lbl_after_poll;
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites
+
(* Output .text section directive, or named .text.caml.<name> if enabled. *)
let emit_named_text_section func_name =
(* Output the assembly code for an instruction *)
-let emit_instr i =
+let emit_instr env i =
emit_debug_info i.dbg;
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env in
if n > 0 then
emit_stack_adjustment (-n);
- if !contains_calls then begin
+ if env.f.fun_contains_calls then begin
cfi_offset ~reg:30 (* return address *) ~offset:(-8);
` str x30, [sp, #{emit_int (n-8)}]\n`
end
| {loc = Reg _}, {loc = Reg _} ->
` mov {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _}, {loc = Stack _} ->
- ` str {emit_reg src}, {emit_stack dst}\n`
+ ` str {emit_reg src}, {emit_stack env dst}\n`
| {loc = Stack _}, {loc = Reg _} ->
- ` ldr {emit_reg dst}, {emit_stack src}\n`
+ ` ldr {emit_reg dst}, {emit_stack env src}\n`
| _ ->
assert false
end
| {loc = Reg _}, {loc = Reg _} ->
` mov {emit_wreg dst}, {emit_wreg src}\n`
| {loc = Reg _}, {loc = Stack _} ->
- ` str {emit_wreg src}, {emit_stack dst}\n`
+ ` str {emit_wreg src}, {emit_stack env dst}\n`
| {loc = Stack _}, {loc = Reg _} ->
- ` ldr {emit_wreg dst}, {emit_stack src}\n`
+ ` ldr {emit_wreg dst}, {emit_stack env src}\n`
| _ ->
assert false
end
else if is_immediate_float f then
` fmov {emit_reg i.res.(0)}, #{emit_printf "%.7f" (Int64.float_of_bits f)}\n`
else begin
- let lbl = float_literal f in
+ let lbl = float_literal env f in
emit_load_literal i.res.(0) lbl
end
| Lop(Iconst_symbol s) ->
emit_load_symbol_addr i.res.(0) s
| Lop(Icall_ind) ->
` blr {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
| Lop(Icall_imm { func; }) ->
` bl {emit_symbol func}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
| Lop(Itailcall_ind) ->
- output_epilogue (fun () -> ` br {emit_reg i.arg.(0)}\n`)
+ output_epilogue env (fun () -> ` br {emit_reg i.arg.(0)}\n`)
| Lop(Itailcall_imm { func; }) ->
- if func = !function_name then
- ` b {emit_label !tailrec_entry_point}\n`
+ if func = env.f.fun_name then
+ ` b {emit_label env.f.fun_tailrec_entry_point_label}\n`
else
- output_epilogue (fun () -> ` b {emit_symbol func}\n`)
+ output_epilogue env (fun () -> ` b {emit_symbol func}\n`)
| Lop(Iextcall { func; alloc = false; }) ->
` bl {emit_symbol func}\n`
| Lop(Iextcall { func; alloc = true; }) ->
emit_load_symbol_addr reg_x8 func;
` bl {emit_symbol "caml_c_call"}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
emit_stack_adjustment (-n);
- stack_offset := !stack_offset + n
- | Lop(Iload(size, addr)) ->
+ env.stack_offset <- env.stack_offset + n
+ | Lop(Iload(size, addr, _mut)) ->
let dst = i.res.(0) in
let base =
match addr with
` str {emit_reg src}, {emit_addressing addr base}\n`
end
| Lop(Ialloc { bytes = n; dbginfo }) ->
- assembly_code_for_allocation i ~n ~far:false ~dbginfo
+ assembly_code_for_allocation env i ~n ~far:false ~dbginfo
| Lop(Ispecific (Ifar_alloc { bytes = n; dbginfo })) ->
- assembly_code_for_allocation i ~n ~far:true ~dbginfo
+ assembly_code_for_allocation env i ~n ~far:true ~dbginfo
+ | Lop(Ipoll { return_label }) ->
+ assembly_code_for_poll env i ~far:false ~return_label
+ | Lop(Ispecific (Ifar_poll { return_label })) ->
+ assembly_code_for_poll env i ~far:true ~return_label
| Lop(Iintop_imm(Iadd, n)) ->
emit_addimm i.res.(0) i.arg.(0) n
| Lop(Iintop_imm(Isub, n)) ->
emit_cmpimm i.arg.(0) n;
` cset {emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.ls {emit_label lbl}\n`
| Lop(Ispecific Ifar_intop_checkbound) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` b.hi {emit_label lbl2}\n`;
` b {emit_label lbl}\n`;
`{emit_label lbl2}:\n`;
| Lop(Iintop_imm(Icheckbound, n)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
emit_cmpimm i.arg.(0) n;
` b.ls {emit_label lbl}\n`
| Lop(Ispecific(
Ifar_intop_imm_checkbound { bound; })) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(0)}, #{emit_int bound}\n`;
` b.hi {emit_label lbl2}\n`;
` b {emit_label lbl}\n`;
`{emit_label lbl2}:\n`;
| Lop(Ispecific(Ishiftcheckbound { shift; })) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
` b.cs {emit_label lbl}\n`
| Lop(Ispecific(Ifar_shiftcheckbound { shift; })) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
let lbl2 = new_label () in
` cmp {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;
` b.lo {emit_label lbl2}\n`;
| Inegmulsubf -> "fnmsub"
| _ -> assert false) in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n`
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific(Ishiftarith(op, shift))) ->
let instr = (match op with
Ishiftadd -> "add"
| _ ->
assert false
end
- | Lop (Iname_for_debugger _) -> ()
+ | Lop(Ispecific(Isignext size)) ->
+ ` sbfm {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #0, #{emit_int (size - 1)}\n`
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue (fun () -> ` ret\n`)
+ output_epilogue env (fun () -> ` ret\n`)
| Llabel lbl ->
`{emit_label lbl}:\n`
| Lbranch lbl ->
(* each trap occupies 16 bytes on the stack *)
let delta = 16 * delta_traps in
cfi_adjust_cfa_offset delta;
- stack_offset := !stack_offset + delta
+ env.stack_offset <- env.stack_offset + delta
| Lpushtrap { lbl_handler; } ->
` adr {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`;
- stack_offset := !stack_offset + 16;
+ env.stack_offset <- env.stack_offset + 16;
` str {emit_reg reg_trap_ptr}, [sp, -16]!\n`;
` str {emit_reg reg_tmp1}, [sp, #8]\n`;
cfi_adjust_cfa_offset 16;
| Lpoptrap ->
` ldr {emit_reg reg_trap_ptr}, [sp], 16\n`;
cfi_adjust_cfa_offset (-16);
- stack_offset := !stack_offset - 16
+ env.stack_offset <- env.stack_offset - 16
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
` str xzr, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n`;
` bl {emit_symbol "caml_raise_exn"}\n`;
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_reraise ->
` bl {emit_symbol "caml_raise_exn"}\n`;
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_notrace ->
` mov sp, {emit_reg reg_trap_ptr}\n`;
` ldr {emit_reg reg_tmp1}, [sp, #8]\n`;
(* Emission of an instruction sequence *)
-let rec emit_all i =
- if i.desc = Lend then () else (emit_instr i; emit_all i.next)
+let rec emit_all env i =
+ if i.desc = Lend then () else (emit_instr env i; emit_all env i.next)
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- fastcode_flag := fundecl.fun_fast;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- float_literals := [];
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- contains_calls := fundecl.fun_contains_calls;
- emit_named_text_section !function_name;
+ let env = mk_env fundecl in
+ emit_named_text_section fundecl.fun_name;
` .align 3\n`;
` .globl {emit_symbol fundecl.fun_name}\n`;
emit_symbol_type emit_symbol fundecl.fun_name "function";
emit_debug_info fundecl.fun_dbg;
cfi_startproc();
let num_call_gc, num_check_bound =
- num_call_gc_and_check_bound_points fundecl.fun_body
+ num_call_gc_and_check_bound_points env
in
let max_out_of_line_code_offset =
max_out_of_line_code_offset ~num_call_gc
~num_check_bound
in
- BR.relax fundecl.fun_body ~max_out_of_line_code_offset;
- emit_all fundecl.fun_body;
- List.iter emit_call_gc !call_gc_sites;
- List.iter emit_call_bound_error !bound_error_sites;
- assert (List.length !call_gc_sites = num_call_gc);
- assert (List.length !bound_error_sites = num_check_bound);
+ BR.relax fundecl ~max_out_of_line_code_offset;
+ emit_all env fundecl.fun_body;
+ List.iter emit_call_gc env.call_gc_sites;
+ List.iter emit_call_bound_error env.bound_error_sites;
+ assert (List.length env.call_gc_sites = num_call_gc);
+ assert (List.length env.bound_error_sites = num_check_bound);
cfi_endproc();
emit_symbol_type emit_symbol fundecl.fun_name "function";
emit_symbol_size fundecl.fun_name;
- emit_literals()
+ emit_literals env
(* Emission of data *)
x0 - x15 general purpose (caller-save)
x16, x17 temporaries (used by call veeners)
x18 platform register (reserved)
- x19 - x24 general purpose (callee-save)
- x25 domain state pointer
+ x19 - x25 general purpose (callee-save)
x26 trap pointer
x27 alloc pointer
- x28 alloc limit
+ x28 domain state pointer
x29 frame pointer
x30 return address
sp / xzr stack pointer / zero register
*)
let int_reg_name =
- [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7";
- "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15";
- "x19"; "x20"; "x21"; "x22"; "x23"; "x24";
- "x25"; "x26"; "x27"; "x28"; "x16"; "x17" |]
+ [| "x0"; "x1"; "x2"; "x3"; "x4"; "x5"; "x6"; "x7"; (* 0 - 7 *)
+ "x8"; "x9"; "x10"; "x11"; "x12"; "x13"; "x14"; "x15"; (* 8 - 15 *)
+ "x19"; "x20"; "x21"; "x22"; "x23"; "x24"; "x25"; (* 16 - 22 *)
+ "x26"; "x27"; "x28"; (* 23 - 25 *)
+ "x16"; "x17" |] (* 26 - 27 *)
let float_reg_name =
[| "d0"; "d1"; "d2"; "d3"; "d4"; "d5"; "d6"; "d7";
| Float -> 1
let num_available_registers =
- [| 22; 32 |] (* first 22 int regs allocatable; all float regs allocatable *)
+ [| 23; 32 |] (* first 23 int regs allocatable; all float regs allocatable *)
let first_available_register =
[| 0; 100 |]
all_phys_regs
| Iop(Iextcall { alloc = false; }) ->
destroyed_at_c_call
- | Iop(Ialloc _) ->
+ | Iop(Ialloc _) | Iop(Ipoll _) ->
[| reg_x8 |]
- | Iop(Iintoffloat | Ifloatofint | Iload(Single, _) | Istore(Single, _, _)) ->
+ | Iop( Iintoffloat | Ifloatofint
+ | Iload(Single, _, _) | Istore(Single, _, _)) ->
[| reg_d7 |] (* d7 / s7 destroyed *)
| _ -> [||]
(* Maximal register pressure *)
let safe_register_pressure = function
- | Iextcall _ -> 8
- | Ialloc _ -> 24
- | _ -> 25
+ | Iextcall _ -> 7
+ | Ialloc _ | Ipoll _ -> 22
+ | _ -> 23
let max_register_pressure = function
- | Iextcall _ -> [| 10; 8 |]
- | Ialloc _ -> [| 24; 32 |]
+ | Iextcall _ -> [| 7; 8 |] (* 7 integer callee-saves, 8 FP callee-saves *)
+ | Ialloc _ | Ipoll _ -> [| 22; 32 |]
| Iintoffloat | Ifloatofint
- | Iload(Single, _) | Istore(Single, _, _) -> [| 25; 31 |]
- | _ -> [| 25; 32 |]
-
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)
- | Ispecific(Ishiftcheckbound _) -> false
- | _ -> true
+ | Iload(Single, _, _) | Istore(Single, _, _) -> [| 23; 31 |]
+ | _ -> [| 23; 32 |]
(* Layout of the stack *)
let frame_required fd =
| Word_int | Word_val | Double | Double_u ->
n land 7 = 0 && n lsr 3 < 0x1000)
-(* An automaton to recognize ( 0+1+0* | 1+0+1* )
-
- 0 1 0
- / \ / \ / \
- \ / \ / \ /
- -0--> [1] --1--> [2] --0--> [3]
- /
- [0]
- \
- -1--> [4] --0--> [5] --1--> [6]
- / \ / \ / \
- \ / \ / \ /
- 1 0 1
-
-The accepting states are 2, 3, 5 and 6. *)
-
-let auto_table = [| (* accepting?, next on 0, next on 1 *)
- (* state 0 *) (false, 1, 4);
- (* state 1 *) (false, 1, 2);
- (* state 2 *) (true, 3, 2);
- (* state 3 *) (true, 3, 7);
- (* state 4 *) (false, 5, 4);
- (* state 5 *) (true, 5, 6);
- (* state 6 *) (true, 7, 6);
- (* state 7 *) (false, 7, 7) (* error state *)
-|]
-
-let rec run_automata nbits state input =
- let (acc, next0, next1) = auto_table.(state) in
- if nbits <= 0
- then acc
- else run_automata (nbits - 1)
- (if input land 1 = 0 then next0 else next1)
- (input asr 1)
-
-(* We are very conservative wrt what ARM64 supports: we don't support
- repetitions of a 000111000 or 1110000111 pattern, just a single
- pattern of this kind. *)
-
let is_logical_immediate n =
- n <> 0 && n <> -1 && run_automata 64 0 n
+ Arch.is_logical_immediate (Nativeint.of_int n)
(* Signed immediates are simpler *)
| _ ->
super#select_operation op args dbg
end
+ (* Recognize sign extension *)
+ | Casr ->
+ begin match args with
+ [Cop(Clsl, [k; Cconst_int (n, _)], _); Cconst_int (n', _)]
+ when n' = n && 0 < n && n < 64 ->
+ (Ispecific (Isignext (64 - n)), [k])
+ | _ -> super#select_operation op args dbg
+ end
(* Recognize floating-point negate and multiply *)
| Cnegf ->
begin match args with
else self#insert_moves env src dst
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f = (new selector)#emit_fundecl
+ ~future_funcnames f
type error =
| Assembler_error of string
| Mismatched_for_pack of string option
+ | Asm_generation of string * Emitaux.error
exception Error of error
+let cmm_invariants ppf fd_cmm =
+ let print_fundecl =
+ if !Clflags.dump_cmm then Printcmm.fundecl
+ else fun ppf fdecl -> Format.fprintf ppf "%s" fdecl.fun_name
+ in
+ if !Clflags.cmm_invariants && Cmm_invariants.run ppf fd_cmm then
+ Misc.fatal_errorf "Cmm invariants failed on following fundecl:@.%a@."
+ print_fundecl fd_cmm;
+ fd_cmm
+
let liveness phrase = Liveness.fundecl phrase; phrase
let dump_if ppf flag message phrase =
let emit_begin_assembly = if_emit_do Emit.begin_assembly
let emit_end_assembly = if_emit_do Emit.end_assembly
let emit_data = if_emit_do Emit.data
-let emit_fundecl =
- if_emit_do
- (Profile.record ~accumulate:true "emit" Emit.fundecl)
+let emit_fundecl fd =
+ if should_emit() then begin
+ try
+ Profile.record ~accumulate:true "emit" Emit.fundecl fd
+ with Emitaux.Error e ->
+ raise (Error (Asm_generation(fd.Linear.fun_name, e)))
+ end
let rec regalloc ~ppf_dump round fd =
if round > 50 then
let (++) x f = f x
-let compile_fundecl ~ppf_dump fd_cmm =
+let compile_fundecl ~ppf_dump ~funcnames fd_cmm =
Proc.init ();
Reg.reset();
fd_cmm
- ++ Profile.record ~accumulate:true "selection" Selection.fundecl
+ ++ Profile.record ~accumulate:true "cmm_invariants" (cmm_invariants ppf_dump)
+ ++ Profile.record ~accumulate:true "selection"
+ (Selection.fundecl ~future_funcnames:funcnames)
+ ++ Profile.record ~accumulate:true "polling"
+ (Polling.instrument_fundecl ~future_funcnames:funcnames)
++ pass_dump_if ppf_dump dump_selection "After instruction selection"
++ Profile.record ~accumulate:true "comballoc" Comballoc.fundecl
++ pass_dump_if ppf_dump dump_combine "After allocation combining"
++ pass_dump_if ppf_dump dump_split "After live range splitting"
++ Profile.record ~accumulate:true "liveness" liveness
++ Profile.record ~accumulate:true "regalloc" (regalloc ~ppf_dump 1)
- ++ Profile.record ~accumulate:true "available_regs" Available_regs.fundecl
++ Profile.record ~accumulate:true "linearize" Linearize.fundecl
++ pass_dump_linear_if ppf_dump dump_linear "Linearized code"
++ Profile.record ~accumulate:true "scheduling" Scheduling.fundecl
++ save_linear
++ emit_fundecl
+module String = Misc.Stdlib.String
+
let compile_data dl =
dl
++ save_data
++ emit_data
-let compile_phrase ~ppf_dump p =
- if !dump_cmm then fprintf ppf_dump "%a@." Printcmm.phrase p;
- match p with
- | Cfunction fd -> compile_fundecl ~ppf_dump fd
- | Cdata dl -> compile_data dl
+let compile_phrases ~ppf_dump ps =
+ let funcnames =
+ List.fold_left (fun s p ->
+ match p with
+ | Cfunction fd -> String.Set.add fd.fun_name s
+ | Cdata _ -> s)
+ String.Set.empty ps
+ in
+ let rec compile ~funcnames ps =
+ match ps with
+ | [] -> ()
+ | p :: ps ->
+ if !dump_cmm then fprintf ppf_dump "%a@." Printcmm.phrase p;
+ match p with
+ | Cfunction fd ->
+ compile_fundecl ~ppf_dump ~funcnames fd;
+ compile ~funcnames:(String.Set.remove fd.fun_name funcnames) ps
+ | Cdata dl ->
+ compile_data dl;
+ compile ~funcnames ps
+ in
+ compile ~funcnames ps
+let compile_phrase ~ppf_dump p =
+ compile_phrases ~ppf_dump [p]
(* For the native toplevel: generates generic functions unless
they are already available in the process *)
emit_begin_assembly ();
clambda
++ Profile.record "cmm" Cmmgen.compunit
- ++ Profile.record "compile_phrases" (List.iter (compile_phrase ~ppf_dump))
+ ++ Profile.record "compile_phrases" (compile_phrases ~ppf_dump)
++ (fun () -> ());
(match toplevel with None -> () | Some f -> compile_genfuns ~ppf_dump f);
(* We add explicit references to external primitive symbols. This
type middle_end =
backend:(module Backend_intf.S)
- -> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
then output_prefix ^ ext_asm
else Filename.temp_file "camlasm" ext_asm
-let compile_implementation ?toplevel ~backend ~filename ~prefixname ~middle_end
+let compile_implementation ?toplevel ~backend ~prefixname ~middle_end
~ppf_dump (program : Lambda.program) =
compile_unit ~output_prefix:prefixname
~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
(fun () ->
Ident.Set.iter Compilenv.require_global program.required_globals;
let clambda_with_constants =
- middle_end ~backend ~filename ~prefixname ~ppf_dump program
+ middle_end ~backend ~prefixname ~ppf_dump program
in
end_gen_implementation ?toplevel ~ppf_dump clambda_with_constants)
fprintf ppf
"This input file cannot be compiled %s: it was generated %s."
(msg !Clflags.for_package) (msg saved)
+ | Asm_generation(fn, err) ->
+ fprintf ppf
+ "Error producing assembly code for function %s: %a"
+ fn Emitaux.report_error err
let () =
Location.register_error_of_exn
(** The type of converters from Lambda to Clambda. *)
type middle_end =
backend:(module Backend_intf.S)
- -> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
val compile_implementation
: ?toplevel:(string -> bool)
-> backend:(module Backend_intf.S)
- -> filename:string
-> prefixname:string
-> middle_end:middle_end
-> ppf_dump:Format.formatter
type error =
| Assembler_error of string
| Mismatched_for_pack of string option
+ | Asm_generation of string * Emitaux.error
exception Error of error
val report_error: Format.formatter -> error -> unit
with Not_found ->
raise(Error(File_not_found libname))
-let object_file_name name =
- let file_name =
- try
- Load_path.find name
- with Not_found ->
- fatal_errorf "Asmlink.object_file_name: %s not found" name in
- if Filename.check_suffix file_name ".cmx" then
- Filename.chop_suffix file_name ".cmx" ^ ext_obj
- else if Filename.check_suffix file_name ".cmxa" then
- Filename.chop_suffix file_name ".cmxa" ^ ext_lib
- else
- fatal_error "Asmlink.object_file_name: bad ext"
-
(* First pass: determine which units are needed *)
let missing_globals = (Hashtbl.create 17 : (string, string list ref) Hashtbl.t)
| Unit of string * unit_infos * Digest.t
| Library of string * library_infos
+let object_file_name_of_file = function
+ | Unit (fname, _, _) -> Some (Filename.chop_suffix fname ".cmx" ^ ext_obj)
+ | Library (fname, infos) ->
+ let obj_file = Filename.chop_suffix fname ".cmxa" ^ ext_lib in
+ (* MSVC doesn't support empty .lib files, and macOS struggles to make
+ them (#6550), so there shouldn't be one if the .cmxa contains no
+ units. The file_exists check is added to be ultra-defensive for the
+ case where a user has manually added things to the .a/.lib file *)
+ if infos.lib_units = [] && not (Sys.file_exists obj_file) then None else
+ Some obj_file
+
let read_file obj_name =
let file_name =
try
end
else raise(Error(Not_an_object_file file_name))
-let scan_file obj_name (tolink, objfiles) = match read_file obj_name with
+let scan_file file tolink = match file with
| Unit (file_name,info,crc) ->
(* This is a .cmx file. It must be linked in any case. *)
remove_required info.ui_name;
List.iter (add_required file_name) info.ui_imports_cmx;
- ((info, file_name, crc) :: tolink, obj_name :: objfiles)
+ (info, file_name, crc) :: tolink
| Library (file_name,infos) ->
(* This is an archive file. Each unit contained in it will be linked
in only if needed. *)
add_ccobjs (Filename.dirname file_name) infos;
- let tolink =
- List.fold_right
- (fun (info, crc) reqd ->
- if info.ui_force_link
- || !Clflags.link_everything
- || is_required info.ui_name
- then begin
- remove_required info.ui_name;
- List.iter (add_required (Printf.sprintf "%s(%s)"
- file_name info.ui_name))
- info.ui_imports_cmx;
- (info, file_name, crc) :: reqd
- end else
- reqd)
- infos.lib_units tolink
- and objfiles =
- if infos.lib_units = []
- && not (Sys.file_exists (object_file_name obj_name)) then
- (* MSVC doesn't support empty .lib files, and macOS struggles to make
- them (#6550), so there shouldn't be one if the .cmxa contains no
- units. The file_exists check is added to be ultra-defensive for the
- case where a user has manually added things to the .a/.lib file *)
- objfiles
- else
- obj_name :: objfiles
- in (tolink, objfiles)
+ List.fold_right
+ (fun (info, crc) reqd ->
+ if info.ui_force_link
+ || !Clflags.link_everything
+ || is_required info.ui_name
+ then begin
+ remove_required info.ui_name;
+ List.iter (add_required (Printf.sprintf "%s(%s)"
+ file_name info.ui_name))
+ info.ui_imports_cmx;
+ (info, file_name, crc) :: reqd
+ end else
+ reqd)
+ infos.lib_units tolink
(* Second pass: generate the startup file and link it with everything else *)
let link_shared ~ppf_dump objfiles output_name =
Profile.record_call output_name (fun () ->
- let units_tolink, objfiles =
- List.fold_right scan_file objfiles ([], [])
- in
+ let obj_infos = List.map read_file objfiles in
+ let units_tolink = List.fold_right scan_file obj_infos [] in
List.iter
(fun (info, file_name, crc) -> check_consistency file_name info crc)
units_tolink;
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
- let objfiles = List.rev_map object_file_name objfiles @
+ let objfiles =
+ List.rev (List.filter_map object_file_name_of_file obj_infos) @
(List.rev !Clflags.ccobjs) in
-
let startup =
if !Clflags.keep_startup_file || !Emitaux.binary_backend_available
then output_name ^ ".startup" ^ ext_asm
if !Clflags.nopervasives then objfiles
else if !Clflags.output_c_object then stdlib :: objfiles
else stdlib :: (objfiles @ [stdexit]) in
- let units_tolink, objfiles =
- List.fold_right scan_file objfiles ([], [])
- in
+ let obj_infos = List.map read_file objfiles in
+ let units_tolink = List.fold_right scan_file obj_infos [] in
Array.iter remove_required Runtimedef.builtin_exceptions;
begin match extract_missing_globals() with
[] -> ()
(fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
Misc.try_finally
(fun () ->
- call_linker (List.map object_file_name objfiles)
+ call_linker (List.filter_map object_file_name_of_file obj_infos)
startup_obj output_name)
~always:(fun () -> remove_file startup_obj)
)
program, Closure_middle_end.lambda_to_clambda
in
Asmgen.compile_implementation ~backend
- ~filename:targetname
~prefixname
~middle_end
~ppf_dump
open Linear
module Make (T : Branch_relaxation_intf.S) = struct
- let label_map code =
+ let label_map f =
let map = Hashtbl.create 37 in
let rec fill_map pc instr =
match instr.desc with
| Lend -> (pc, map)
| Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next
- | op -> fill_map (pc + T.instr_size op) instr.next
+ | op -> fill_map (pc + T.instr_size f op) instr.next
in
- fill_map 0 code
+ fill_map 0 f.fun_body
let branch_overflows map pc_branch lbl_dest max_branch_offset =
let pc_dest = Hashtbl.find map lbl_dest in
in
match instr.desc with
| Lop (Ialloc _)
+ | Lop (Ipoll { return_label = None })
| Lop (Iintop (Icheckbound))
| Lop (Iintop_imm (Icheckbound, _))
| Lop (Ispecific _) ->
opt_branch_overflows map pc lbl0 max_branch_offset
|| opt_branch_overflows map pc lbl1 max_branch_offset
|| opt_branch_overflows map pc lbl2 max_branch_offset
+ | Lop (Ipoll { return_label = Some lbl }) ->
+ (* A poll-and-branch instruction can branch to the label lbl,
+ but also to an out-of-line code block. *)
+ code_size + max_out_of_line_code_offset - pc >= max_branch_offset
+ || branch_overflows map pc lbl max_branch_offset
| _ ->
Misc.fatal_error "Unsupported instruction for branch relaxation"
- let fixup_branches ~code_size ~max_out_of_line_code_offset map code =
+ let fixup_branches ~code_size ~max_out_of_line_code_offset map f =
let expand_optbranch lbl n arg next =
match lbl with
| None -> next
instr_overflows ~code_size ~max_out_of_line_code_offset instr map pc
in
if not overflows then
- fixup did_fix (pc + T.instr_size instr.desc) instr.next
+ fixup did_fix (pc + T.instr_size f instr.desc) instr.next
else
match instr.desc with
+ | Lop (Ipoll { return_label }) ->
+ instr.desc <- T.relax_poll ~return_label;
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lop (Ialloc { bytes = num_bytes; dbginfo }) ->
instr.desc <- T.relax_allocation ~num_bytes ~dbginfo;
- fixup true (pc + T.instr_size instr.desc) instr.next
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lop (Iintop (Icheckbound)) ->
instr.desc <- T.relax_intop_checkbound ();
- fixup true (pc + T.instr_size instr.desc) instr.next
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lop (Iintop_imm (Icheckbound, bound)) ->
instr.desc
<- T.relax_intop_imm_checkbound ~bound;
- fixup true (pc + T.instr_size instr.desc) instr.next
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lop (Ispecific specific) ->
instr.desc <- T.relax_specific_op specific;
- fixup true (pc + T.instr_size instr.desc) instr.next
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lcondbranch (test, lbl) ->
let lbl2 = Cmm.new_label() in
let cont =
in
instr.desc <- Lcondbranch (invert_test test, lbl2);
instr.next <- cont;
- fixup true (pc + T.instr_size instr.desc) instr.next
+ fixup true (pc + T.instr_size f instr.desc) instr.next
| Lcondbranch3 (lbl0, lbl1, lbl2) ->
let cont =
expand_optbranch lbl0 0 instr.arg
We can *never* get here. *)
assert false
in
- fixup false 0 code
+ fixup false 0 f.fun_body
(* Iterate branch expansion till all conditional branches are OK *)
- let rec relax code ~max_out_of_line_code_offset =
+ let rec relax f ~max_out_of_line_code_offset =
let min_of_max_branch_offsets =
List.fold_left (fun min_of_max_branch_offsets branch ->
- min min_of_max_branch_offsets
+ Int.min min_of_max_branch_offsets
(T.Cond_branch.max_displacement branch))
max_int T.Cond_branch.all
in
- let (code_size, map) = label_map code in
+ let (code_size, map) = label_map f in
if code_size >= min_of_max_branch_offsets
- && fixup_branches ~code_size ~max_out_of_line_code_offset map code
- then relax code ~max_out_of_line_code_offset
+ && fixup_branches ~code_size ~max_out_of_line_code_offset map f
+ then relax f ~max_out_of_line_code_offset
else ()
end
module Make (T : Branch_relaxation_intf.S) : sig
val relax
- : Linear.instruction
+ : Linear.fundecl
(* [max_offset_of_out_of_line_code] specifies the furthest distance,
measured from the first address immediately after the last instruction
of the function, that may be branched to from within the function in
N.B. The only instructions supported are the following:
- Lop (Ialloc _)
+ - Lop (Ipoll _)
- Lop (Iintop Icheckbound)
- Lop (Iintop_imm (Icheckbound, _))
- Lop (Ispecific _)
val offset_pc_at_branch : distance
(* The maximum size of a given instruction. *)
- val instr_size : Linear.instruction_desc -> distance
+ val instr_size : Linear.fundecl -> Linear.instruction_desc -> distance
(* Insertion of target-specific code to relax operations that cannot be
relaxed generically. It is assumed that these rewrites do not change
: num_bytes:int
-> dbginfo:Debuginfo.alloc_dbginfo
-> Linear.instruction_desc
+
+ val relax_poll
+ : return_label:Cmm.label option
+ -> Linear.instruction_desc
+
val relax_intop_checkbound
: unit
-> Linear.instruction_desc
| Ccmpf of float_comparison
| Craise of Lambda.raise_kind
| Ccheckbound
+ | Copaque
type expression =
Cconst_int of int * Debuginfo.t
then the index.
It results in a bounds error if the index is greater than
or equal to the bound. *)
+ | Copaque (* Sys.opaque_identity *)
(** Every basic block should have a corresponding [Debuginfo.t] for its
beginning. *)
in
Csequence(make_checkbound dbg [max_or_zero a1 dbg; a2], k)
+let opaque e dbg =
+ Cop(Copaque, [e], dbg)
+
let unaligned_set size ptr idx newval dbg =
match (size : Clambda_primitives.memory_access_size) with
| Sixteen -> unaligned_set_16 ptr idx newval dbg
let cache = cache in
let fun_name = "caml_send" ^ Int.to_string arity in
let fun_args =
- [obj, typ_val; tag, typ_int; cache, typ_val]
+ [obj, typ_val; tag, typ_int; cache, typ_addr]
@ List.map (fun id -> (id, typ_val)) (List.tl args) in
let fun_dbg = placeholder_fun_dbg ~human_name:fun_name in
Cfunction
expression -> expression -> expression ->
expression
+(** Sys.opaque_identity *)
+val opaque : expression -> Debuginfo.t -> expression
+
(** Generic application functions *)
(** Get the symbol for the generic application with [n] arguments, and
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Vincent Laviron, OCamlPro *)
+(* *)
+(* Copyright 2017 OCamlPro SAS *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+[@@@ocaml.warning "-40"]
+
+module Int = Numbers.Int
+
+(* Check a number of continuation-related invariants *)
+
+module Env : sig
+ type t
+
+ val init : unit -> t
+
+ val handler : t -> cont:int -> arg_num:int -> t
+
+ val jump : t -> cont:int -> arg_num:int -> unit
+
+ val report : Format.formatter -> bool
+end = struct
+ type t = {
+ bound_handlers : int Int.Map.t;
+ }
+
+ type error =
+ | Unbound_handler of { cont: int }
+ | Multiple_handlers of { cont: int; }
+ | Wrong_arguments_number of
+ { cont: int; handler_args: int; jump_args: int; }
+
+ module Error = struct
+ type t = error
+
+ let compare = Stdlib.compare
+ end
+
+ module ErrorSet = Set.Make(Error)
+
+ type persistent_state = {
+ mutable all_handlers : Int.Set.t;
+ mutable errors : ErrorSet.t;
+ }
+
+ let state = {
+ all_handlers = Int.Set.empty;
+ errors = ErrorSet.empty;
+ }
+
+ let record_error error =
+ state.errors <- ErrorSet.add error state.errors
+
+ let unbound_handler cont =
+ record_error (Unbound_handler { cont; })
+
+ let multiple_handler cont =
+ record_error (Multiple_handlers { cont; })
+
+ let wrong_arguments cont handler_args jump_args =
+ record_error (Wrong_arguments_number { cont; handler_args; jump_args; })
+
+ let init () =
+ state.all_handlers <- Int.Set.empty;
+ state.errors <- ErrorSet.empty;
+ {
+ bound_handlers = Int.Map.empty;
+ }
+
+ let handler t ~cont ~arg_num =
+ if Int.Set.mem cont state.all_handlers then multiple_handler cont;
+ state.all_handlers <- Int.Set.add cont state.all_handlers;
+ let bound_handlers = Int.Map.add cont arg_num t.bound_handlers in
+ { bound_handlers; }
+
+ let jump t ~cont ~arg_num =
+ match Int.Map.find cont t.bound_handlers with
+ | handler_args ->
+ if arg_num <> handler_args then
+ wrong_arguments cont handler_args arg_num
+ | exception Not_found -> unbound_handler cont
+
+ let print_error ppf error =
+ match error with
+ | Unbound_handler { cont } ->
+ if Int.Set.mem cont state.all_handlers then
+ Format.fprintf ppf
+ "Continuation %d was used outside the scope of its handler"
+ cont
+ else
+ Format.fprintf ppf
+ "Continuation %d was used but never bound"
+ cont
+ | Multiple_handlers { cont; } ->
+ Format.fprintf ppf
+ "Continuation %d was declared in more than one handler"
+ cont
+ | Wrong_arguments_number { cont; handler_args; jump_args } ->
+ Format.fprintf ppf
+ "Continuation %d was declared with %d arguments but called with %d"
+ cont
+ handler_args
+ jump_args
+
+ let print_error_newline ppf error =
+ Format.fprintf ppf "%a@." print_error error
+
+ let report ppf =
+ if ErrorSet.is_empty state.errors then false
+ else begin
+ ErrorSet.iter (fun err -> print_error_newline ppf err) state.errors;
+ true
+ end
+end
+
+let rec check env (expr : Cmm.expression) =
+ match expr with
+ | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _
+ | Cvar _ ->
+ ()
+ | Clet (_, expr, body)
+ | Clet_mut (_, _, expr, body) ->
+ check env expr;
+ check env body
+ | Cphantom_let (_, _, expr) ->
+ check env expr
+ | Cassign (_, expr) ->
+ check env expr
+ | Ctuple exprs ->
+ List.iter (check env) exprs
+ | Cop (_, args, _) ->
+ List.iter (check env) args;
+ | Csequence (expr1, expr2) ->
+ check env expr1;
+ check env expr2
+ | Cifthenelse (test, _, ifso, _, ifnot, _) ->
+ check env test;
+ check env ifso;
+ check env ifnot
+ | Cswitch (body, _, branches, _) ->
+ check env body;
+ Array.iter (fun (expr, _) -> check env expr) branches
+ | Ccatch (rec_flag, handlers, body) ->
+ let env_extended =
+ List.fold_left
+ (fun env (cont, args, _, _) ->
+ Env.handler env ~cont ~arg_num:(List.length args))
+ env
+ handlers
+ in
+ check env_extended body;
+ let env_handler =
+ match rec_flag with
+ | Recursive -> env_extended
+ | Nonrecursive -> env
+ in
+ List.iter (fun (_, _, handler, _) -> check env_handler handler) handlers
+ | Cexit (cont, args) ->
+ Env.jump env ~cont ~arg_num:(List.length args)
+ | Ctrywith (body, _, handler, _) ->
+ (* Jumping from inside a trywith body to outside isn't very nice,
+ but it's handled correctly by Linearize, as it happens
+ when compiling match ... with exception ..., for instance, so it is
+ not reported as an error. *)
+ check env body;
+ check env handler
+
+let run ppf (fundecl : Cmm.fundecl) =
+ let env = Env.init () in
+ check env fundecl.fun_body;
+ Env.report ppf
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Vincent Laviron, OCamlPro *)
+(* *)
+(* Copyright 2017 OCamlPro SAS *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Check a number of continuation-related invariants *)
+
+(* Currently, this checks that :
+ - Every use of a continuation occurs within the scope of its handler
+ - Exit instructions take the same number of arguments as their handler.
+ - In every function declaration, a given continuation can only be
+ declared in a single handler.
+
+ This is intended to document what invariants the backend can rely upon.
+ The first two would trigger errors later, and the last one, while
+ harmless for now, is not that hard to ensure, could be useful for
+ future work on the backend, and helped detect a code duplication bug.
+
+ These invariants are not checked by default, but the check can be turned
+ on with the -dcmm-invariants compilation flag.
+*)
+
+(** [run ppf fundecl] analyses the given function, and returns whether
+ any errors were encountered (with corresponding error messages printed
+ on the given formatter). *)
+
+val run : Format.formatter -> Cmm.fundecl -> bool
let args = List.map (transl env) args in
send kind met obj args dbg
| Ulet(str, kind, id, exp, body) ->
- transl_let env str kind id exp body
+ transl_let env str kind id exp (fun env -> transl env body)
| Uphantom_let (var, defining_expr, body) ->
let defining_expr =
match defining_expr with
match p with
(* Generic operations *)
Popaque ->
- transl env arg
+ opaque (transl env arg) dbg
(* Heap operations *)
| Pfield n ->
get_field env (transl env arg) n dbg
| Thirty_two -> transl_unbox_int dbg env Pint32 exp
| Sixty_four -> transl_unbox_int dbg env Pint64 exp
-and transl_let env str kind id exp body =
+and transl_let env str kind id exp transl_body =
let dbg = Debuginfo.none in
let cexp = transl env exp in
let unboxing =
(* N.B. [body] must still be traversed even if [exp] will never return:
there may be constant closures inside that need lifting out. *)
begin match str, kind with
- | Immutable, _ -> Clet(id, cexp, transl env body)
- | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl env body)
- | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl env body)
+ | Immutable, _ -> Clet(id, cexp, transl_body env)
+ | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl_body env)
+ | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl_body env)
end
| Boxed (boxed_number, false) ->
let unboxed_id = V.create_local (VP.name id) in
let v = VP.create unboxed_id in
let cexp = unbox_number dbg boxed_number cexp in
let body =
- transl (add_unboxed_id (VP.var id) unboxed_id boxed_number env) body in
+ transl_body (add_unboxed_id (VP.var id) unboxed_id boxed_number env) in
begin match str, boxed_number with
| Immutable, _ -> Clet (v, cexp, body)
| Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body)
ifso_dbg arg2
then_dbg then_
else_dbg else_
+ | Ulet(str, kind, id, exp, cond) ->
+ transl_let env str kind id exp (fun env ->
+ transl_if env approx dbg cond then_dbg then_ else_dbg else_)
| Uprim (Psequand, [arg1; arg2], inner_dbg) ->
transl_sequand env approx
inner_dbg arg1
if not (Reg.is_visited r) then begin
Reg.mark_visited r;
f r w;
- List.iter (fun (r1, w1) -> walk r1 (min w w1)) r.prefer
+ List.iter (fun (r1, w1) -> walk r1 (Int.min w w1)) r.prefer
end in
List.iter (fun (r, w) -> walk r w) reg.prefer;
Reg.clear_visited_marks () in
i.arg i.res i.dbg next, allocstate)
end
| Iop(Icall_ind | Icall_imm _ | Iextcall _ |
- Itailcall_ind | Itailcall_imm _) ->
+ Itailcall_ind | Itailcall_imm _ | Ipoll _) ->
let newnext = combine_restart i.next in
(instr_cons_debug i.desc i.arg i.res i.dbg newnext,
allocstate)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Mach
+
+module type DOMAIN = sig
+ type t
+ val bot: t
+ val join: t -> t -> t
+ val lessequal: t -> t -> bool
+end
+
+module Backward(D: DOMAIN) = struct
+
+let analyze ?(exnhandler = fun x -> x) ?(exnescape = D.bot) ~transfer instr =
+
+ let lbls =
+ (Hashtbl.create 20 : (int, D.t) Hashtbl.t) in
+ let get_lbl n =
+ match Hashtbl.find_opt lbls n with None -> D.bot | Some b -> b
+ and set_lbl n x =
+ Hashtbl.replace lbls n x in
+
+ let rec before end_ exn i =
+ match i.desc with
+ | Iend ->
+ transfer i ~next:end_ ~exn
+ | Ireturn | Iop (Itailcall_ind | Itailcall_imm _) ->
+ transfer i ~next:D.bot ~exn:D.bot
+ | Iop _ ->
+ let bx = before end_ exn i.next in
+ transfer i ~next:bx ~exn
+ | Iifthenelse(_, ifso, ifnot) ->
+ let bx = before end_ exn i.next in
+ let b1 = before bx exn ifso
+ and b0 = before bx exn ifnot in
+ transfer i ~next:(D.join b1 b0) ~exn
+ | Iswitch(_, cases) ->
+ let bx = before end_ exn i.next in
+ let b1 =
+ Array.fold_left
+ (fun accu case -> D.join accu (before bx exn case))
+ D.bot cases in
+ transfer i ~next:b1 ~exn
+ | Icatch(rc, handlers, body) ->
+ let bx = before end_ exn i.next in
+ begin match rc with
+ | Cmm.Nonrecursive ->
+ List.iter
+ (fun (n, h) -> set_lbl n (before bx exn h))
+ handlers
+ | Cmm.Recursive ->
+ let update changed (n, h) =
+ let b0 = get_lbl n in
+ let b1 = before bx exn h in
+ if D.lessequal b1 b0 then changed else (set_lbl n b1; true) in
+ while List.fold_left update false handlers do () done
+ end;
+ let b = before bx exn body in
+ transfer i ~next:b ~exn
+ | Iexit n ->
+ transfer i ~next:(get_lbl n) ~exn
+ | Itrywith(body, handler) ->
+ let bx = before end_ exn i.next in
+ let bh = exnhandler (before bx exn handler) in
+ let bb = before bx bh body in
+ transfer i ~next:bb ~exn
+ | Iraise _ ->
+ transfer i ~next:D.bot ~exn
+ in
+ let b = before D.bot exnescape instr in
+ (b, get_lbl)
+
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cambium, INRIA Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* An abstract domain for dataflow analysis. Defines a type [t]
+ of abstractions, with lattice operations. *)
+
+module type DOMAIN = sig
+ type t
+ val bot: t
+ val join: t -> t -> t
+ val lessequal: t -> t -> bool
+end
+
+(* Build a backward dataflow analysis engine for the given domain. *)
+
+module Backward(D: DOMAIN) : sig
+
+ val analyze: ?exnhandler: (D.t -> D.t) ->
+ ?exnescape: D.t ->
+ transfer: (Mach.instruction -> next: D.t -> exn: D.t -> D.t) ->
+ Mach.instruction ->
+ D.t * (int -> D.t)
+
+ (* [analyze ~exnhandler ~transfer instr] performs a backward dataflow
+ analysis on the Mach instruction [instr], typically a function body.
+
+ It returns a pair of
+ - the abstract state at the function entry point;
+ - a mapping from catch handler label to the abstract state at the
+ beginning of the handler with this label.
+
+ The [transfer] function is called as [transfer i ~next ~exn].
+ - [i] is a sub-instruction of [instr].
+ - [next] is the abstract state "after" the instruction for
+ normal control flow, falling through the successor(s) of [i].
+ - [exn] is the abstract state "after" the instruction for
+ exceptional control flow, branching to the nearest exception handler
+ or exiting the function with an unhandled exception.
+
+ The [transfer] function, then, returns the abstract state "before"
+ the instruction. The dataflow analysis will, then, propagate this
+ state "before" as the state "after" the predecessor instructions.
+
+ For compound instructions like [Iifthenelse], the [next] abstract
+ value that is passed to [transfer] is not the abstract state at
+ the end of the compound instruction (e.g. after the "then" and "else"
+ branches have joined), but the join of the abstract states at
+ the beginning of the sub-instructions. More precisely:
+ - for [Iifthenelse(tst, ifso, ifnot)], it's the join of the
+ abstract states at the beginning of the [ifso] and [ifnot]
+ branches;
+ - for [Iswitch(tbl, cases)], it's the join of the abstract states
+ at the beginning of the [cases] branches;
+ - for [Icatch(recflag, body, handlers)] and [Itrywith(body, handler)],
+ it's the abstract state at the beginning of [body].
+
+ The [transfer] function is called for every sub-instruction of [instr],
+ as many times as needed to reach a fixpoint. Hence, it can record
+ the results of the analysis at each sub-instruction in a mutable
+ data structure. For instance, the transfer function for liveness
+ analysis updates the [live] fields of instructions as a side
+ effect.
+
+ The optional [exnhandler] argument deals with exception handlers.
+ This is a function that transforms the abstract state at the
+ beginning of an exception handler into the exceptional abstract
+ state for the instructions within the body of the handler.
+ Typically, for liveness analysis, it takes the registers live at
+ the beginning of the handler and removes the register
+ [Proc.loc_exn_bucket] that carries the exception value. If not
+ specified, [exnhandler] defaults to the identity function.
+
+ The optional [exnescape] argument deals with unhandled exceptions.
+ It is the abstract state corresponding to exiting the function on an
+ unhandled exception. It defaults to [D.bot].
+ *)
+
+end
{ i; regs; exits = Int.Set.empty; }
| Iop op ->
let s = deadcode i.next in
- if Proc.op_is_pure op (* no side effects *)
+ if operation_is_pure op (* no side effects *)
&& Reg.disjoint_set_array s.regs i.res (* results are not used after *)
&& not (Proc.regs_are_volatile i.arg) (* no stack-like hard reg *)
&& not (Proc.regs_are_volatile i.res) (* is involved *)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Thomas Refis, Jane Street Europe *)
-(* *)
-(* Copyright 2013--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-9-30-40-41-42"]
-
-module M = Mach
-module R = Reg
-module RAS = Reg_availability_set
-module RD = Reg_with_debug_info
-module V = Backend_var
-
-(* This pass treats [avail_at_exit] like a "result" structure whereas the
- equivalent in [Liveness] is like an "environment". (Which means we need
- to be careful not to throw away information about further-out catch
- handlers collected in [avail_at_exit].) *)
-let avail_at_exit = Hashtbl.create 42
-let avail_at_raise = ref RAS.Unreachable
-
-let augment_availability_at_raise avail =
- avail_at_raise := RAS.inter avail !avail_at_raise
-
-let check_invariants (instr : M.instruction) ~(avail_before : RAS.t) =
- match avail_before with
- | Unreachable -> ()
- | Ok avail_before ->
- (* Every register that is live across an instruction should also be
- available before the instruction. *)
- if not (R.Set.subset instr.live (RD.Set.forget_debug_info avail_before))
- then begin
- Misc.fatal_errorf "Live registers not a subset of available registers: \
- live={%a} avail_before=%a missing={%a} insn=%a"
- Printmach.regset instr.live
- (RAS.print ~print_reg:Printmach.reg)
- (RAS.Ok avail_before)
- Printmach.regset (R.Set.diff instr.live
- (RD.Set.forget_debug_info avail_before))
- Printmach.instr ({ instr with M. next = M.end_instr (); })
- end;
- (* Every register that is an input to an instruction should be
- available. *)
- let args = R.set_of_array instr.arg in
- let avail_before_fdi = RD.Set.forget_debug_info avail_before in
- if not (R.Set.subset args avail_before_fdi) then begin
- Misc.fatal_errorf "Instruction has unavailable input register(s): \
- avail_before=%a avail_before_fdi={%a} inputs={%a} insn=%a"
- (RAS.print ~print_reg:Printmach.reg) (RAS.Ok avail_before)
- Printmach.regset avail_before_fdi
- Printmach.regset args
- Printmach.instr ({ instr with M. next = M.end_instr (); })
- end
-
-(* [available_regs ~instr ~avail_before] calculates, given the registers
- "available before" an instruction [instr], the registers that are available
- both "across" and immediately after [instr]. This is a forwards dataflow
- analysis.
-
- "available before" can be thought of, at the assembly level, as the set of
- registers available when the program counter is equal to the address of the
- particular instruction under consideration (that is to say, immediately
- prior to the instruction being executed). Inputs to that instruction are
- available at this point even if the instruction will clobber them. Results
- from the previous instruction are also available at this point.
-
- "available across" is the registers available during the execution of
- some particular instruction. These are the registers "available before"
- minus registers that may be clobbered or otherwise invalidated by the
- instruction. (The notion of "available across" is only useful for [Iop]
- instructions. Recall that some of these may expand into multiple
- machine instructions including clobbers, e.g. for [Ialloc].)
-
- The [available_before] and [available_across] fields of each instruction
- is updated by this function.
-*)
-let rec available_regs (instr : M.instruction)
- ~(avail_before : RAS.t) : RAS.t =
- check_invariants instr ~avail_before;
- instr.available_before <- avail_before;
- let avail_across, avail_after =
- let ok set = RAS.Ok set in
- let unreachable = RAS.Unreachable in
- match avail_before with
- | Unreachable -> None, unreachable
- | Ok avail_before ->
- match instr.desc with
- | Iend -> None, ok avail_before
- | Ireturn -> None, unreachable
- | Iop (Itailcall_ind) | Iop (Itailcall_imm _) ->
- Some (ok Reg_with_debug_info.Set.empty), unreachable
- | Iop (Iname_for_debugger { ident; which_parameter; provenance;
- is_assignment; }) ->
- (* First forget about any existing debug info to do with [ident]
- if the naming corresponds to an assignment operation. *)
- let forgetting_ident =
- if not is_assignment then
- avail_before
- else
- RD.Set.map (fun reg ->
- match RD.debug_info reg with
- | None -> reg
- | Some debug_info ->
- if V.same
- (RD.Debug_info.holds_value_of debug_info) ident
- then RD.clear_debug_info reg
- else reg)
- avail_before
- in
- let avail_after = ref forgetting_ident in
- let num_parts_of_value = Array.length instr.arg in
- (* Add debug info about [ident], but only for registers that are known
- to be available. *)
- for part_of_value = 0 to num_parts_of_value - 1 do
- let reg = instr.arg.(part_of_value) in
- if RD.Set.mem_reg forgetting_ident reg then begin
- let regd =
- RD.create ~reg
- ~holds_value_of:ident
- ~part_of_value
- ~num_parts_of_value
- ~which_parameter
- ~provenance
- in
- avail_after := RD.Set.add regd (RD.Set.filter_reg !avail_after reg)
- end
- done;
- Some (ok avail_before), ok !avail_after
- | Iop (Imove | Ireload | Ispill) ->
- (* Moves are special: they enable us to propagate names.
- No-op moves need to be handled specially---in this case, we may
- learn that a given hard register holds the value of multiple
- pseudoregisters (all of which have the same value). This makes us
- match up properly with [Liveness]. *)
- let move_to_same_location =
- let move_to_same_location = ref true in
- for i = 0 to Array.length instr.arg - 1 do
- let arg = instr.arg.(i) in
- let res = instr.res.(i) in
- (* Note that the register classes must be the same, so we don't
- need to check that. *)
- if arg.loc <> res.loc then begin
- move_to_same_location := false
- end
- done;
- !move_to_same_location
- in
- let made_unavailable =
- if move_to_same_location then
- RD.Set.empty
- else
- RD.Set.made_unavailable_by_clobber avail_before
- ~regs_clobbered:instr.res
- ~register_class:Proc.register_class
- in
- let results =
- Array.map2 (fun arg_reg result_reg ->
- match RD.Set.find_reg_exn avail_before arg_reg with
- | exception Not_found ->
- assert false (* see second invariant in [check_invariants] *)
- | arg_reg ->
- RD.create_copying_debug_info ~reg:result_reg
- ~debug_info_from:arg_reg)
- instr.arg instr.res
- in
- let avail_across = RD.Set.diff avail_before made_unavailable in
- let avail_after = RD.Set.union avail_across (RD.Set.of_array results) in
- Some (ok avail_across), ok avail_after
- | Iop op ->
- (* We split the calculation of registers that become unavailable after
- a call into two parts. First: anything that the target marks as
- destroyed by the operation, combined with any registers that will
- be clobbered by the operation writing out its results. *)
- let made_unavailable_1 =
- let regs_clobbered =
- Array.append (Proc.destroyed_at_oper instr.desc) instr.res
- in
- RD.Set.made_unavailable_by_clobber avail_before ~regs_clobbered
- ~register_class:Proc.register_class
- in
- (* Second: the cases of (a) allocations and (b) OCaml to OCaml function
- calls. In these cases, since the GC may run, registers always
- become unavailable unless:
- (a) they are "live across" the instruction; and/or
- (b) they hold immediates and are assigned to the stack.
- For the moment we assume that [Ispecific] instructions do not
- run the GC. *)
- (* CR-someday mshinwell: Consider factoring this out from here and
- [Available_ranges.Make_ranges.end_pos_offset]. *)
- let made_unavailable_2 =
- match op with
- | Icall_ind | Icall_imm _ | Ialloc _ ->
- RD.Set.filter (fun reg ->
- let holds_immediate = RD.holds_non_pointer reg in
- let on_stack = RD.assigned_to_stack reg in
- let live_across = Reg.Set.mem (RD.reg reg) instr.live in
- let remains_available =
- live_across
- || (holds_immediate && on_stack)
- in
- not remains_available)
- avail_before
- | _ -> RD.Set.empty
- in
- let made_unavailable =
- RD.Set.union made_unavailable_1 made_unavailable_2
- in
- let avail_across = RD.Set.diff avail_before made_unavailable in
- if M.operation_can_raise op then begin
- augment_availability_at_raise (ok avail_across)
- end;
- let avail_after =
- RD.Set.union
- (RD.Set.without_debug_info (Reg.set_of_array instr.res))
- avail_across
- in
- Some (ok avail_across), ok avail_after
- | Iifthenelse (_, ifso, ifnot) -> join [ifso; ifnot] ~avail_before
- | Iswitch (_, cases) -> join (Array.to_list cases) ~avail_before
- | Icatch (recursive, handlers, body) ->
- List.iter (fun (nfail, _handler) ->
- (* In case there are nested [Icatch] expressions with the same
- handler numbers, we rely on the [Hashtbl] shadowing
- semantics. *)
- Hashtbl.add avail_at_exit nfail unreachable)
- handlers;
- let avail_after_body =
- available_regs body ~avail_before:(ok avail_before)
- in
- (* CR-someday mshinwell: Consider potential efficiency speedups
- (see suggestions from @chambart on GPR#856). *)
- let aux (nfail, handler) (nfail', avail_at_top_of_handler) =
- assert (nfail = nfail');
- available_regs handler ~avail_before:avail_at_top_of_handler
- in
- let aux_equal (nfail, avail_before_handler)
- (nfail', avail_before_handler') =
- assert (nfail = nfail');
- RAS.equal avail_before_handler avail_before_handler'
- in
- let rec fixpoint avail_at_top_of_handlers =
- let avail_after_handlers =
- List.map2 aux handlers avail_at_top_of_handlers
- in
- let avail_at_top_of_handlers' =
- List.map (fun (nfail, _handler) ->
- match Hashtbl.find avail_at_exit nfail with
- | exception Not_found -> assert false (* see above *)
- | avail_at_top_of_handler -> nfail, avail_at_top_of_handler)
- handlers
- in
- match recursive with
- | Nonrecursive -> avail_after_handlers
- | Recursive ->
- if List.for_all2 aux_equal avail_at_top_of_handlers
- avail_at_top_of_handlers'
- then avail_after_handlers
- else fixpoint avail_at_top_of_handlers'
- in
- let init_avail_at_top_of_handlers =
- List.map (fun (nfail, _handler) ->
- match Hashtbl.find avail_at_exit nfail with
- | exception Not_found -> assert false (* see above *)
- | avail_at_top_of_handler -> nfail, avail_at_top_of_handler)
- handlers
- in
- let avail_after_handlers = fixpoint init_avail_at_top_of_handlers in
- List.iter (fun (nfail, _handler) ->
- Hashtbl.remove avail_at_exit nfail)
- handlers;
- let avail_after =
- List.fold_left (fun avail_at_join avail_after_handler ->
- RAS.inter avail_at_join avail_after_handler)
- avail_after_body
- avail_after_handlers
- in
- None, avail_after
- | Iexit nfail ->
- let avail_before = ok avail_before in
- let avail_at_top_of_handler =
- match Hashtbl.find avail_at_exit nfail with
- | exception Not_found -> (* also see top of [Icatch] clause above *)
- Misc.fatal_errorf "Iexit %d not in scope of Icatch" nfail
- | avail_at_top_of_handler -> avail_at_top_of_handler
- in
- let avail_at_top_of_handler =
- RAS.inter avail_at_top_of_handler avail_before
- in
- Hashtbl.replace avail_at_exit nfail avail_at_top_of_handler;
- None, unreachable
- | Itrywith (body, handler) ->
- let saved_avail_at_raise = !avail_at_raise in
- avail_at_raise := unreachable;
- let avail_before = ok avail_before in
- let after_body = available_regs body ~avail_before in
- let avail_before_handler =
- match !avail_at_raise with
- | Unreachable -> unreachable
- | Ok avail_at_raise ->
- let without_exn_bucket =
- RD.Set.filter_reg avail_at_raise Proc.loc_exn_bucket
- in
- let with_anonymous_exn_bucket =
- RD.Set.add (RD.create_without_debug_info ~reg:Proc.loc_exn_bucket)
- without_exn_bucket
- in
- ok with_anonymous_exn_bucket
- in
- avail_at_raise := saved_avail_at_raise;
- let avail_after =
- RAS.inter after_body
- (available_regs handler ~avail_before:avail_before_handler)
- in
- None, avail_after
- | Iraise _ ->
- let avail_before = ok avail_before in
- augment_availability_at_raise avail_before;
- None, unreachable
- in
- instr.available_across <- avail_across;
- match instr.desc with
- | Iend -> avail_after
- | _ -> available_regs instr.next ~avail_before:avail_after
-
-and join branches ~avail_before =
- let avail_before = RAS.Ok avail_before in
- let avails = List.map (available_regs ~avail_before) branches in
- let avail_after =
- match avails with
- | [] -> avail_before
- | avail::avails -> List.fold_left RAS.inter avail avails
- in
- None, avail_after
-
-let fundecl (f : M.fundecl) =
- if !Clflags.debug && !Clflags.debug_runavail then begin
- assert (Hashtbl.length avail_at_exit = 0);
- avail_at_raise := RAS.Unreachable;
- let fun_args = R.set_of_array f.fun_args in
- let avail_before = RAS.Ok (RD.Set.without_debug_info fun_args) in
- ignore ((available_regs f.fun_body ~avail_before) : RAS.t);
- end;
- f
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell and Thomas Refis, Jane Street Europe *)
-(* *)
-(* Copyright 2013--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Available registers analysis used to determine which variables may be
- shown in the debugger. *)
-
-val fundecl : Mach.fundecl -> Mach.fundecl
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2014--2019 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-30-40-41-42"]
-
-open! Int_replace_polymorphic_compare
-
-module L = Linear
-
-module Make (S : Compute_ranges_intf.S_functor) = struct
- module Subrange_state = S.Subrange_state
- module Subrange_info = S.Subrange_info
- module Range_info = S.Range_info
-
- let rewrite_label env label =
- match Numbers.Int.Map.find label env with
- | exception Not_found -> label
- | label -> label
-
- module Subrange = struct
- (* CR-soon mshinwell: Check that function epilogues, including returns
- in the middle of functions, work ok in the debugger. *)
- type t = {
- start_pos : L.label;
- start_pos_offset : int;
- end_pos : L.label;
- end_pos_offset : int;
- subrange_info : Subrange_info.t;
- }
-
- let create ~(start_insn : L.instruction)
- ~start_pos ~start_pos_offset
- ~end_pos ~end_pos_offset
- ~subrange_info =
- match start_insn.desc with
- | Llabel _ ->
- { start_pos;
- start_pos_offset;
- end_pos;
- end_pos_offset;
- subrange_info;
- }
- | _ ->
- Misc.fatal_errorf "Subrange.create: bad [start_insn]: %a"
- Printlinear.instr start_insn
-
- let start_pos t = t.start_pos
- let start_pos_offset t = t.start_pos_offset
- let end_pos t = t.end_pos
- let end_pos_offset t = t.end_pos_offset
- let info t = t.subrange_info
-
- let rewrite_labels t ~env =
- let start_pos = rewrite_label env t.start_pos in
- let end_pos = rewrite_label env t.end_pos in
- if start_pos = end_pos
- && t.start_pos_offset = 0
- && t.end_pos_offset = 0
- then None
- else
- Some {
- t with
- start_pos;
- end_pos;
- }
- end
-
- module Range = struct
- type t = {
- mutable subranges : Subrange.t list;
- mutable min_pos_and_offset : (L.label * int) option;
- range_info : Range_info.t;
- }
-
- let create range_info =
- { subranges = [];
- min_pos_and_offset = None;
- range_info;
- }
-
- let info t = t.range_info
-
- let add_subrange t ~subrange =
- let start_pos = Subrange.start_pos subrange in
- let start_pos_offset = Subrange.start_pos_offset subrange in
- begin match t.min_pos_and_offset with
- | None -> t.min_pos_and_offset <- Some (start_pos, start_pos_offset)
- | Some (min_pos, min_pos_offset) ->
- (* This may seem dubious, but is correct by virtue of the way label
- counters are allocated sequentially and the fact that, below,
- we go through the code from lowest (code) address to highest. As
- such the label with the highest integer value should be the one with
- the highest address, and vice-versa. (Note that we also exploit the
- ordering when constructing DWARF-4 location lists, to ensure that
- they are sorted in increasing program counter order by start
- address.) *)
- let c = compare start_pos min_pos in
- if c < 0
- || (c = 0 && start_pos_offset < min_pos_offset)
- then begin
- t.min_pos_and_offset <- Some (start_pos, start_pos_offset)
- end
- end;
- t.subranges <- subrange::t.subranges
-
- let estimate_lowest_address t =
- (* See assumption described in compute_ranges_intf.ml. *)
- t.min_pos_and_offset
-
- let fold t ~init ~f =
- List.fold_left f init t.subranges
-
- let no_subranges t =
- match t.subranges with
- | [] -> true
- | _ -> false
-
- let rewrite_labels_and_remove_empty_subranges t ~env =
- let subranges =
- List.filter_map (fun subrange ->
- Subrange.rewrite_labels subrange ~env)
- t.subranges
- in
- match subranges with
- | [] ->
- { t with
- subranges;
- min_pos_and_offset = None;
- }
- | subranges ->
- let min_pos_and_offset =
- Option.map
- (fun (label, offset) -> rewrite_label env label, offset)
- t.min_pos_and_offset
- in
- { t with
- subranges;
- min_pos_and_offset;
- }
- end
-
- type t = {
- ranges : Range.t S.Index.Tbl.t;
- }
-
- module KM = S.Key.Map
- module KS = S.Key.Set
-
- (* Whilst this pass is not DWARF-specific, the output of this pass uses
- the conventions of the DWARF specification (e.g. DWARF-4 spec.
- section 2.6.2, page 30) in the sense that starting addresses of ranges
- are treated as inclusive and ending addresses as exclusive.
-
- Imagine that, for a given [key], the program counter (PC) is exactly at the
- start of [insn]; that instruction has not yet been executed. Assume
- a immediately-previous instruction exists called [prev_insn]. Intuitively,
- this function calculates which available subranges are to start and stop at
- that point, but these notions are subtle.
-
- There are eight cases, referenced in the code below.
-
- 1. First four cases: [key] is currently unavailable, i.e. it is not a
- member of (roughly speaking) [S.available_across prev_insn].
-
- (a) [key] is not in [S.available_before insn] and neither is it in
- [S.available_across insn]. There is nothing to do.
-
- (b) [key] is not in [S.available_before insn] but it is in
- [S.available_across insn]. A new range is created with the starting
- position being one byte after the first machine instruction of [insn]
- and left open.
-
- It might seem like this case 1 (b) is impossible, likewise for 2 (b)
- below, since "available across" should always be a subset of
- "available before". However this does not hold in general: see the
- comment in available_ranges_vars.ml.
-
- (c) [key] is in [S.available_before insn] but it is not in
- [S.available_across insn]. A new range is created with the starting
- position being the first machine instruction of [insn] and the ending
- position being the next machine address after that.
-
- (d) [key] is in [S.available_before insn] and it is also in
- [S.available_across insn]. A new range is created with the starting
- position being the first machine instruction of [insn] and left open.
-
- 2. Second four cases: [key] is already available, i.e. a member of
- [S.available_across prev_insn].
-
- (a) [key] is not in [S.available_before insn] and neither is it in
- [S.available_across insn]. The range endpoint is given as the address
- of the first machine instruction of [insn]. Since endpoint bounds are
- exclusive (see above) then [key] will not be shown as available when
- the debugger is standing on [insn].
-
- (b) [key] is not in [S.available_before insn] but it is in
- [S.available_across insn]. The range endpoint is given as the address
- of the first machine instruction of [insn]; and a new range is opened
- in the same way as for case 1 (b), above.
-
- (c) [key] is in [S.available_before insn] but it is not in
- [S.available_across insn]. This will only happen when calculating
- variables' available ranges for operation (i.e. [Lop]) instructions
- (for example calls or allocations). To give a good user experience it
- is necessary to show availability when the debugger is standing on the
- very first instruction of the operation but not thereafter. As such we
- terminate the range one byte beyond the first machine instruction of
- [insn].
-
- (d) [key] is in [S.available_before insn] and it is also in
- it is in [S.available_across insn]. The existing range remains open.
- *)
-
- type action =
- | Open_one_byte_subrange
- | Open_subrange
- | Open_subrange_one_byte_after
- | Close_subrange
- | Close_subrange_one_byte_after
-
- (* CR mshinwell: Move to [Clflags] *)
- let check_invariants = ref true
-
- let actions_at_instruction ~(insn : L.instruction)
- ~(prev_insn : L.instruction option) =
- let available_before = S.available_before insn in
- let available_across = S.available_across insn in
- let opt_available_across_prev_insn =
- match prev_insn with
- | None -> KS.empty
- | Some prev_insn -> S.available_across prev_insn
- in
- let case_1b =
- KS.diff available_across
- (KS.union opt_available_across_prev_insn available_before)
- in
- let case_1c =
- KS.diff available_before
- (KS.union opt_available_across_prev_insn available_across)
- in
- let case_1d =
- KS.diff (KS.inter available_before available_across)
- opt_available_across_prev_insn
- in
- let case_2a =
- KS.diff opt_available_across_prev_insn
- (KS.union available_before available_across)
- in
- let case_2b =
- KS.inter opt_available_across_prev_insn
- (KS.diff available_across available_before)
- in
- let case_2c =
- KS.diff
- (KS.inter opt_available_across_prev_insn available_before)
- available_across
- in
- let handle case action result =
- (* We use [K.all_parents] here to circumvent a potential performance
- problem. In the case of lexical blocks, there may be long chains
- of blocks and their parents, yet the innermost block determines the
- rest of the chain. As such [S] (which comes from
- lexical_block_ranges.ml) only needs to use the innermost blocks in
- the "available before" sets, keeping things fast---but we still
- populate ranges for all parent blocks, thus avoiding any
- post-processing, by using [K.all_parents] here. *)
- KS.fold (fun key result ->
- List.fold_left (fun result key ->
- (key, action) :: result)
- result
- (key :: (S.Key.all_parents key)))
- case
- result
- in
- let actions =
- (* Ranges must be closed before they are opened---otherwise, when a
- variable moves between registers at a range boundary, we might end up
- with no open range for that variable. Note that the pipeline below
- constructs the [actions] list in reverse order---later functions in
- the pipeline produce actions nearer the head of the list. *)
- []
- |> handle case_1b Open_subrange_one_byte_after
- |> handle case_1c Open_one_byte_subrange
- |> handle case_1d Open_subrange
- |> handle case_2a Close_subrange
- |> handle case_2b Open_subrange_one_byte_after
- |> handle case_2b Close_subrange
- |> handle case_2c Close_subrange_one_byte_after
- in
- let must_restart =
- if S.must_restart_ranges_upon_any_change ()
- && match actions with
- | [] -> false
- | _::_ -> true
- then
- KS.inter opt_available_across_prev_insn available_before
- else
- KS.empty
- in
- actions, must_restart
-
- let rec process_instruction t (fundecl : L.fundecl)
- ~(first_insn : L.instruction) ~(insn : L.instruction)
- ~(prev_insn : L.instruction option)
- ~currently_open_subranges ~subrange_state =
- let used_label = ref None in
- let get_label () =
- match !used_label with
- | Some label_and_insn -> label_and_insn
- | None ->
- (* Note that we can't reuse an existing label in the code since we rely
- on the ordering of range-related labels. *)
- let label = Cmm.new_label () in
- let label_insn : L.instruction =
- { desc = Llabel label;
- next = insn;
- arg = [| |];
- res = [| |];
- dbg = insn.dbg;
- live = insn.live;
- }
- in
- used_label := Some (label, label_insn);
- label, label_insn
- in
- let open_subrange key ~start_pos_offset ~currently_open_subranges =
- (* If the range is later discarded, the inserted label may actually be
- useless, but this doesn't matter. It does not generate any code. *)
- let label, label_insn = get_label () in
- KM.add key (label, start_pos_offset, label_insn) currently_open_subranges
- in
- let close_subrange key ~end_pos_offset ~currently_open_subranges =
- match KM.find key currently_open_subranges with
- | exception Not_found ->
- Misc.fatal_errorf "No subrange is open for key %a"
- S.Key.print key
- | start_pos, start_pos_offset, start_insn ->
- let currently_open_subranges = KM.remove key currently_open_subranges in
- match Range_info.create fundecl key ~start_insn with
- | None -> currently_open_subranges
- | Some (index, range_info) ->
- let range =
- match S.Index.Tbl.find t.ranges index with
- | range -> range
- | exception Not_found ->
- let range = Range.create range_info in
- S.Index.Tbl.add t.ranges index range;
- range
- in
- let label, _label_insn = get_label () in
- let subrange_info = Subrange_info.create key subrange_state in
- let subrange =
- Subrange.create ~start_insn
- ~start_pos ~start_pos_offset
- ~end_pos:label ~end_pos_offset
- ~subrange_info
- in
- Range.add_subrange range ~subrange;
- currently_open_subranges
- in
- let actions, must_restart = actions_at_instruction ~insn ~prev_insn in
- (* Restart ranges if needed *)
- let currently_open_subranges =
- KS.fold (fun key currently_open_subranges ->
- let currently_open_subranges =
- close_subrange key ~end_pos_offset:0 ~currently_open_subranges
- in
- open_subrange key ~start_pos_offset:0 ~currently_open_subranges)
- must_restart
- currently_open_subranges
- in
- (* Apply actions *)
- let currently_open_subranges =
- List.fold_left (fun currently_open_subranges (key, (action : action)) ->
- match action with
- | Open_one_byte_subrange ->
- let currently_open_subranges =
- open_subrange key ~start_pos_offset:0 ~currently_open_subranges
- in
- close_subrange key ~end_pos_offset:1 ~currently_open_subranges
- | Open_subrange ->
- open_subrange key ~start_pos_offset:0 ~currently_open_subranges
- | Open_subrange_one_byte_after ->
- open_subrange key ~start_pos_offset:1 ~currently_open_subranges
- | Close_subrange ->
- close_subrange key ~end_pos_offset:0 ~currently_open_subranges
- | Close_subrange_one_byte_after ->
- close_subrange key ~end_pos_offset:1 ~currently_open_subranges)
- currently_open_subranges
- actions
- in
- (* Close all subranges if at last instruction *)
- let currently_open_subranges =
- match insn.desc with
- | Lend ->
- let currently_open_subranges =
- KM.fold (fun key _ currently_open_subranges ->
- close_subrange key ~end_pos_offset:0 ~currently_open_subranges)
- currently_open_subranges
- currently_open_subranges
- in
- assert (KM.is_empty currently_open_subranges);
- currently_open_subranges
- | _ -> currently_open_subranges
- in
- let first_insn =
- match !used_label with
- | None -> first_insn
- | Some (_label, label_insn) ->
- assert (label_insn.L.next == insn);
- (* (Note that by virtue of [Lprologue], we can insert labels prior to
- the first assembly instruction of the function.) *)
- begin match prev_insn with
- | None ->
- (* The label becomes the new first instruction. *)
- label_insn
- | Some prev_insn ->
- assert (prev_insn.L.next == insn);
- prev_insn.next <- label_insn;
- first_insn
- end
- in
- if !check_invariants then begin
- let currently_open_subranges =
- KS.of_list (
- List.map (fun (key, _datum) -> key)
- (KM.bindings currently_open_subranges))
- in
- let should_be_open = S.available_across insn in
- let not_open_but_should_be =
- KS.diff should_be_open currently_open_subranges
- in
- if not (KS.is_empty not_open_but_should_be) then begin
- Misc.fatal_errorf "%s: ranges for %a are not open across the following \
- instruction:\n%a\navailable_across:@ %a\n\
- currently_open_subranges: %a"
- fundecl.fun_name
- KS.print not_open_but_should_be
- Printlinear.instr { insn with L.next = L.end_instr; }
- KS.print should_be_open
- KS.print currently_open_subranges
- end
- end;
- match insn.desc with
- | Lend -> first_insn
- | Lprologue | Lop _ | Lreloadretaddr | Lreturn | Llabel _
- | Lbranch _ | Lcondbranch _ | Lcondbranch3 _ | Lswitch _
- | Lentertrap | Lpushtrap _ | Lpoptrap | Ladjust_trap_depth _
- | Lraise _ ->
- let subrange_state =
- Subrange_state.advance_over_instruction subrange_state insn
- in
- process_instruction t fundecl ~first_insn ~insn:insn.next
- ~prev_insn:(Some insn) ~currently_open_subranges ~subrange_state
-
- let process_instructions t fundecl ~first_insn =
- let subrange_state = Subrange_state.create () in
- process_instruction t fundecl ~first_insn ~insn:first_insn
- ~prev_insn:None ~currently_open_subranges:KM.empty ~subrange_state
-
- let all_indexes t =
- S.Index.Set.of_list (List.map fst (S.Index.Tbl.to_list t.ranges))
-
- let empty =
- { ranges = S.Index.Tbl.create 1;
- }
-
- let create (fundecl : L.fundecl) =
- let t =
- { ranges = S.Index.Tbl.create 42;
- }
- in
- let first_insn =
- process_instructions t fundecl ~first_insn:fundecl.fun_body
- in
- let fundecl : L.fundecl =
- { fundecl with fun_body = first_insn; }
- in
- t, fundecl
-
- let iter t ~f =
- S.Index.Tbl.iter (fun index range -> f index range)
- t.ranges
-
- let fold t ~init ~f =
- S.Index.Tbl.fold (fun index range acc -> f acc index range)
- t.ranges
- init
-
- let find t index = S.Index.Tbl.find t.ranges index
-
- let rewrite_labels_and_remove_empty_subranges_and_ranges t ~env =
- let ranges = S.Index.Tbl.create 42 in
- S.Index.Tbl.iter (fun index range ->
- let range =
- Range.rewrite_labels_and_remove_empty_subranges range ~env
- in
- if not (Range.no_subranges range) then begin
- S.Index.Tbl.add ranges index range
- end)
- t.ranges;
- { ranges;
- }
-end
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2014--2018 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Coalescing of per-instruction information into possibly-discontiguous
- regions of code delimited by labels. This is used for collating
- register availability and lexical block scoping information into a
- concise form. *)
-
-[@@@ocaml.warning "+a-4-30-40-41-42"]
-
-module Make (S : Compute_ranges_intf.S_functor)
- : Compute_ranges_intf.S
- with module Index := S.Index
- with module Key := S.Key
- with module Subrange_state := S.Subrange_state
- with module Subrange_info := S.Subrange_info
- with module Range_info := S.Range_info
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2014--2019 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-30-40-41-42"]
-
-(** This file defines types that are used to specify the interface of
- [Compute_ranges]. The description of [Compute_ranges] is:
-
- "Coalescing of per-instruction information into possibly-discontiguous
- regions of code delimited by labels. This is used for collating register
- availability and lexical block scoping information into a concise form."
-
- [Compute_ranges] defines a functor, whose argument has type [S_functor], and
- whose result has type [S]. Both [S_functor] and [S] are defined here.
-
- It is suggested that those unfamiliar with this module start by reading
- the documentation on module type [S], below.
-*)
-
-module L = Linear
-
-(** The type of caller-defined contextual state associated with subranges.
- This may be used to track information throughout the range-computing
- process. *)
-module type S_subrange_state = sig
- type t
-
- val create : unit -> t
- val advance_over_instruction : t -> L.instruction -> t
-end
-
-(** The type of caller-defined information associated with subranges. *)
-module type S_subrange_info = sig
- type t
- type key
- type subrange_state
-
- val create : key -> subrange_state -> t
-end
-
-(** The type of caller-defined information associated with ranges. *)
-module type S_range_info = sig
- type t
- type key
- type index
-
- val create
- : L.fundecl
- -> key
- -> start_insn:L.instruction
- -> (index * t) option
-end
-
-(** This module type specifies what the caller has to provide in order to
- instantiate a module to compute ranges. *)
-module type S_functor = sig
- (** The module [Index] is used to filter and group the generated subranges.
- Inclusion of a computed subrange in the result is conditional upon the
- existence of an index that can be associated to it. To give a concrete
- example, the keys associated to ranges might be pseudoregisters, and the
- indexes variable names (c.f. [Available_ranges_vars]). Every register that
- is not known to hold the value of some variable is dropped from the
- result.
-
- As the name suggests, values of type [Index.t] also serve as indices for
- accessing ranges in the result. The result may actually contain no
- reference to keys (only [Subrange_info.t] may reliably contain it), and
- subranges with different keys will be coalesced into a single range if all
- their keys are associated to the same index. *)
- module Index : Identifiable.S
-
- (** The module [Key] corresponds to the identifiers that define the ranges in
- [Linear] instructions. Each instruction should have two sets of keys,
- [available_before] and [available_across], with accessor functions of
- these names being provided to retrieve them. The notion of "availability"
- is not prescribed. The availability sets are used to compute subranges
- associated to each key. *)
- module Key : sig
- (** The type of identifiers that define ranges. *)
- type t
-
- module Set : sig
- include Set.S with type elt = t
- val print : Format.formatter -> t -> unit
- end
-
- module Map : Map.S with type key = t
-
- (** Print a representation (typically sexp) of the given key to the given
- formatter. *)
- val print : Format.formatter -> t -> unit
-
- (** In some situations, for performance reasons, an "available" set may only
- contain a subset of all keys that need to be tracked. For example, when
- using a notion of availability that describes which lexical block a
- given instruction lies in, using a standard notion of nested lexical
- blocks, the innermost lexical block uniquely determines the chain of its
- parents. (This is exploited in [Lexical_block_ranges].) The
- [all_parents] function must return, given an "available" [key], all
- those other keys that are also available and uniquely determined by
- [key]. *)
- val all_parents : t -> t list
- end
-
- (** The module [Range_info] is used to store additional information on a range
- that is associated to a range at its creation and can be retrieved from
- the result. The association between keys and indices is also done here:
- [Range_info.create] serves both as a map between keys and indices; and
- also as the creator of the [Range_info.t] structure. When several
- subranges are contained in a single range, the associated [Range_info.t]
- will correspond to the first closed subrange. *)
- module Range_info : S_range_info
- with type key := Key.t
- with type index := Index.t
-
- (** The module [Subrange_state] describes information that needs to be
- propagated and passed to [Subrange_info.create]. The state that will be
- used for subrange creation is the state at the end of the subrange, not at
- the beginning. *)
- module Subrange_state : S_subrange_state
-
- (** The module [Subrange_info] has a similar purpose to [Range_info], but for
- subranges. Its distinguishing property is that it can store information
- about its context using the additional [subrange_state] parameter of its
- [create] function. *)
- module Subrange_info : S_subrange_info
- with type key := Key.t
- with type subrange_state := Subrange_state.t
-
- (** How to retrieve from an instruction those keys that are available
- immediately before the instruction starts executing. *)
- val available_before : L.instruction -> Key.Set.t
-
- (** How to retrieve from an instruction those keys that are available
- between the points at which the instruction reads its arguments and
- writes its results. *)
- val available_across : L.instruction -> Key.Set.t
-
- (** This [must_restart_ranges_upon_any_change] boolean exists because some
- consumers of the range information may require that two subranges are
- disjoint rather than including one in another. When this function returns
- [true], whenever a subrange is opened or closed, all other overlapping
- subranges will be split in two at the same point. *)
- val must_restart_ranges_upon_any_change : unit -> bool
-end
-
-(** This module type is the result type of the [Compute_ranges.Make] functor.
-
- The _ranges_ being computed are composed of contiguous _subranges_ delimited
- by two labels (of type [Linear.label]). These labels will be added by
- this pass to the code being inspected, which is why the [create] function in
- the result of the functor returns not only the ranges but also the updated
- function with the labels added. The [start_pos_offset] and [end_pos_offset]
- components of the subranges are there to allow a distinction between ranges
- starting (or ending) right at the start of the corresponding instruction
- (offset of zero), and ranges starting or ending one byte after the actual
- instruction (offset of one). *)
-module type S = sig
- (** Corresponds to [Index] in the [S_functor] module type. *)
- module Index : Identifiable.S
-
- (** Corresponds to [Key] in the [S_functor] module type. *)
- module Key : sig
- type t
- module Set : Set.S with type elt = t
- module Map : Map.S with type key = t
- end
-
- (** Corresponds to [Subrange_state] in the [S_functor] module type. *)
- module Subrange_state : S_subrange_state
-
- (** Corresponds to [Subrange_info] in the [S_functor] module type. *)
- module Subrange_info : S_subrange_info
- with type key := Key.t
- with type subrange_state := Subrange_state.t
-
- (** Corresponds to [Range_info] in the [S_functor] module type. *)
- module Range_info : S_range_info
- with type key := Key.t
- with type index := Index.t
-
- module Subrange : sig
- (** The type of subranges. Each subrange is a contiguous region of
- code delimited by labels. *)
- type t
-
- (** The caller's information about the subrange. *)
- val info : t -> Subrange_info.t
-
- (** The label at the start of the range. *)
- val start_pos : t -> Linear.label
-
- (** How many bytes from the label at [start_pos] the range actually
- commences. If this value is zero, then the first byte of the range
- has the address of the label given by [start_pos]. *)
- val start_pos_offset : t -> int
-
- (** The label at the end of the range. *)
- val end_pos : t -> Linear.label
-
- (** Like [start_pos_offset], but analogously for the end of the range. (The
- sense is not inverted; a positive [end_pos_offset] means the range ends
- at an address higher than the address of the [end_pos], just like a
- positive [start_pos_offset] means the range starts at an address higher
- than the [start_pos]. *)
- val end_pos_offset : t -> int
- end
-
- module Range : sig
- (** The type of ranges. Each range is a list of subranges, so a
- possibly-discontiguous region of code. *)
- type t
-
- (** The caller's information about the range. *)
- val info : t -> Range_info.t
-
- (** Estimate the pair of ([start_pos], [start_pos_offset]) (c.f. [Subrange],
- above) found amongst the given ranges that yields the lowest machine
- address. The assumption is made that no [start_pos_offset] or
- [end_pos_offset] will cause the corresponding extremity of a range to
- cross an extremity of any other range. (This should be satisfied in
- typical uses because the offsets are typically zero or one.) If there
- are no ranges supplied then [None] is returned. *)
- val estimate_lowest_address : t -> (Linear.label * int) option
-
- (** Fold over all subranges within the given range. *)
- val fold
- : t
- -> init:'a
- -> f:('a -> Subrange.t -> 'a)
- -> 'a
- end
-
- (** The type holding information on computed ranges. *)
- type t
-
- (** A value of type [t] that holds no range information. *)
- val empty : t
-
- (** Compute ranges for the code in the given linearized function
- declaration, returning the ranges as a value of type [t] and the
- rewritten code that must go forward for emission. *)
- val create : Linear.fundecl -> t * Linear.fundecl
-
- (** Iterate through ranges. Each range is associated with an index. *)
- val iter : t -> f:(Index.t -> Range.t -> unit) -> unit
-
- (** Like [iter], but a fold. *)
- val fold : t -> init:'a -> f:('a -> Index.t -> Range.t -> 'a) -> 'a
-
- (** Find the range for the given index, or raise an exception. *)
- val find : t -> Index.t -> Range.t
-
- (** All indexes for which the given value of type [t] contains ranges. *)
- val all_indexes : t -> Index.Set.t
-
- (** An internal function used by [Coalesce_labels].
- The [env] should come from [Coalesce_labels.fundecl]. *)
- val rewrite_labels_and_remove_empty_subranges_and_ranges
- : t
- -> env:int Numbers.Int.Map.t
- -> t
-end
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2016--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-9-30-40-41-42"]
-
-module RD = Reg_with_debug_info
-module V = Backend_var
-
-type t =
- | Ok of RD.Set.t
- | Unreachable
-
-let inter regs1 regs2 =
- match regs1, regs2 with
- | Unreachable, _ -> regs2
- | _, Unreachable -> regs1
- | Ok avail1, Ok avail2 ->
- let result =
- RD.Set.fold (fun reg1 result ->
- match RD.Set.find_reg_exn avail2 (RD.reg reg1) with
- | exception Not_found -> result
- | reg2 ->
- let debug_info1 = RD.debug_info reg1 in
- let debug_info2 = RD.debug_info reg2 in
- let debug_info =
- match debug_info1, debug_info2 with
- | None, None -> None
- (* Example for this next case: the value of a mutable variable x
- is copied into another variable y; then there is a conditional
- where on one branch x is assigned and on the other branch it
- is not. This means that on the former branch we have
- forgotten about y holding the value of x; but we have not on
- the latter. At the join point we must have forgotten the
- information. *)
- | None, Some _ | Some _, None -> None
- | Some debug_info1, Some debug_info2 ->
- if RD.Debug_info.compare debug_info1 debug_info2 = 0 then
- Some debug_info1
- else
- None
- in
- let reg =
- RD.create_with_debug_info ~reg:(RD.reg reg1)
- ~debug_info
- in
- RD.Set.add reg result)
- avail1
- RD.Set.empty
- in
- Ok result
-
-let equal t1 t2 =
- match t1, t2 with
- | Unreachable, Unreachable -> true
- | Unreachable, Ok _ | Ok _, Unreachable -> false
- | Ok regs1, Ok regs2 -> RD.Set.equal regs1 regs2
-
-let canonicalise availability =
- match availability with
- | Unreachable -> Unreachable
- | Ok availability ->
- let regs_by_ident = V.Tbl.create 42 in
- RD.Set.iter (fun reg ->
- match RD.debug_info reg with
- | None -> ()
- | Some debug_info ->
- let name = RD.Debug_info.holds_value_of debug_info in
- if not (V.persistent name) then begin
- match V.Tbl.find regs_by_ident name with
- | exception Not_found -> V.Tbl.add regs_by_ident name reg
- | (reg' : RD.t) ->
- (* We prefer registers that are assigned to the stack since
- they probably give longer available ranges (less likely to
- be clobbered). *)
- match RD.location reg, RD.location reg' with
- | Reg _, Stack _
- | Reg _, Reg _
- | Stack _, Stack _
- | _, Unknown
- | Unknown, _ -> ()
- | Stack _, Reg _ ->
- V.Tbl.remove regs_by_ident name;
- V.Tbl.add regs_by_ident name reg
- end)
- availability;
- let result =
- V.Tbl.fold (fun _ident reg availability ->
- RD.Set.add reg availability)
- regs_by_ident
- RD.Set.empty
- in
- Ok result
-
-let print ~print_reg ppf = function
- | Unreachable -> Format.fprintf ppf "<unreachable>"
- | Ok availability ->
- Format.fprintf ppf "{%a}"
- (Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
- (Reg_with_debug_info.print ~print_reg))
- (RD.Set.elements availability)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2016--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Register availability sets. *)
-
-type t =
- | Ok of Reg_with_debug_info.Set.t
- | Unreachable
-
-val inter : t -> t -> t
-(** Intersection of availabilities. *)
-
-val canonicalise : t -> t
-(** Return a subset of the given availability set which contains no registers
- that are not associated with debug info (and holding values of
- non-persistent identifiers); and where no two registers share the same
- location. *)
-
-val equal : t -> t -> bool
-
-val print
- : print_reg:(Format.formatter -> Reg.t -> unit)
- -> Format.formatter
- -> t
- -> unit
-(** For debugging purposes only. *)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2016--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-[@@@ocaml.warning "+a-4-9-30-40-41-42"]
-
-module V = Backend_var
-
-module Debug_info = struct
- type t = {
- holds_value_of : V.t;
- part_of_value : int;
- num_parts_of_value : int;
- which_parameter : int option;
- provenance : unit option;
- }
-
- let compare t1 t2 =
- let c = V.compare t1.holds_value_of t2.holds_value_of in
- if c <> 0 then c
- else
- Stdlib.compare
- (t1.part_of_value, t1.num_parts_of_value, t1.which_parameter)
- (t2.part_of_value, t2.num_parts_of_value, t2.which_parameter)
-
- let holds_value_of t = t.holds_value_of
- let part_of_value t = t.part_of_value
- let num_parts_of_value t = t.num_parts_of_value
- let which_parameter t = t.which_parameter
- let provenance t = t.provenance
-
- let print ppf t =
- Format.fprintf ppf "%a" V.print t.holds_value_of;
- if not (t.part_of_value = 0 && t.num_parts_of_value = 1) then begin
- Format.fprintf ppf "(%d/%d)" t.part_of_value t.num_parts_of_value
- end;
- begin match t.which_parameter with
- | None -> ()
- | Some index -> Format.fprintf ppf "[P%d]" index
- end
-end
-
-module T = struct
- type t = {
- reg : Reg.t;
- debug_info : Debug_info.t option;
- }
-
- module Order = struct
- type t = Reg.t
- let compare (t1 : t) (t2 : t) = t1.stamp - t2.stamp
- end
-
- let compare t1 t2 =
- Order.compare t1.reg t2.reg
-end
-
-include T
-
-type reg_with_debug_info = t
-
-let create ~reg ~holds_value_of ~part_of_value ~num_parts_of_value
- ~which_parameter ~provenance =
- assert (num_parts_of_value >= 1);
- assert (part_of_value >= 0 && part_of_value < num_parts_of_value);
- assert (match which_parameter with None -> true | Some index -> index >= 0);
- let debug_info : Debug_info.t =
- { holds_value_of;
- part_of_value;
- num_parts_of_value;
- which_parameter;
- provenance;
- }
- in
- { reg;
- debug_info = Some debug_info;
- }
-
-let create_with_debug_info ~reg ~debug_info =
- { reg;
- debug_info;
- }
-
-let create_without_debug_info ~reg =
- { reg;
- debug_info = None;
- }
-
-let create_copying_debug_info ~reg ~debug_info_from =
- { reg;
- debug_info = debug_info_from.debug_info;
- }
-
-let reg t = t.reg
-let location t = t.reg.loc
-
-let holds_pointer t =
- match t.reg.typ with
- | Addr | Val -> true
- | Int | Float -> false
-
-let holds_non_pointer t = not (holds_pointer t)
-
-let assigned_to_stack t =
- match t.reg.loc with
- | Stack _ -> true
- | Reg _ | Unknown -> false
-
-let regs_at_same_location (reg1 : Reg.t) (reg2 : Reg.t) ~register_class =
- (* We need to check the register classes too: two locations both saying
- "stack offset N" might actually be different physical locations, for
- example if one is of class "Int" and another "Float" on amd64.
- [register_class] will be [Proc.register_class], but cannot be here,
- due to a circular dependency. *)
- reg1.loc = reg2.loc
- && register_class reg1 = register_class reg2
-
-let at_same_location t (reg : Reg.t) ~register_class =
- regs_at_same_location t.reg reg ~register_class
-
-let debug_info t = t.debug_info
-
-let clear_debug_info t =
- { t with debug_info = None; }
-
-module Order_distinguishing_names_and_locations = struct
- type nonrec t = t
-
- let compare t1 t2 =
- match t1.debug_info, t2.debug_info with
- | None, None -> 0
- | None, Some _ -> -1
- | Some _, None -> 1
- | Some di1, Some di2 ->
- let c = V.compare di1.holds_value_of di2.holds_value_of in
- if c <> 0 then c
- else Stdlib.compare t1.reg.loc t2.reg.loc
-end
-
-module Set_distinguishing_names_and_locations =
- Set.Make (Order_distinguishing_names_and_locations)
-
-module Map_distinguishing_names_and_locations =
- Map.Make (Order_distinguishing_names_and_locations)
-
-module Set = struct
- include Set.Make (T)
-
- let of_array elts =
- of_list (Array.to_list elts)
-
- let forget_debug_info t =
- fold (fun t acc -> Reg.Set.add (reg t) acc) t Reg.Set.empty
-
- let without_debug_info regs =
- Reg.Set.fold (fun reg acc -> add (create_without_debug_info ~reg) acc)
- regs
- empty
-
- let made_unavailable_by_clobber t ~regs_clobbered ~register_class =
- Reg.Set.fold (fun reg acc ->
- let made_unavailable =
- filter (fun reg' ->
- regs_at_same_location reg'.reg reg ~register_class)
- t
- in
- union made_unavailable acc)
- (Reg.set_of_array regs_clobbered)
- (* ~init:*)empty
-
- let mem_reg t (reg : Reg.t) =
- exists (fun t -> t.reg.stamp = reg.stamp) t
-
- let filter_reg t (reg : Reg.t) =
- filter (fun t -> t.reg.stamp <> reg.stamp) t
-
- (* CR-someday mshinwell: Well, it looks like we should have used a map.
- mshinwell: Also see @chambart's suggestion on GPR#856. *)
- let find_reg_exn t (reg : Reg.t) =
- match elements (filter (fun t -> t.reg.stamp = reg.stamp) t) with
- | [] -> raise Not_found
- | [reg] -> reg
- | _ -> assert false
-end
-
-let print ~print_reg ppf t =
- match t.debug_info with
- | None -> Format.fprintf ppf "%a" print_reg t.reg
- | Some debug_info ->
- Format.fprintf ppf "%a(%a)" print_reg t.reg Debug_info.print debug_info
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Mark Shinwell, Jane Street Europe *)
-(* *)
-(* Copyright 2016--2017 Jane Street Group LLC *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(** Registers equipped with information used for generating debugging
- information. *)
-
-module Debug_info : sig
- type t
-
- val compare : t -> t -> int
-
- val holds_value_of : t -> Backend_var.t
- (** The identifier that the register holds (part of) the value of. *)
-
- val part_of_value : t -> int
- val num_parts_of_value : t -> int
-
- val which_parameter : t -> int option
- (** If the register corresponds to a function parameter, the value returned
- is the zero-based index of said parameter; otherwise it is [None]. *)
-
- val provenance : t -> unit option
-end
-
-type t
-
-type reg_with_debug_info = t
-
-val create
- : reg:Reg.t
- -> holds_value_of:Backend_var.t
- -> part_of_value:int
- -> num_parts_of_value:int
- -> which_parameter:int option
- -> provenance:unit option
- -> t
-
-val create_with_debug_info : reg:Reg.t -> debug_info:Debug_info.t option -> t
-
-val create_without_debug_info : reg:Reg.t -> t
-
-val create_copying_debug_info : reg:Reg.t -> debug_info_from:t -> t
-
-val reg : t -> Reg.t
-val location : t -> Reg.location
-val debug_info : t -> Debug_info.t option
-
-val at_same_location : t -> Reg.t -> register_class:(Reg.t -> int) -> bool
-(** [at_same_location t reg] holds iff the register [t] corresponds to
- the same (physical or pseudoregister) location as the register [reg],
- which is not equipped with debugging information.
- [register_class] should be [Proc.register_class].
-*)
-
-val holds_pointer : t -> bool
-val holds_non_pointer : t -> bool
-
-val assigned_to_stack : t -> bool
-(** [assigned_to_stack t] holds iff the location of [t] is a hard stack
- slot. *)
-
-val clear_debug_info : t -> t
-
-module Set_distinguishing_names_and_locations
- : Set.S with type elt = t
-
-module Map_distinguishing_names_and_locations
- : Map.S with type key = t
-
-module Set : sig
- include Set.S with type elt = t
-
- val of_array : reg_with_debug_info array -> t
-
- val mem_reg : t -> Reg.t -> bool
-
- val find_reg_exn : t -> Reg.t -> reg_with_debug_info
-
- val filter_reg : t -> Reg.t -> t
-
- val forget_debug_info : t -> Reg.Set.t
-
- val without_debug_info : Reg.Set.t -> t
-
- val made_unavailable_by_clobber
- : t
- -> regs_clobbered:Reg.t array
- -> register_class:(Reg.t -> int)
- -> t
- (** [made_unavailable_by_clobber t ~regs_clobbered ~register_class] returns
- the largest subset of [t] whose locations do not overlap with any
- registers in [regs_clobbered]. (Think of [t] as a set of available
- registers.)
- [register_class] should always be [Proc.register_class]. *)
-end
-
-val print
- : print_reg:(Format.formatter -> Reg.t -> unit)
- -> Format.formatter
- -> t
- -> unit
(* Common functions for emitting assembly code *)
+type error =
+ | Stack_frame_too_large of int
+
+exception Error of error
+
let output_channel = ref stdout
let emit_string s = output_string !output_channel s
end else begin
let i = ref 0 in
while !i < l do
- let n = min (l - !i) 80 in
+ let n = Int.min (l - !i) 80 in
emit_string directive;
emit_string_literal (String.sub s !i n);
emit_char '\n';
Label_table.add debuginfos key lbl;
lbl
in
+ let efa_16_checked n =
+ assert (n >= 0);
+ if n < 0x1_0000
+ then a.efa_16 n
+ else raise (Error(Stack_frame_too_large n))
+ in
let emit_frame fd =
assert (fd.fd_frame_size land 3 = 0);
let flags =
then 3 else 2
in
a.efa_code_label fd.fd_lbl;
- a.efa_16 (fd.fd_frame_size + flags);
- a.efa_16 (List.length fd.fd_live_offset);
- List.iter a.efa_16 fd.fd_live_offset;
+ efa_16_checked (fd.fd_frame_size + flags);
+ efa_16_checked (List.length fd.fd_live_offset);
+ List.iter efa_16_checked fd.fd_live_offset;
begin match fd.fd_debuginfo with
| _ when flags = 0 ->
()
a.efa_string defname
in
let pack_info fd_raise d has_next =
- let line = min 0xFFFFF d.Debuginfo.dinfo_line
- and char_start = min 0xFF d.Debuginfo.dinfo_char_start
- and char_end = min 0x3FF d.Debuginfo.dinfo_char_end
+ let line = Int.min 0xFFFFF d.Debuginfo.dinfo_line
+ and char_start = Int.min 0xFF d.Debuginfo.dinfo_char_start
+ and char_end = Int.min 0x3FF d.Debuginfo.dinfo_char_end
and kind = if fd_raise then 1 else 0
and has_next = if has_next then 1 else 0 in
Int64.(add (shift_left (of_int line) 44)
let binary_backend_available = ref false
let create_asm_file = ref true
+
+let report_error ppf = function
+ | Stack_frame_too_large n ->
+ Format.fprintf ppf "stack frame too large (%d bytes)" n
+
+let mk_env f : Emitenv.per_function_env =
+ {
+ f;
+ stack_offset = 0;
+ call_gc_sites = [];
+ bound_error_sites = [];
+ bound_error_call = None;
+ call_gc_label = 0;
+ jumptables_lbl = None;
+ jumptables = [];
+ float_literals = [];
+ int_literals = [];
+ offset_literals = [];
+ gotrel_literals = [];
+ symbol_literals = [];
+ size_literals = 0;
+ }
val cfi_adjust_cfa_offset : int -> unit
val cfi_offset : reg:int -> offset:int -> unit
-
val binary_backend_available: bool ref
(** Is a binary backend available. If yes, we don't need
to generate the textual assembly file (unless the user
val create_asm_file: bool ref
(** Are we actually generating the textual assembly file? *)
+
+type error =
+ | Stack_frame_too_large of int
+
+exception Error of error
+val report_error: Format.formatter -> error -> unit
+
+val mk_env : Linear.fundecl -> Emitenv.per_function_env
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+(* Per function environment for emit - common code for all targets. *)
+type label = Linear.label
+
+(* Record calls to caml_call_gc, emitted out of line. *)
+type gc_call =
+ { gc_lbl: label; (* Entry label *)
+ gc_return_lbl: label; (* Where to branch after GC *)
+ gc_frame_lbl: label; (* Label of frame descriptor *)
+ }
+
+(* Record calls to caml_ml_array_bound_error.
+ In -g mode, we maintain one call to caml_ml_array_bound_error
+ per bound check site. Without -g, we can share a single call. *)
+
+type bound_error_call =
+ { bd_lbl: label; (* Entry label *)
+ bd_frame: label; (* Label of frame descriptor *)
+ }
+
+(* Pending floating-point literals *)
+type float_literal =
+ {
+ fl : int64;
+ lbl : label;
+ }
+
+(* Pending large integer literals *)
+type int_literal =
+ {
+ n : nativeint;
+ n_lbl : label;
+ }
+
+(* Pending offset computations : {lbl; dst; src;} --> lbl: .word dst-(src+N) *)
+type offset_computation =
+ { lbl : label;
+ dst : label;
+ src : label;
+ }
+
+(* Pending relative references to the global offset table *)
+type gotrel_literal =
+ { lbl_got : label;
+ lbl_pic : label;
+ }
+
+(* Pending symbol literals *)
+type symbol_literal =
+ {
+ sym : string;
+ lbl : label;
+ }
+
+(* Environment for emitting a function *)
+type per_function_env = {
+ f : Linear.fundecl;
+ mutable stack_offset : int;
+ mutable call_gc_sites : gc_call list; (* used in all targets except power *)
+ mutable call_gc_label : label; (* used only in power *)
+ mutable bound_error_sites : bound_error_call list;
+ (* used in all targets except power *)
+ mutable bound_error_call : label option; (* used in amd64,i386,s390x *)
+
+ (* record jump tables (for PPC64). In order to reduce the size of the TOC,
+ we concatenate all jumptables and emit them at the end of the function. *)
+ mutable jumptables_lbl : label option; (* used only in power *)
+ mutable jumptables : label list; (* in reverse order *)
+
+ (* pending literals *)
+ mutable float_literals : float_literal list; (* in all except amd64,i386 *)
+ mutable int_literals : int_literal list; (* used only in s390x *)
+ mutable offset_literals : offset_computation list; (* used only in arm *)
+ mutable gotrel_literals : gotrel_literal list; (* used only in arm *)
+ mutable symbol_literals : symbol_literal list; (* used only in arm *)
+ (* [size_literals] is the total space (in words) occupied
+ by pending literals. *)
+ mutable size_literals : int; (* used only in arm *)
+}
(* Operations that affect the floating-point stack cannot be factored *)
| Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Iintoffloat | Ifloatofint
- | Iload((Single | Double | Double_u), _) -> Op_other
+ | Iload((Single | Double | Double_u), _, _) -> Op_other
(* Specific ops *)
| Ispecific(Ilea _) -> Op_pure
| Ispecific(Istore_int(_, _, is_asg)) -> Op_store is_asg
| "win32" -> 4 (* MSVC *)
| _ -> 16
(* PR#6038: GCC and Clang seem to require 16-byte alignment nowadays *)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+ | Ilea _ -> true
+ | _ -> false
+(* x87 floating-point operations are not pure because they push and pop
+ on the FP stack as a side effect *)
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false
open Mach
open Linear
open Emitaux
+open Emitenv
module String = Misc.Stdlib.String
open X86_ast
let emit_debug_info dbg =
emit_debug_info_gen dbg D.file D.loc
-(* Tradeoff between code size and code speed *)
-
-let fastcode_flag = ref true
-
-let stack_offset = ref 0
-
-(* Layout of the stack frame *)
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let frame_size () = (* includes return address *)
+let frame_size env = (* includes return address *)
let sz =
- !stack_offset + 4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 4
+ env.stack_offset
+ + 4 * env.f.fun_num_stack_slots.(0)
+ + 8 * env.f.fun_num_stack_slots.(1) + 4
in Misc.align sz stack_alignment
-let slot_offset loc cl =
+let slot_offset env loc cl =
match loc with
| Incoming n ->
assert (n >= 0);
- frame_size() + n
+ frame_size env + n
| Local n ->
if cl = 0
- then !stack_offset + n * 4
- else !stack_offset + num_stack_slots.(0) * 4 + n * 8
+ then env.stack_offset + n * 4
+ else env.stack_offset + env.f.fun_num_stack_slots.(0) * 4 + n * 8
| Outgoing n ->
assert (n >= 0);
n
let def_label s = D.label (emit_label s)
-let emit_Llabel fallthrough lbl =
- if not fallthrough && !fastcode_flag then D.align 16 ;
+let emit_Llabel env fallthrough lbl =
+ if not fallthrough && env.f.fun_fast then D.align 16 ;
def_label lbl
(* Output a pseudo-register *)
let load_domain_state r =
I.mov (sym32 "Caml_state") r
-let reg = function
+let reg env = function
| { loc = Reg r } -> register_name r
| { loc = Stack(Incoming n | Outgoing n) } when n < 0 ->
sym32 "caml_extra_params" ~ofs:(n + 64)
| { loc = Stack s; typ = Float } as r ->
- let ofs = slot_offset s (register_class r) in
+ let ofs = slot_offset env s (register_class r) in
mem32 REAL8 ofs RSP
| { loc = Stack s } as r ->
- let ofs = slot_offset s (register_class r) in
+ let ofs = slot_offset env s (register_class r) in
mem32 DWORD ofs RSP
| { loc = Unknown } ->
fatal_error "Emit_i386.reg"
(* Record live pointers at call points *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := ((r lsl 1) + 1) :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ())
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in
def_label lbl
-(* Record calls to the GC -- we've moved them out of the way *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame: label } (* Label of frame descriptor *)
-
-let call_gc_sites = ref ([] : gc_call list)
-
let emit_call_gc gc =
def_label gc.gc_lbl;
emit_call "caml_call_gc";
- def_label gc.gc_frame;
+ def_label gc.gc_frame_lbl;
I.jmp (label gc.gc_return_lbl)
-(* Record calls to caml_ml_array_bound_error.
- In -g mode, we maintain one call to caml_ml_array_bound_error
- per bound check site. Without -g, we can share a single call. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame: label } (* Label of frame descriptor *)
-
-let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_call = ref 0
-
-let bound_error_label dbg =
+let bound_error_label env dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
- { bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <-
+ { bd_lbl = lbl_bound_error; bd_frame = lbl_frame; }
+ :: env.bound_error_sites;
lbl_bound_error
end else begin
- if !bound_error_call = 0 then bound_error_call := new_label();
- !bound_error_call
+ match env.bound_error_call with
+ | None->
+ let lbl = new_label () in
+ env.bound_error_call <- Some lbl;
+ lbl
+ | Some lbl -> lbl
end
let emit_call_bound_error bd =
emit_call "caml_ml_array_bound_error";
def_label bd.bd_frame
-let emit_call_bound_errors () =
- List.iter emit_call_bound_error !bound_error_sites;
- if !bound_error_call > 0 then begin
- def_label !bound_error_call;
+let emit_call_bound_errors env =
+ List.iter emit_call_bound_error env.bound_error_sites;
+ match env.bound_error_call with
+ | Some lbl ->
+ def_label lbl;
emit_call "caml_ml_array_bound_error"
- end
+ | None -> ()
(* Names for instructions *)
(* Output an = 0 or <> 0 test. *)
-let output_test_zero arg =
+let output_test_zero env arg =
match arg.loc with
- | Reg.Reg _ -> I.test (reg arg) (reg arg)
- | _ -> I.cmp (int 0) (reg arg)
+ | Reg.Reg _ -> I.test (reg env arg) (reg env arg)
+ | _ -> I.cmp (int 0) (reg env arg)
(* Deallocate the stack frame before a return or tail call *)
-let output_epilogue f =
- let n = frame_size() - 4 in
+let output_epilogue env f =
+ let n = frame_size env - 4 in
if n > 0 then
begin
I.add (int n) esp;
(* Emit the code for a floating-point comparison *)
-let emit_float_test cmp arg lbl =
+let emit_float_test env cmp arg lbl =
let actual_cmp =
match (is_tos arg.(0), is_tos arg.(1)) with
| (true, true) ->
cmp
| (true, false) ->
(* first arg on top of FP stack *)
- I.fcomp (reg arg.(1));
+ I.fcomp (reg env arg.(1));
cmp
| (false, true) ->
(* second arg on top of FP stack *)
- I.fcomp (reg arg.(0));
+ I.fcomp (reg env arg.(0));
Cmm.swap_float_comparison cmp
| (false, false) ->
- I.fld (reg arg.(0));
- I.fcomp (reg arg.(1));
+ I.fld (reg env arg.(0));
+ I.fcomp (reg env arg.(1));
cmp
in
I.fnstsw ax;
else D.text ()
(* Output the assembly code for an instruction *)
-
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-
-let emit_instr fallthrough i =
+let emit_instr env fallthrough i =
+ let reg = reg env in
emit_debug_info i.dbg;
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() - 4 in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env - 4 in
if n > 0 then begin
I.sub (int n) esp;
cfi_adjust_cfa_offset n;
I.mov (immsym s) (reg i.res.(0))
| Lop(Icall_ind) ->
I.call (reg i.arg.(0));
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Icall_imm { func; }) ->
add_used_symbol func;
emit_call func;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Itailcall_ind) ->
- output_epilogue (fun () -> I.jmp (reg i.arg.(0)))
+ output_epilogue env (fun () -> I.jmp (reg i.arg.(0)))
| Lop(Itailcall_imm { func; }) ->
- if func = !function_name then
- I.jmp (label !tailrec_entry_point)
+ if func = env.f.fun_name then
+ I.jmp (label env.f.fun_tailrec_entry_point_label)
else begin
- output_epilogue begin fun () ->
+ output_epilogue env begin fun () ->
add_used_symbol func;
I.jmp (immsym func)
end
if alloc then begin
I.mov (immsym func) eax;
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
end else begin
emit_call func
end
then I.add (int (-n)) esp
else I.sub (int n) esp;
cfi_adjust_cfa_offset n;
- stack_offset := !stack_offset + n
- | Lop(Iload(chunk, addr)) ->
+ env.stack_offset <- env.stack_offset + n
+ | Lop(Iload(chunk, addr, _mut)) ->
let dest = i.res.(0) in
begin match chunk with
| Word_int | Word_val | Thirtytwo_signed | Thirtytwo_unsigned ->
I.fstp (addressing addr REAL8 i 1)
end
end
+ | Lop(Ipoll { return_label }) ->
+ begin match return_label with
+ None -> ()
+ | Some lbl -> I.jmp (label lbl)
+ end
| Lop(Ialloc { bytes = n; dbginfo }) ->
- if !fastcode_flag then begin
+ if env.f.fun_fast then begin
load_domain_state ebx;
I.mov (domain_field Domain_young_ptr RBX) eax;
I.sub (int n) eax;
I.cmp (domain_field Domain_young_limit RBX) eax;
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label
- i.live (Dbg_alloc dbginfo) in
+ record_frame_label env i.live (Dbg_alloc dbginfo) in
I.jb (label lbl_call_gc);
let lbl_after_alloc = new_label() in
def_label lbl_after_alloc;
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame = lbl_frame } :: !call_gc_sites
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites
end else begin
begin match n with
8 -> emit_call "caml_alloc1"
I.mov (int n) eax;
emit_call "caml_allocN"
end;
- let label =
- record_frame_label
- i.live (Dbg_alloc dbginfo)
- in
+ let label = record_frame_label env i.live (Dbg_alloc dbginfo) in
def_label label;
I.lea (mem32 NONE 4 RAX) (reg i.res.(0))
end
I.set (cond cmp) al;
I.movzx al (reg i.res.(0))
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.jbe (label lbl)
| Lop(Iintop_imm(Icheckbound, n)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
I.cmp (int n) (reg i.arg.(0));
I.jbe (label lbl)
| Lop(Iintop(Idiv | Imod)) ->
| Lop(Iintoffloat) ->
if not (is_tos i.arg.(0)) then
I.fld (reg i.arg.(0));
- stack_offset := !stack_offset - 8;
+ env.stack_offset <- env.stack_offset - 8;
I.sub (int 8) esp;
cfi_adjust_cfa_offset 8;
I.fnstcw (mem32 NONE 4 RSP);
I.fldcw (mem32 NONE 4 RSP);
I.add (int 8) esp;
cfi_adjust_cfa_offset (-8);
- stack_offset := !stack_offset + 8
+ env.stack_offset <- env.stack_offset + 8
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific(Ilea addr)) ->
I.lea (addressing addr DWORD i 0) (reg i.res.(0))
| Lop(Ispecific(Istore_int(n, addr, _))) ->
I.sub (int 8) esp;
cfi_adjust_cfa_offset 8;
I.fstp (mem32 REAL8 0 RSP);
- stack_offset := !stack_offset + 8
+ env.stack_offset <- env.stack_offset + 8
| {loc = Stack sl; typ = Float} ->
- let ofs = slot_offset sl 1 in
+ let ofs = slot_offset env sl 1 in
(* Use x87 stack to move from stack to stack,
instead of two 32-bit push instructions,
which could kill performance on modern CPUs (see #6979).
I.sub (int 8) esp;
cfi_adjust_cfa_offset 8;
I.fstp (mem32 REAL8 0 RSP);
- stack_offset := !stack_offset + 8
+ env.stack_offset <- env.stack_offset + 8
| _ ->
I.push (reg r);
cfi_adjust_cfa_offset 4;
- stack_offset := !stack_offset + 4
+ env.stack_offset <- env.stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
I.push (nat n);
cfi_adjust_cfa_offset 4;
- stack_offset := !stack_offset + 4
+ env.stack_offset <- env.stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
add_used_symbol s;
I.push (immsym s);
cfi_adjust_cfa_offset 4;
- stack_offset := !stack_offset + 4
+ env.stack_offset <- env.stack_offset + 4
| Lop(Ispecific(Ipush_load addr)) ->
I.push (addressing addr DWORD i 0);
cfi_adjust_cfa_offset 4;
- stack_offset := !stack_offset + 4
+ env.stack_offset <- env.stack_offset + 4
| Lop(Ispecific(Ipush_load_float addr)) ->
I.push (addressing (offset_addressing addr 4) DWORD i 0);
I.push (addressing addr DWORD i 0);
cfi_adjust_cfa_offset 8;
- stack_offset := !stack_offset + 8
+ env.stack_offset <- env.stack_offset + 8
| Lop(Ispecific(Ifloatarithmem(double, op, addr))) ->
if not (is_tos i.arg.(0)) then
I.fld (reg i.arg.(0));
if Array.length i.arg = 2 && is_tos i.arg.(1) then
I.fxch st1;
emit_floatspecial s
- | Lop (Iname_for_debugger _) -> ()
| Lreloadretaddr ->
()
| Lreturn ->
- output_epilogue begin fun () ->
+ output_epilogue env begin fun () ->
I.ret ()
end
| Llabel lbl ->
- emit_Llabel fallthrough lbl
+ emit_Llabel env fallthrough lbl
| Lbranch lbl ->
I.jmp (label lbl)
| Lcondbranch(tst, lbl) ->
let lbl = label lbl in
begin match tst with
| Itruetest ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.jne lbl;
| Ifalsetest ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.je lbl
| Iinttest cmp ->
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.j (cond cmp) lbl
| Iinttest_imm((Isigned Ceq | Isigned Cne |
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
- output_test_zero i.arg.(0);
+ output_test_zero env i.arg.(0);
I.j (cond cmp) lbl
| Iinttest_imm(cmp, n) ->
I.cmp (int n) (reg i.arg.(0));
I.j (cond cmp) lbl
| Ifloattest cmp ->
- emit_float_test cmp i.arg lbl
+ emit_float_test env cmp i.arg lbl
| Ioddtest ->
I.test (int 1) (reg i.arg.(0));
I.jne lbl
for i = 0 to Array.length jumptbl - 1 do
D.long (ConstLabel (emit_label jumptbl.(i)))
done;
- emit_named_text_section !function_name
+ emit_named_text_section env.f.fun_name
| Lentertrap ->
()
| Ladjust_trap_depth { delta_traps } ->
let delta = trap_frame_size * delta_traps in
cfi_adjust_cfa_offset delta;
- stack_offset := !stack_offset + delta
+ env.stack_offset <- env.stack_offset + delta
| Lpushtrap { lbl_handler; } ->
I.push (label lbl_handler);
if trap_frame_size > 8 then
I.push (domain_field Domain_exception_pointer RDX);
cfi_adjust_cfa_offset trap_frame_size;
I.mov esp (domain_field Domain_exception_pointer RDX);
- stack_offset := !stack_offset + trap_frame_size
+ env.stack_offset <- env.stack_offset + trap_frame_size
| Lpoptrap ->
I.mov edx (mem32 DWORD 4 RSP);
load_domain_state edx;
if trap_frame_size > 8 then
I.add (int (trap_frame_size - 8)) esp;
cfi_adjust_cfa_offset (-trap_frame_size);
- stack_offset := !stack_offset - trap_frame_size
+ env.stack_offset <- env.stack_offset - trap_frame_size
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
load_domain_state ebx;
I.mov (int 0) (domain_field Domain_backtrace_pos RBX);
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_notrace ->
load_domain_state ebx;
I.mov (domain_field Domain_exception_pointer RBX) esp;
I.jmp ebx
end
-let rec emit_all fallthrough i =
+let rec emit_all env fallthrough i =
match i.desc with
| Lend -> ()
| _ ->
- emit_instr fallthrough i;
- emit_all
+ emit_instr env fallthrough i;
+ emit_all env
(system = S_win32 || Linear.has_fallthrough i.desc)
i.next
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- fastcode_flag := fundecl.fun_fast;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- bound_error_call := 0;
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- emit_named_text_section !function_name;
+ let env = mk_env fundecl in
+ emit_named_text_section fundecl.fun_name;
add_def_symbol fundecl.fun_name;
D.align (if system = S_win32 then 4 else 16);
D.global (emit_symbol fundecl.fun_name);
D.label (emit_symbol fundecl.fun_name);
emit_debug_info fundecl.fun_dbg;
cfi_startproc ();
- emit_all true fundecl.fun_body;
- List.iter emit_call_gc !call_gc_sites;
- emit_call_bound_errors ();
+ emit_all env true fundecl.fun_body;
+ List.iter emit_call_gc env.call_gc_sites;
+ emit_call_bound_errors env;
cfi_endproc ();
begin match system with
| S_linux_elf | S_bsd_elf | S_gnu ->
Iintoffloat -> [| 6; max_int |]
| _ -> [|7; max_int |]
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
- | Ispecific(Ilea _) -> true
- | Ispecific _ -> false
- | _ -> true
-
(* Layout of the stack frame *)
let frame_required fd =
(* For floating-point operations and floating-point loads,
the result is always left at the top of the floating-point stack *)
| Iconst_float _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
- | Ifloatofint | Iload((Single | Double | Double_u), _)
+ | Ifloatofint | Iload((Single | Double | Double_u), _, _)
| Ispecific(Isubfrev | Idivfrev | Ifloatarithmem _ | Ifloatspecial _) ->
(arg, [| tos |], false) (* don't move it immediately *)
(* For storing a byte, the argument must be in eax...edx.
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f = (new selector)#emit_fundecl
+ ~future_funcnames f
| Iop(Imove | Ireload | Ispill)
when i.Mach.arg.(0).loc = i.Mach.res.(0).loc ->
linear i.Mach.next n
+ | Iop((Ipoll { return_label = None; _ }) as op) ->
+ (* If the poll call does not already specify where to jump to after
+ the poll (the expected situation in the current implementation),
+ absorb any branch after the poll call into the poll call itself.
+ This, in particular, optimises polls at the back edges of loops. *)
+ let n = linear i.Mach.next n in
+ let op, n =
+ match n.desc with
+ | Lbranch lbl ->
+ Mach.Ipoll { return_label = Some lbl }, n.next
+ | _ -> op, n
+ in
+ copy_instr (Lop op) i n
| Iop op ->
copy_instr (Lop op) i (linear i.Mach.next n)
| Ireturn ->
in linear i n
let add_prologue first_insn prologue_required =
- (* The prologue needs to come after any [Iname_for_debugger] operations that
- refer to parameters. (Such operations always come in a contiguous
- block, cf. [Selectgen].) *)
- let rec skip_naming_ops (insn : instruction) : label * instruction =
- match insn.desc with
- | Lop (Iname_for_debugger _) ->
- let tailrec_entry_point_label, next = skip_naming_ops insn.next in
- tailrec_entry_point_label, { insn with next; }
- | _ ->
- let tailrec_entry_point_label = Cmm.new_label () in
- let tailrec_entry_point =
- { desc = Llabel tailrec_entry_point_label;
- next = insn;
- arg = [| |];
- res = [| |];
- dbg = insn.dbg;
- live = insn.live;
- }
- in
- (* We expect [Lprologue] to expand to at least one instruction---as such,
- if no prologue is required, we avoid adding the instruction here.
- The reason is subtle: an empty expansion of [Lprologue] can cause
- two labels, one either side of the [Lprologue], to point at the same
- location. This means that we lose the property (cf. [Coalesce_labels])
- that we can check if two labels point at the same location by
- comparing them for equality. This causes trouble when the function
- whose prologue is in question lands at the top of the object file
- and we are emitting DWARF debugging information:
- foo_code_begin:
- foo:
- .L1:
- ; empty prologue
- .L2:
- ...
- If we were to emit a location list entry from L1...L2, not realising
- that they point at the same location, then the beginning and ending
- points of the range would be both equal to each other and (relative to
- "foo_code_begin") equal to zero. This appears to confuse objdump,
- which seemingly misinterprets the entry as an end-of-list entry
- (which is encoded with two zero words), then complaining about a
- "hole in location list" (as it ignores any remaining list entries
- after the misinterpreted entry). *)
- if prologue_required then
- let prologue =
- { desc = Lprologue;
- next = tailrec_entry_point;
- arg = [| |];
- res = [| |];
- dbg = tailrec_entry_point.dbg;
- live = Reg.Set.empty; (* will not be used *)
- }
- in
- tailrec_entry_point_label, prologue
- else
- tailrec_entry_point_label, tailrec_entry_point
+ let tailrec_entry_point_label = Cmm.new_label () in
+ let tailrec_entry_point =
+ { desc = Llabel tailrec_entry_point_label;
+ next = first_insn;
+ arg = [| |];
+ res = [| |];
+ dbg = first_insn.dbg;
+ live = first_insn.live;
+ }
in
- skip_naming_ops first_insn
+ (* We expect [Lprologue] to expand to at least one instruction---as such,
+ if no prologue is required, we avoid adding the instruction here.
+ The reason is subtle: an empty expansion of [Lprologue] can cause
+ two labels, one either side of the [Lprologue], to point at the same
+ location. This means that we lose the property (cf. [Coalesce_labels])
+ that we can check if two labels point at the same location by
+ comparing them for equality. This causes trouble when the function
+ whose prologue is in question lands at the top of the object file
+ and we are emitting DWARF debugging information:
+ foo_code_begin:
+ foo:
+ .L1:
+ ; empty prologue
+ .L2:
+ ...
+ If we were to emit a location list entry from L1...L2, not realising
+ that they point at the same location, then the beginning and ending
+ points of the range would be both equal to each other and (relative to
+ "foo_code_begin") equal to zero. This appears to confuse objdump,
+ which seemingly misinterprets the entry as an end-of-list entry
+ (which is encoded with two zero words), then complaining about a
+ "hole in location list" (as it ignores any remaining list entries
+ after the misinterpreted entry). *)
+ if prologue_required then
+ let prologue =
+ { desc = Lprologue;
+ next = tailrec_entry_point;
+ arg = [| |];
+ res = [| |];
+ dbg = tailrec_entry_point.dbg;
+ live = Reg.Set.empty; (* will not be used *)
+ }
+ in
+ tailrec_entry_point_label, prologue
+ else
+ tailrec_entry_point_label, tailrec_entry_point
let fundecl f =
let fun_prologue_required = Proc.prologue_required f in
open Mach
-let live_at_exit = ref []
+module Domain = struct
+ type t = Reg.Set.t
+ let bot = Reg.Set.empty
+ let join = Reg.Set.union
+ let lessequal = Reg.Set.subset
+end
-let find_live_at_exit k =
- try
- List.assoc k !live_at_exit
- with
- | Not_found -> Misc.fatal_error "Liveness.find_live_at_exit"
+module Analyzer = Dataflow.Backward(Domain)
-let live_at_raise = ref Reg.Set.empty
-
-let rec live i finally =
- (* finally is the set of registers live after execution of the
- instruction sequence.
- The result of the function is the set of registers live just
- before the instruction sequence.
- The instruction i is annotated by the set of registers live across
- the instruction. *)
+let transfer i ~next ~exn =
match i.desc with
- Iend ->
- i.live <- finally;
- finally
| Ireturn | Iop(Itailcall_ind) | Iop(Itailcall_imm _) ->
i.live <- Reg.Set.empty; (* no regs are live across *)
Reg.set_of_array i.arg
| Iop op ->
- let after = live i.next finally in
- if Proc.op_is_pure op (* no side effects *)
- && Reg.disjoint_set_array after i.res (* results are not used after *)
- && not (Proc.regs_are_volatile i.arg) (* no stack-like hard reg *)
- && not (Proc.regs_are_volatile i.res) (* is involved *)
+ if operation_is_pure op (* no side effects *)
+ && Reg.disjoint_set_array next i.res (* results are not used after *)
+ && not (Proc.regs_are_volatile i.arg) (* no stack-like hard reg *)
+ && not (Proc.regs_are_volatile i.res) (* is involved *)
then begin
(* This operation is dead code. Ignore its arguments. *)
- i.live <- after;
- after
+ i.live <- next;
+ next
end else begin
- let across_after = Reg.diff_set_array after i.res in
+ let across1 = Reg.diff_set_array next i.res in
let across =
- match op with
- | Icall_ind | Icall_imm _ | Iextcall _ | Ialloc _
- | Iintop (Icheckbound) | Iintop_imm(Icheckbound, _) ->
- (* The function call may raise an exception, branching to the
- nearest enclosing try ... with. Similarly for bounds checks
- and allocation (for the latter: finalizers may throw
- exceptions, as may signal handlers).
- Hence, everything that must be live at the beginning of
- the exception handler must also be live across this instr. *)
- Reg.Set.union across_after !live_at_raise
- | _ ->
- across_after in
+ (* Operations that can raise an exception (function calls,
+ bounds checks, allocations) can branch to the
+ nearest enclosing try ... with.
+ Hence, everything that must be live at the beginning of
+ the exception handler must also be live across this instr. *)
+ if operation_can_raise op
+ then Reg.Set.union across1 exn
+ else across1 in
i.live <- across;
Reg.add_set_array across i.arg
end
- | Iifthenelse(_test, ifso, ifnot) ->
- let at_join = live i.next finally in
- let at_fork = Reg.Set.union (live ifso at_join) (live ifnot at_join) in
- i.live <- at_fork;
- Reg.add_set_array at_fork i.arg
- | Iswitch(_index, cases) ->
- let at_join = live i.next finally in
- let at_fork = ref Reg.Set.empty in
- for i = 0 to Array.length cases - 1 do
- at_fork := Reg.Set.union !at_fork (live cases.(i) at_join)
- done;
- i.live <- !at_fork;
- Reg.add_set_array !at_fork i.arg
- | Icatch(rec_flag, handlers, body) ->
- let at_join = live i.next finally in
- let aux (nfail,handler) (nfail', before_handler) =
- assert(nfail = nfail');
- let before_handler' = live handler at_join in
- nfail, Reg.Set.union before_handler before_handler'
- in
- let aux_equal (nfail, before_handler) (nfail', before_handler') =
- assert(nfail = nfail');
- Reg.Set.equal before_handler before_handler'
- in
- let live_at_exit_before = !live_at_exit in
- let rec fixpoint before_handlers =
- live_at_exit := before_handlers @ !live_at_exit;
- let before_handlers' = List.map2 aux handlers before_handlers in
- live_at_exit := live_at_exit_before;
- match rec_flag with
- | Cmm.Nonrecursive ->
- before_handlers'
- | Cmm.Recursive ->
- if List.for_all2 aux_equal before_handlers before_handlers'
- then before_handlers'
- else fixpoint before_handlers'
- in
- let init_state =
- List.map (fun (nfail, _handler) -> nfail, Reg.Set.empty) handlers
- in
- let before_handler = fixpoint init_state in
- (* We could use handler.live instead of Reg.Set.empty as the initial
- value but we would need to clean the live field before doing the
- analysis (to remove remnants of previous passes). *)
- live_at_exit := before_handler @ !live_at_exit;
- let before_body = live body at_join in
- live_at_exit := live_at_exit_before;
- i.live <- before_body;
- before_body
- | Iexit nfail ->
- let this_live = find_live_at_exit nfail in
- i.live <- this_live ;
- this_live
- | Itrywith(body, handler) ->
- let at_join = live i.next finally in
- let before_handler = live handler at_join in
- let saved_live_at_raise = !live_at_raise in
- live_at_raise := Reg.Set.remove Proc.loc_exn_bucket before_handler;
- let before_body = live body at_join in
- live_at_raise := saved_live_at_raise;
- i.live <- before_body;
- before_body
+ | Iifthenelse _
+ | Iswitch _ ->
+ i.live <- next;
+ Reg.add_set_array next i.arg
+ | Iend | Icatch _ | Iexit _ | Itrywith _ ->
+ i.live <- next;
+ next
| Iraise _ ->
- i.live <- !live_at_raise;
- Reg.add_set_array !live_at_raise i.arg
+ i.live <- exn;
+ Reg.add_set_array exn i.arg
-let reset () =
- live_at_raise := Reg.Set.empty;
- live_at_exit := []
+let exnhandler before_handler =
+ Reg.Set.remove Proc.loc_exn_bucket before_handler
let fundecl f =
- let initially_live = live f.fun_body Reg.Set.empty in
+ let (initially_live, _) =
+ Analyzer.analyze ~exnhandler ~transfer f.fun_body in
(* Sanity check: only function parameters can be live at entrypoint *)
let wrong_live = Reg.Set.diff initially_live (Reg.set_of_array f.fun_args) in
if not (Reg.Set.is_empty wrong_live) then begin
(* Liveness analysis.
Annotate mach code with the set of regs live at each point. *)
-val reset : unit -> unit
val fundecl: Mach.fundecl -> unit
ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
alloc : bool; }
| Istackoffset of int
- | Iload of Cmm.memory_chunk * Arch.addressing_mode
+ | Iload of Cmm.memory_chunk * Arch.addressing_mode * Asttypes.mutable_flag
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
| Ialloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo; }
| Iintop of integer_operation
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Ifloatofint | Iintoffloat
+ | Iopaque
| Ispecific of Arch.specific_operation
- | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
- provenance : unit option; is_assignment : bool; }
+ | Ipoll of { return_label: Cmm.label option }
type instruction =
{ desc: instruction_desc;
arg: Reg.t array;
res: Reg.t array;
dbg: Debuginfo.t;
- mutable live: Reg.Set.t;
- mutable available_before: Reg_availability_set.t;
- mutable available_across: Reg_availability_set.t option;
+ mutable live: Reg.Set.t
}
and instruction_desc =
arg = [||];
res = [||];
dbg = Debuginfo.none;
- live = Reg.Set.empty;
- available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
- available_across = None;
+ live = Reg.Set.empty
}
let end_instr () =
arg = [||];
res = [||];
dbg = Debuginfo.none;
- live = Reg.Set.empty;
- available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
- available_across = None;
+ live = Reg.Set.empty
}
let instr_cons d a r n =
{ desc = d; next = n; arg = a; res = r;
- dbg = Debuginfo.none; live = Reg.Set.empty;
- available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
- available_across = None;
+ dbg = Debuginfo.none; live = Reg.Set.empty
}
let instr_cons_debug d a r dbg n =
- { desc = d; next = n; arg = a; res = r; dbg = dbg; live = Reg.Set.empty;
- available_before = Reg_availability_set.Ok Reg_with_debug_info.Set.empty;
- available_across = None;
- }
+ { desc = d; next = n; arg = a; res = r; dbg = dbg; live = Reg.Set.empty }
let rec instr_iter f i =
match i.desc with
| _ ->
instr_iter f i.next
+let operation_is_pure = function
+ | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ | Ipoll _
+ | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) | Iopaque -> false
+ | Ispecific sop -> Arch.operation_is_pure sop
+ | _ -> true
+
let operation_can_raise op =
match op with
| Icall_ind | Icall_imm _ | Iextcall _
| Iintop (Icheckbound) | Iintop_imm (Icheckbound, _)
- | Ialloc _ -> true
+ | Ialloc _ | Ipoll _ -> true
+ | Ispecific sop -> Arch.operation_can_raise sop
| _ -> false
ty_res : Cmm.machtype; ty_args : Cmm.exttype list;
alloc : bool; }
| Istackoffset of int
- | Iload of Cmm.memory_chunk * Arch.addressing_mode
+ | Iload of Cmm.memory_chunk * Arch.addressing_mode * Asttypes.mutable_flag
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
(* false = initialization, true = assignment *)
| Ialloc of { bytes : int; dbginfo : Debuginfo.alloc_dbginfo; }
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
| Ifloatofint | Iintoffloat
+ | Iopaque
| Ispecific of Arch.specific_operation
- | Iname_for_debugger of { ident : Backend_var.t; which_parameter : int option;
- provenance : unit option; is_assignment : bool; }
- (** [Iname_for_debugger] has the following semantics:
- (a) The argument register(s) is/are deemed to contain the value of the
- given identifier.
- (b) If [is_assignment] is [true], any information about other [Reg.t]s
- that have been previously deemed to hold the value of that
- identifier is forgotten. *)
+ | Ipoll of { return_label: Cmm.label option }
type instruction =
{ desc: instruction_desc;
arg: Reg.t array;
res: Reg.t array;
dbg: Debuginfo.t;
- mutable live: Reg.Set.t;
- mutable available_before: Reg_availability_set.t;
- mutable available_across: Reg_availability_set.t option;
+ mutable live: Reg.Set.t
}
and instruction_desc =
instruction -> instruction
val instr_iter: (instruction -> unit) -> instruction -> unit
+val operation_is_pure : operation -> bool
+ (** Returns [true] if the given operation only produces a result
+ in its destination registers, but has no side effects whatsoever:
+ it doesn't raise exceptions, it doesn't modify already-allocated
+ blocks, it doesn't adjust the stack frame, etc. *)
+
val operation_can_raise : operation -> bool
+ (** Returns [true] if the given operation can raise an exception. *)
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Damien Doligez, projet Cambium, INRIA Paris *)
+(* Sadiq Jaffer, OCaml Labs Consultancy Ltd *)
+(* Stephen Dolan and Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 OCaml Labs Consultancy Ltd *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Mach
+
+module Int = Numbers.Int
+module String = Misc.Stdlib.String
+
+let function_is_assumed_to_never_poll func =
+ String.starts_with ~prefix:"caml_apply" func
+ || String.starts_with ~prefix:"caml_send" func
+
+(* Detection of recursive handlers that are not guaranteed to poll
+ at every loop iteration. *)
+
+(* We use a backwards dataflow analysis to compute a mapping from handlers H
+ (= loop heads) to either "safe" or "unsafe".
+
+ H is "safe" if every path starting from H goes through an Ialloc,
+ Ipoll, Ireturn, Itailcall_ind or Itailcall_imm instruction.
+
+ H is "unsafe", therefore, if starting from H we can loop infinitely
+ without crossing an Ialloc or Ipoll instruction.
+*)
+
+type unsafe_or_safe = Unsafe | Safe
+
+module Unsafe_or_safe = struct
+ type t = unsafe_or_safe
+
+ let bot = Unsafe
+
+ let join t1 t2 =
+ match t1, t2 with
+ | Unsafe, Unsafe
+ | Unsafe, Safe
+ | Safe, Unsafe -> Unsafe
+ | Safe, Safe -> Safe
+
+ let lessequal t1 t2 =
+ match t1, t2 with
+ | Unsafe, Unsafe
+ | Unsafe, Safe
+ | Safe, Safe -> true
+ | Safe, Unsafe -> false
+end
+
+module PolledLoopsAnalysis = Dataflow.Backward(Unsafe_or_safe)
+
+let polled_loops_analysis funbody =
+ let transfer i ~next ~exn =
+ match i.desc with
+ | Iend -> next
+ | Iop (Ialloc _ | Ipoll _)
+ | Iop (Itailcall_ind | Itailcall_imm _) -> Safe
+ | Iop op ->
+ if operation_can_raise op
+ then Unsafe_or_safe.join next exn
+ else next
+ | Ireturn -> Safe
+ | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ | Itrywith _ -> next
+ | Iraise _ -> exn
+ in
+ (* [exnescape] is [Safe] because we can't loop infinitely having
+ returned from the function via an unhandled exception. *)
+ snd (PolledLoopsAnalysis.analyze ~exnescape:Safe ~transfer funbody)
+
+(* Detection of functions that can loop via a tail-call without going
+ through a poll point. *)
+
+(* We use a backwards dataflow analysis to compute a single value: either
+ "Might_not_poll" or "Always_polls".
+
+ "Might_not_poll" means there exists a path from the function entry to a
+ Potentially Recursive Tail Call (an Itailcall_ind or
+ Itailcall_imm to a forward function)
+ that does not go through an Ialloc or Ipoll instruction.
+
+ "Always_polls", therefore, means the function always polls (via Ialloc or
+ Ipoll) before doing a PRTC. This includes the case where it does not
+ perform any PRTC.
+
+ A note on Potentially Recursive Tail Calls
+ ------------------------------------------
+
+ Tail calls can create infinite loops, of course. (Consider a function
+ that tail-calls itself.) But not all tail calls need to be flagged
+ as potential infinite loops.
+
+ We optimise by making a partial ordering over Mach functions: in
+ definition order within a compilation unit, and dependency
+ order between compilation units. This order is acyclic, as
+ OCaml does not allow circular dependencies between modules.
+ It's also finite, so if there's an infinite sequence of
+ function calls then something has to make a forward reference.
+
+ Also, in such an infinite sequence of function calls, at most finitely
+ many of them can be non-tail calls. (If there are infinitely many
+ non-tail calls, then the program soon terminates with a stack
+ overflow).
+
+ So, every such infinite sequence must contain many forward-referencing
+ tail calls. These tail calls are the Potentially Recursive Tail Calls
+ (PTRCs). Polling only on those calls suffices.
+
+ Several functions below take a parameter [future_funcnames]
+ which is the set of functions defined "after" the current function
+ in the current compilation unit. The PTRCs are tail calls
+ to known functions in [future_funcnames], or tail calls to
+ unknown functions.
+*)
+
+type polls_before_prtc = Might_not_poll | Always_polls
+
+module Polls_before_prtc = struct
+ type t = polls_before_prtc
+
+ let bot = Always_polls
+
+ let join t1 t2 =
+ match t1, t2 with
+ | Might_not_poll, Might_not_poll
+ | Might_not_poll, Always_polls
+ | Always_polls, Might_not_poll -> Might_not_poll
+ | Always_polls, Always_polls -> Always_polls
+
+ let lessequal t1 t2 =
+ match t1, t2 with
+ | Always_polls, Always_polls
+ | Always_polls, Might_not_poll
+ | Might_not_poll, Might_not_poll -> true
+ | Might_not_poll, Always_polls -> false
+end
+
+module PTRCAnalysis = Dataflow.Backward(Polls_before_prtc)
+
+let potentially_recursive_tailcall ~future_funcnames funbody =
+ let transfer i ~next ~exn =
+ match i.desc with
+ | Iend -> next
+ | Iop (Ialloc _ | Ipoll _) -> Always_polls
+ | Iop (Itailcall_ind) -> Might_not_poll (* this is a PTRC *)
+ | Iop (Itailcall_imm { func }) ->
+ if String.Set.mem func future_funcnames
+ || function_is_assumed_to_never_poll func
+ then Might_not_poll (* this is a PTRC *)
+ else Always_polls (* this is not a PTRC *)
+ | Iop op ->
+ if operation_can_raise op
+ then Polls_before_prtc.join next exn
+ else next
+ | Ireturn -> Always_polls
+ | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ | Itrywith _ -> next
+ | Iraise _ -> exn
+ in
+ fst (PTRCAnalysis.analyze ~transfer funbody)
+
+(* We refer to the set of recursive handler labels that need extra polling
+ as the "unguarded back edges" ("ube").
+
+ Given the result of the analysis of recursive handlers, add [Ipoll]
+ instructions at the [Iexit] instructions before unguarded back edges,
+ thus ensuring that every loop contains a poll point. Also compute whether
+ the resulting function contains any [Ipoll] instructions.
+*)
+
+let contains_polls = ref false
+
+let add_poll i =
+ contains_polls := true;
+ Mach.instr_cons (Iop (Ipoll { return_label = None })) [||] [||] i
+
+let instr_body handler_safe i =
+ let add_unsafe_handler ube (k, _) =
+ match handler_safe k with
+ | Safe -> ube
+ | Unsafe -> Int.Set.add k ube
+ in
+ let rec instr ube i =
+ match i.desc with
+ | Iifthenelse (test, i0, i1) ->
+ { i with
+ desc = Iifthenelse (test, instr ube i0, instr ube i1);
+ next = instr ube i.next;
+ }
+ | Iswitch (index, cases) ->
+ { i with
+ desc = Iswitch (index, Array.map (instr ube) cases);
+ next = instr ube i.next;
+ }
+ | Icatch (rc, hdl, body) ->
+ let ube' =
+ match rc with
+ | Cmm.Recursive -> List.fold_left add_unsafe_handler ube hdl
+ | Cmm.Nonrecursive -> ube in
+ let instr_handler (k, i0) =
+ let i1 = instr ube' i0 in
+ (k, i1) in
+ (* Since we are only interested in unguarded _back_ edges, we don't
+ use [ube'] for instrumenting [body], but just [ube] instead. *)
+ let body = instr ube body in
+ { i with
+ desc = Icatch (rc,
+ List.map instr_handler hdl,
+ body);
+ next = instr ube i.next;
+ }
+ | Iexit k ->
+ if Int.Set.mem k ube
+ then add_poll i
+ else i
+ | Itrywith (body, hdl) ->
+ { i with
+ desc = Itrywith (instr ube body, instr ube hdl);
+ next = instr ube i.next;
+ }
+ | Iend | Ireturn | Iraise _ -> i
+ | Iop op ->
+ begin match op with
+ | Ipoll _ -> contains_polls := true
+ | _ -> ()
+ end;
+ { i with next = instr ube i.next }
+ in
+ instr Int.Set.empty i
+
+let instrument_fundecl ~future_funcnames:_ (f : Mach.fundecl) : Mach.fundecl =
+ if function_is_assumed_to_never_poll f.fun_name then f
+ else begin
+ let handler_needs_poll = polled_loops_analysis f.fun_body in
+ contains_polls := false;
+ let new_body = instr_body handler_needs_poll f.fun_body in
+ let new_contains_calls = f.fun_contains_calls || !contains_polls in
+ { f with fun_body = new_body; fun_contains_calls = new_contains_calls }
+ end
+
+let requires_prologue_poll ~future_funcnames ~fun_name i =
+ if function_is_assumed_to_never_poll fun_name then false
+ else
+ match potentially_recursive_tailcall ~future_funcnames i with
+ | Might_not_poll -> true
+ | Always_polls -> false
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy and Damien Doligez, projet Cambium, INRIA Paris *)
+(* Sadiq Jaffer, OCaml Labs Consultancy Ltd *)
+(* Stephen Dolan and Mark Shinwell, Jane Street Europe *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 OCaml Labs Consultancy Ltd *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Analyses related to the insertion of [Ipoll] operations. *)
+
+val instrument_fundecl : future_funcnames:Misc.Stdlib.String.Set.t
+ -> Mach.fundecl -> Mach.fundecl
+
+val requires_prologue_poll : future_funcnames:Misc.Stdlib.String.Set.t
+ -> fun_name:string -> Mach.instruction -> bool
method! class_of_operation op =
match op with
| Ispecific(Imultaddf | Imultsubf) -> Op_pure
- | Ispecific(Ialloc_far _) -> Op_other
+ | Ispecific(Ialloc_far _) | Ispecific(Ipoll_far _) -> Op_other
| _ -> super#class_of_operation op
method! is_cheap_operation op =
| "ppc64le" -> ELF64v2
| _ -> assert false
+type cmm_label = int
+(* Do not introduce a dependency to Cmm *)
+
(* Machine-specific command-line options *)
let big_toc = ref true
| Imultsubf (* multiply and subtract *)
| Ialloc_far of (* allocation in large functions *)
{ bytes : int; dbginfo : Debuginfo.alloc_dbginfo }
+ | Ipoll_far of { return_label : cmm_label option }
(* Addressing modes *)
printreg arg.(0) printreg arg.(1) printreg arg.(2)
| Ialloc_far { bytes; _ } ->
fprintf ppf "alloc_far %d" bytes
+ | Ipoll_far _ ->
+ fprintf ppf "poll_far"
+
+(* Specific operations that are pure *)
+
+let operation_is_pure = function
+ | Ialloc_far _ | Ipoll_far _ -> false
+ | _ -> true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise = function
+ | Ialloc_far _ | Ipoll_far _ -> true
+ | _ -> false
open Mach
open Linear
open Emitaux
+open Emitenv
(* Reserved space at bottom of stack *)
(* Layout of the stack. The stack is kept 16-aligned. *)
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let contains_calls = ref false
-
-let initial_stack_offset () =
+let initial_stack_offset f =
reserved_stack_space +
- size_int * num_stack_slots.(0) + (* Local int variables *)
- size_float * num_stack_slots.(1) + (* Local float variables *)
- (if !contains_calls && abi = ELF32 then size_int else 0)
+ size_int * f.fun_num_stack_slots.(0) + (* Local int variables *)
+ size_float * f.fun_num_stack_slots.(1) + (* Local float variables *)
+ (if f.fun_contains_calls && abi = ELF32 then size_int else 0)
(* The return address *)
-let frame_size () =
+let frame_size env =
let size =
- !stack_offset + (* Trap frame, outgoing parameters *)
- initial_stack_offset () in
+ env.stack_offset + (* Trap frame, outgoing parameters *)
+ initial_stack_offset env.f in
Misc.align size 16
-let slot_offset loc cls =
+let slot_offset env loc cls =
match loc with
Local n ->
- reserved_stack_space + !stack_offset +
- (if cls = 0 then num_stack_slots.(1) * size_float + n * size_int
+ reserved_stack_space + env.stack_offset +
+ (if cls = 0 then env.f.fun_num_stack_slots.(1) * size_float + n * size_int
else n * size_float)
- | Incoming n -> frame_size() + reserved_stack_space + n
+ | Incoming n ->
+ (* Callee's [reserved_stack_space] is included in [frame_size].
+ To access incoming arguments, add caller's [reserverd_stack_space]. *)
+ frame_size env + reserved_stack_space + n
| Outgoing n -> reserved_stack_space + n
-let retaddr_offset () =
+let retaddr_offset env =
match abi with
- | ELF32 -> frame_size() - size_addr
- | ELF64v1 | ELF64v2 -> frame_size() + 16
+ | ELF32 -> frame_size env - size_addr
+ | ELF64v1 | ELF64v2 -> frame_size env + 16
-let toc_save_offset () =
+let toc_save_offset env =
match abi with
| ELF32 -> assert false
- | ELF64v1 | ELF64v2 -> frame_size() + 8
+ | ELF64v1 | ELF64v2 -> frame_size env + 8
let (trap_size, trap_handler_offset, trap_previous_offset) =
match abi with
(* Output a stack reference *)
-let emit_stack r =
+let emit_stack env r =
match r.loc with
| Stack s ->
- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(1)`
+ let ofs = slot_offset env s (register_class r) in `{emit_int ofs}(1)`
| _ -> Misc.fatal_error "Emit.emit_stack"
(* Output the name of a symbol plus an optional offset *)
let (lo, hi) = low_high_s d in
if hi <> 0 then
` addis 11, 11, {emit_int hi}\n`;
- ` {emit_string instr} {emit_reg arg}, {emit_int lo}(11)\n`
+ if valid_offset instr lo then
+ ` {emit_string instr} {emit_reg arg}, {emit_int lo}(11)\n`
+ else begin
+ ` li 0, {emit_int lo}\n`;
+ ` {emit_string instr}x {emit_reg arg}, 11, 0\n`
+ end
end
| Iindexed ofs ->
if is_immediate ofs && valid_offset instr ofs then
(* Free the stack frame *)
-let emit_free_frame () =
- let n = frame_size() in
+let emit_free_frame env =
+ let n = frame_size env in
if n > 0 then
` addi 1, 1, {emit_int n}\n`
(* Reload the TOC register r2 from the value saved on the stack *)
-let emit_reload_toc () =
- ` ld 2, {emit_int (toc_save_offset())}(1)\n`
+let emit_reload_toc env =
+ ` ld 2, {emit_int (toc_save_offset env)}(1)\n`
(* Adjust stack_offset and emit corresponding CFI directive *)
-let adjust_stack_offset delta =
- stack_offset := !stack_offset + delta;
+let adjust_stack_offset env delta =
+ env.stack_offset <- env.stack_offset + delta;
cfi_adjust_cfa_offset delta
(* Record live pointers at call points *)
-let record_frame live dbg =
+let record_frame env live dbg =
let lbl = new_label() in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := ((r lsl 1) + 1) :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ())
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
`{emit_label lbl}:\n`
-(* Record floating-point literals (for PPC32) *)
-
-let float_literals = ref ([] : (int64 * int) list)
-
-(* Record jump tables (for PPC64). In order to reduce the size of the TOC,
- we concatenate all jumptables and emit them at the end of the compilation
- unit. *)
-
-let jumptables = ref ([] : label list) (* in reverse order *)
-let jumptables_lbl = ref (-1)
-
(* Names for conditional branches after comparisons *)
let branch_for_comparison = function
| Imultsubf -> "fmsub"
| _ -> Misc.fatal_error "Emit.Ispecific"
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-(* Label of glue code for calling the GC *)
-let call_gc_label = ref 0
-
(* Relaxation of branches that exceed the span of a relative branch. *)
module BR = Branch_relaxation.Make (struct
let classify_instr = function
| Lop (Ialloc _)
+ | Lop (Ipoll _)
(* [Ialloc_far] does not need to be here, since its code sequence
never involves any conditional branches that might need relaxing. *)
| Lcondbranch _
| ELF32 -> 5
| ELF64v1 | ELF64v2 -> 6
- let prologue_size () =
+ let prologue_size f =
profiling_prologue_size ()
- + (if initial_stack_offset () > 0 then 1 else 0)
- + (if !contains_calls then
+ + (if initial_stack_offset f > 0 then 1 else 0)
+ + (if f.fun_contains_calls then
2 +
match abi with
| ELF32 -> 0
| Iindexed ofs -> if is_immediate ofs then 1 else 3
| Iindexed2 -> 1
- let instr_size = function
+ let instr_size f = function
| Lend -> 0
- | Lprologue -> prologue_size ()
+ | Lprologue -> prologue_size f
| Lop(Imove | Ispill | Ireload) -> 1
| Lop(Iconst_int n) ->
if is_native_immediate n then 1
| Lop(Icall_imm _) -> size 1 3 3
| Lop(Itailcall_ind) -> size 5 7 6
| Lop(Itailcall_imm { func; _ }) ->
- if func = !function_name
+ if func = f.fun_name
then 1
else size 4 (7 + tocload_size()) (6 + tocload_size())
| Lop(Iextcall { alloc = true; _ }) ->
size 3 (2 + tocload_size()) (2 + tocload_size())
| Lop(Iextcall { alloc = false; _}) -> size 1 2 2
| Lop(Istackoffset _) -> 1
- | Lop(Iload(chunk, addr)) ->
+ | Lop(Iload(chunk, addr, _mut)) ->
if chunk = Byte_signed
then load_store_size addr + 1
else load_store_size addr
| Lop(Istore(_chunk, addr, _)) -> load_store_size addr
- | Lop(Ialloc _) -> 4
- | Lop(Ispecific(Ialloc_far _)) -> 5
+ | Lop(Ialloc _) -> 5
+ | Lop(Ispecific(Ialloc_far _)) -> 6
+ | Lop(Ipoll { return_label = Some(_) }) -> 5
+ | Lop(Ipoll { return_label = None }) -> 3
+ | Lop(Ispecific(Ipoll_far { return_label = Some(_) } )) -> 5
+ | Lop(Ispecific(Ipoll_far { return_label = None } )) -> 4
| Lop(Iintop Imod) -> 3
| Lop(Iintop(Icomp _)) -> 4
| Lop(Iintop _) -> 1
| Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1
| Lop(Ifloatofint) -> 9
| Lop(Iintoffloat) -> 4
+ | Lop(Iopaque) -> 0
| Lop(Ispecific _) -> 1
- | Lop (Iname_for_debugger _) -> 0
| Lreloadretaddr -> 2
| Lreturn -> 2
| Llabel _ -> 0
let relax_allocation ~num_bytes:bytes ~dbginfo =
Lop (Ispecific (Ialloc_far { bytes; dbginfo }))
+ let relax_poll ~return_label =
+ Lop (Ispecific (Ipoll_far { return_label }))
+
(* [classify_addr], above, never identifies these instructions as needing
relaxing. As such, these functions should never be called. *)
let relax_specific_op _ = assert false
let relax_intop_imm_checkbound ~bound:_ = assert false
end)
+(* Assembly code for inlined allocation *)
+
+let emit_alloc env i bytes dbginfo far =
+ if env.call_gc_label = 0 then env.call_gc_label <- new_label ();
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` {emit_string lg} 0, {emit_int offset}(30)\n`;
+ ` addi 31, 31, {emit_int(-bytes)}\n`;
+ ` {emit_string cmplg} 31, 0\n`;
+ if not far then begin
+ ` bltl {emit_label env.call_gc_label}\n`;
+ record_frame env i.live (Dbg_alloc dbginfo);
+ ` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+ end else begin
+ let lbl = new_label() in
+ ` bge {emit_label lbl}\n`;
+ ` bl {emit_label env.call_gc_label}\n`;
+ record_frame env i.live (Dbg_alloc dbginfo);
+ `{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+ end
+
+let emit_poll env i return_label far =
+ if env.call_gc_label = 0 then env.call_gc_label <- new_label ();
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` {emit_string lg} 0, {emit_int offset}(30)\n`;
+ ` {emit_string cmplg} 31, 0\n`;
+ if not far then begin
+ begin match return_label with
+ | None ->
+ begin
+ ` bltl {emit_label env.call_gc_label}\n`;
+ record_frame env i.live (Dbg_alloc [])
+ end
+ | Some return_label ->
+ begin
+ ` bltl {emit_label env.call_gc_label}\n`;
+ record_frame env i.live (Dbg_alloc []);
+ ` b {emit_label return_label}\n`
+ end
+ end;
+ end else begin
+ let lbl = new_label () in
+ ` bge {emit_label lbl}\n`;
+ ` bl {emit_label env.call_gc_label}\n`;
+ record_frame env i.live (Dbg_alloc []);
+ ` {emit_label lbl}: \n`;
+ match return_label with
+ | None -> ()
+ | Some return_label -> ` b {emit_label return_label}\n`
+ end
+
(* Output the assembly code for an instruction *)
-let emit_instr i =
+let emit_instr env i =
emit_debug_info i.dbg;
match i.desc with
| Lend -> ()
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env in
if n > 0 then begin
` addi 1, 1, {emit_int(-n)}\n`;
cfi_adjust_cfa_offset n
end;
- if !contains_calls then begin
- let ra = retaddr_offset() in
+ if env.f.fun_contains_calls then begin
+ let ra = retaddr_offset env in
` mflr 0\n`;
` {emit_string stg} 0, {emit_int ra}(1)\n`;
cfi_offset ~reg: 65 (* LR *) ~offset: (ra - n);
match abi with
| ELF32 -> ()
| ELF64v1 | ELF64v2 ->
- ` std 2, {emit_int(toc_save_offset())}(1)\n`
+ ` std 2, {emit_int(toc_save_offset env)}(1)\n`
end
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
` fmr {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
- ` {emit_string stg} {emit_reg src}, {emit_stack dst}\n`
+ ` {emit_string stg} {emit_reg src}, {emit_stack env dst}\n`
| {loc = Reg _; typ = Float}, {loc = Stack _} ->
- ` stfd {emit_reg src}, {emit_stack dst}\n`
+ ` stfd {emit_reg src}, {emit_stack env dst}\n`
| {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
- ` {emit_string lg} {emit_reg dst}, {emit_stack src}\n`
+ ` {emit_string lg} {emit_reg dst}, {emit_stack env src}\n`
| {loc = Stack _; typ = Float}, {loc = Reg _} ->
- ` lfd {emit_reg dst}, {emit_stack src}\n`
+ ` lfd {emit_reg dst}, {emit_stack env src}\n`
| (_, _) ->
Misc.fatal_error "Emit: Imove"
end
begin match abi with
| ELF32 ->
let lbl = new_label() in
- float_literals := (f, lbl) :: !float_literals;
+ env.float_literals <- { fl=f; lbl } :: env.float_literals;
` addis 11, 0, {emit_upper emit_label lbl}\n`;
` lfd {emit_reg i.res.(0)}, {emit_lower emit_label lbl}(11)\n`
| ELF64v1 | ELF64v2 ->
| ELF32 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| ELF64v1 ->
` ld 0, 0({emit_reg i.arg.(0)})\n`; (* code pointer *)
` mtctr 0\n`;
` ld 2, 8({emit_reg i.arg.(0)})\n`; (* TOC for callee *)
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg);
- emit_reload_toc()
+ record_frame env i.live (Dbg_other i.dbg);
+ emit_reload_toc env
| ELF64v2 ->
` mtctr {emit_reg i.arg.(0)}\n`;
` mr 12, {emit_reg i.arg.(0)}\n`; (* addr of fn in r12 *)
` bctrl\n`;
- record_frame i.live (Dbg_other i.dbg);
- emit_reload_toc()
+ record_frame env i.live (Dbg_other i.dbg);
+ emit_reload_toc env
end
| Lop(Icall_imm { func; }) ->
begin match abi with
| ELF32 ->
emit_call func;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| ELF64v1 | ELF64v2 ->
(* For PPC64, we cannot just emit a "bl s; nop" sequence, because
of the following scenario:
Cost: 3 instructions if same TOC, 7 if different TOC.
Let's try option 2. *)
emit_call func;
- record_frame i.live (Dbg_other i.dbg);
+ record_frame env i.live (Dbg_other i.dbg);
` nop\n`;
- emit_reload_toc()
+ emit_reload_toc env
end
| Lop(Itailcall_ind) ->
begin match abi with
` mtctr {emit_reg i.arg.(0)}\n`;
` mr 12, {emit_reg i.arg.(0)}\n` (* addr of fn in r12 *)
end;
- if !contains_calls then begin
- ` {emit_string lg} 11, {emit_int(retaddr_offset())}(1)\n`;
+ if env.f.fun_contains_calls then begin
+ ` {emit_string lg} 11, {emit_int(retaddr_offset env)}(1)\n`;
` mtlr 11\n`
end;
- emit_free_frame();
+ emit_free_frame env;
` bctr\n`
| Lop(Itailcall_imm { func; }) ->
- if func = !function_name then
- ` b {emit_label !tailrec_entry_point}\n`
+ if func = env.f.fun_name then
+ ` b {emit_label env.f.fun_tailrec_entry_point_label}\n`
else begin
begin match abi with
| ELF32 ->
emit_tocload emit_gpr 12 (TocSym func); (* addr of fn must be in r12 *)
` mtctr 12\n`
end;
- if !contains_calls then begin
- ` {emit_string lg} 11, {emit_int(retaddr_offset())}(1)\n`;
+ if env.f.fun_contains_calls then begin
+ ` {emit_string lg} 11, {emit_int(retaddr_offset env)}(1)\n`;
` mtlr 11\n`
end;
- emit_free_frame();
+ emit_free_frame env;
begin match abi with
| ELF32 ->
` b {emit_symbol func}\n`
` addis 25, 0, {emit_upper emit_symbol func}\n`;
` addi 25, 25, {emit_lower emit_symbol func}\n`;
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| ELF64v1 | ELF64v2 ->
emit_tocload emit_gpr 25 (TocSym func);
emit_call "caml_c_call";
- record_frame i.live (Dbg_other i.dbg);
+ record_frame env i.live (Dbg_other i.dbg);
` nop\n`
end
| Lop(Istackoffset n) ->
` addi 1, 1, {emit_int (-n)}\n`;
- adjust_stack_offset n
- | Lop(Iload(chunk, addr)) ->
+ adjust_stack_offset env n
+ | Lop(Iload(chunk, addr, _mut)) ->
let loadinstr =
match chunk with
| Byte_unsigned -> "lbz"
| Single -> "stfs"
| Double | Double_u -> "stfd" in
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
- | Lop(Ialloc { bytes = n; dbginfo }) ->
- if !call_gc_label = 0 then call_gc_label := new_label ();
- ` addi 31, 31, {emit_int(-n)}\n`;
- ` {emit_string cmplg} 31, 30\n`;
- ` bltl {emit_label !call_gc_label}\n`;
- record_frame i.live (Dbg_alloc dbginfo);
- ` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
- | Lop(Ispecific(Ialloc_far { bytes = n; dbginfo })) ->
- if !call_gc_label = 0 then call_gc_label := new_label ();
- let lbl = new_label() in
- ` addi 31, 31, {emit_int(-n)}\n`;
- ` {emit_string cmplg} 31, 30\n`;
- ` bge {emit_label lbl}\n`;
- ` bl {emit_label !call_gc_label}\n`;
- record_frame i.live (Dbg_alloc dbginfo);
- `{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
+ | Lop(Ialloc { bytes; dbginfo }) ->
+ emit_alloc env i bytes dbginfo false
+ | Lop(Ispecific(Ialloc_far { bytes; dbginfo })) ->
+ emit_alloc env i bytes dbginfo true
+ | Lop(Ipoll { return_label }) ->
+ emit_poll env i return_label false
+ | Lop(Ispecific(Ipoll_far { return_label })) ->
+ emit_poll env i return_label true
| Lop(Iintop Isub) -> (* subfc has swapped arguments *)
` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
| Lop(Iintop Imod) ->
end
| Lop(Iintop (Icheckbound)) ->
if !Clflags.debug then
- record_frame Reg.Set.empty (Dbg_other i.dbg);
+ record_frame env Reg.Set.empty (Dbg_other i.dbg);
` {emit_string tglle} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
| Lop(Iintop op) ->
let instr = name_for_intop op in
end
| Lop(Iintop_imm(Icheckbound, n)) ->
if !Clflags.debug then
- record_frame Reg.Set.empty (Dbg_other i.dbg);
+ record_frame env Reg.Set.empty (Dbg_other i.dbg);
` {emit_string tglle}i {emit_reg i.arg.(0)}, {emit_int n}\n`
| Lop(Iintop_imm(op, n)) ->
let instr = name_for_intop_imm op in
` fcfid {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
end else begin
let lbl = new_label() in
- float_literals := (0x4330000080000000L, lbl) :: !float_literals;
+ env.float_literals <- {fl=0x4330000080000000L; lbl} :: env.float_literals;
` addis 11, 0, {emit_upper emit_label lbl}\n`;
` lfd 0, {emit_lower emit_label lbl}(11)\n`;
` lis 0, 0x4330\n`;
` lwz {emit_reg i.res.(0)}, 4(1)\n`;
` addi 1, 1, 16\n`
end
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific sop) ->
let instr = name_for_specific sop in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
- | Lop (Iname_for_debugger _) -> ()
| Lreloadretaddr ->
- ` {emit_string lg} 11, {emit_int(retaddr_offset())}(1)\n`;
+ ` {emit_string lg} 11, {emit_int(retaddr_offset env)}(1)\n`;
` mtlr 11\n`
| Lreturn ->
- emit_free_frame();
+ emit_free_frame env;
` blr\n`
| Llabel lbl ->
`{emit_label lbl}:\n`
| Lswitch jumptbl ->
let lbl = new_label() in
if ppc64 then begin
- if !jumptables_lbl < 0 then jumptables_lbl := lbl;
- let start = List.length !jumptables in
+ let jumptables_lbl = match env.jumptables_lbl with
+ | None ->
+ env.jumptables_lbl <- Some lbl;
+ assert (List.length env.jumptables = 0);
+ lbl
+ | Some l-> l
+ in
+ let start = List.length env.jumptables in
let (start_lo, start_hi) = low_high_s start in
- emit_tocload emit_gpr 11 (TocLabel !jumptables_lbl);
+ emit_tocload emit_gpr 11 (TocLabel jumptables_lbl);
` addi 12, {emit_reg i.arg.(0)}, {emit_int start_lo}\n`;
if start_hi <> 0 then
` addis 12, 12, {emit_int start_hi}\n`;
` mtctr 0\n`;
` bctr\n`;
if ppc64 then begin
- jumptables := List.rev_append (Array.to_list jumptbl) !jumptables
+ env.jumptables <- List.rev_append (Array.to_list jumptbl) env.jumptables
end else begin
emit_string rodata_space;
`{emit_label lbl}:`;
| Lentertrap ->
begin match abi with
| ELF32 -> ()
- | ELF64v1 | ELF64v2 -> emit_reload_toc()
+ | ELF64v1 | ELF64v2 -> emit_reload_toc env
end
| Ladjust_trap_depth { delta_traps } ->
- adjust_stack_offset (trap_size * delta_traps)
+ adjust_stack_offset env (trap_size * delta_traps)
| Lpushtrap { lbl_handler; } ->
begin match abi with
| ELF32 ->
` addis 11, 0, {emit_upper emit_label lbl_handler}\n`;
` addi 11, 11, {emit_lower emit_label lbl_handler}\n`;
` stwu 11, -16(1)\n`;
- adjust_stack_offset 16;
+ adjust_stack_offset env 16;
` stw 29, 4(1)\n`;
` mr 29, 1\n`
| ELF64v1 | ELF64v2 ->
` addi 1, 1, {emit_int (-trap_size)}\n`;
- adjust_stack_offset trap_size;
+ adjust_stack_offset env trap_size;
` std 29, {emit_int trap_previous_offset}(1)\n`;
emit_tocload emit_gpr 29 (TocLabel lbl_handler);
` std 29, {emit_int trap_handler_offset}(1)\n`;
| Lpoptrap ->
` {emit_string lg} 29, {emit_int trap_previous_offset}(1)\n`;
` addi 1, 1, {emit_int trap_size}\n`;
- adjust_stack_offset (-trap_size)
+ adjust_stack_offset env (-trap_size)
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
Domainstate.(idx_of_field Domain_backtrace_pos)
in
begin match abi with
- | ELF32 -> ` stw 0, {emit_int (backtrace_pos * 8)}(28)\n`
- | _ -> ` std 0, {emit_int (backtrace_pos * 8)}(28)\n`
+ | ELF32 -> ` stw 0, {emit_int (backtrace_pos * 8)}(30)\n`
+ | _ -> ` std 0, {emit_int (backtrace_pos * 8)}(30)\n`
end;
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg);
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg);
emit_call_nop()
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
- record_frame Reg.Set.empty (Dbg_raise i.dbg);
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg);
emit_call_nop()
| Lambda.Raise_notrace ->
` {emit_string lg} 0, {emit_int trap_handler_offset}(29)\n`;
(* Emit a sequence of instructions *)
-let rec emit_all i =
+let rec emit_all env i =
match i.desc with
| Lend -> ()
- | _ -> emit_instr i; emit_all i.next
+ | _ -> emit_instr env i; emit_all env i.next
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- stack_offset := 0;
- call_gc_label := 0;
- float_literals := [];
- jumptables := []; jumptables_lbl := -1;
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- contains_calls := fundecl.fun_contains_calls;
+ let env = mk_env fundecl in
begin match abi with
| ELF32 ->
emit_string code_space;
(* On this target, there is at most one "out of line" code block per
function: a single "call GC" point. It comes immediately after the
function's body. *)
- BR.relax fundecl.fun_body ~max_out_of_line_code_offset:0;
- emit_all fundecl.fun_body;
+ BR.relax fundecl ~max_out_of_line_code_offset:0;
+ emit_all env fundecl.fun_body;
(* Emit the glue code to call the GC *)
- if !call_gc_label > 0 then begin
- `{emit_label !call_gc_label}:\n`;
+ if env.call_gc_label > 0 then begin
+ `{emit_label env.call_gc_label}:\n`;
match abi with
| ELF32 ->
` b {emit_symbol "caml_call_gc"}\n`
` .size {emit_symbol fundecl.fun_name}, . - .L.{emit_symbol fundecl.fun_name}\n`
end;
(* Emit the numeric literals *)
- if !float_literals <> [] then begin
+ if env.float_literals <> [] then begin
emit_string rodata_space;
` .align 3\n`;
List.iter
- (fun (f, lbl) ->
+ (fun { fl; lbl } ->
`{emit_label lbl}:`;
- emit_float64_split_directive ".long" f)
- !float_literals
+ emit_float64_split_directive ".long" fl)
+ env.float_literals
end;
(* Emit the jump tables *)
- if !jumptables <> [] then begin
+ match env.jumptables, env.jumptables_lbl with
+ | _ :: _, None | [], Some _ -> assert false (* Sanity check *)
+ | [], None -> ()
+ | _ :: _, Some j ->
emit_string rodata_space;
` .align 2\n`;
- `{emit_label !jumptables_lbl}:`;
+ `{emit_label j}:`;
List.iter
(fun lbl ->
- ` .long {emit_label lbl} - {emit_label !jumptables_lbl}\n`)
- (List.rev !jumptables)
- end
+ ` .long {emit_label lbl} - {emit_label j}\n`)
+ (List.rev env.jumptables)
(* Emission of data *)
3 - 10 function arguments and results
11 - 12 temporaries
13 pointer to small data area
- 14 - 27 general purpose, preserved by C
- 28 domain state pointer
+ 14 - 28 general purpose, preserved by C
29 trap pointer
- 30 allocation limit
+ 30 domain state pointer
31 allocation pointer
Floating-point register map:
0 temporary
*)
let int_reg_name =
- [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10";
- "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21";
- "22"; "23"; "24"; "25"; "26"; "27" |]
+ [| "3"; "4"; "5"; "6"; "7"; "8"; "9"; "10"; (* 0 - 7 *)
+ "14"; "15"; "16"; "17"; "18"; "19"; "20"; "21"; (* 8 - 15 *)
+ "22"; "23"; "24"; "25"; "26"; "27"; "28" |] (* 16 - 22 *)
let float_reg_name =
[| "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8";
| Val | Int | Addr -> 0
| Float -> 1
-let num_available_registers = [| 22; 31 |]
+let num_available_registers = [| 23; 31 |]
let first_available_register = [| 0; 100 |]
(* Representation of hard registers by pseudo-registers *)
let hard_int_reg =
- let v = Array.make 22 Reg.dummy in
+ let v = Array.make 23 Reg.dummy in
for i = 0 to 21 do v.(i) <- Reg.at_location Int (Reg i) done; v
let hard_float_reg =
let safe_register_pressure = function
Iextcall _ -> 14
- | _ -> 22
+ | _ -> 23
let max_register_pressure = function
Iextcall _ -> [| 14; 18 |]
- | _ -> [| 22; 30 |]
-
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
- | Ispecific(Imultaddf | Imultsubf) -> true
- | Ispecific _ -> false
- | _ -> true
+ | _ -> [| 23; 30 |]
(* Layout of the stack *)
method oper_latency = function
Ireload -> 2
- | Iload(_, _) -> 2
+ | Iload(_, _, _) -> 2
| Iconst_float _ -> 2 (* turned into a load *)
| Iconst_symbol _ -> 1
| Iintop(Imul | Imulh) -> 9
method oper_issue_cycles = function
Iconst_float _ | Iconst_symbol _ -> 2
- | Iload(_, Ibased(_, _)) -> 2
+ | Iload(_, Ibased(_, _), _) -> 2
| Istore(_, Ibased(_, _), _) -> 2
| Ialloc _ -> 4
| Iintop(Imod) -> 40 (* assuming full stall *)
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f =
+ (new selector)#emit_fundecl ~future_funcnames f
| Ccmpf c -> Printf.sprintf "%sf" (float_comparison c)
| Craise k -> Lambda.raise_kind k ^ location d
| Ccheckbound -> "checkbound" ^ location d
+ | Copaque -> "opaque"
let rec expr ppf = function
| Cconst_int (n, _dbg) -> fprintf ppf "%i" n
fprintf ppf "prologue"
| Lop op ->
begin match op with
- | Ialloc _ | Icall_ind | Icall_imm _ | Iextcall _ ->
+ | Ialloc _ | Ipoll _ | Icall_ind | Icall_imm _ | Iextcall _ ->
fprintf ppf "@[<1>{%a}@]@," regsetaddr i.live
| _ -> ()
end;
open Mach
open Interval
-module V = Backend_var
-
let reg ppf r =
if not (Reg.anonymous r) then
fprintf ppf "%s" (Reg.name r)
(if alloc then "" else " (noalloc)")
| Istackoffset n ->
fprintf ppf "offset stack %i" n
- | Iload(chunk, addr) ->
+ | Iload(chunk, addr, Immutable) ->
fprintf ppf "%s[%a]"
(Printcmm.chunk chunk) (Arch.print_addressing reg addr) arg
+ | Iload(chunk, addr, Mutable) ->
+ fprintf ppf "%s mut[%a]"
+ (Printcmm.chunk chunk) (Arch.print_addressing reg addr) arg
| Istore(chunk, addr, is_assign) ->
fprintf ppf "%s[%a] := %a %s"
(Printcmm.chunk chunk)
| Idivf -> fprintf ppf "%a /f %a" reg arg.(0) reg arg.(1)
| Ifloatofint -> fprintf ppf "floatofint %a" reg arg.(0)
| Iintoffloat -> fprintf ppf "intoffloat %a" reg arg.(0)
- | Iname_for_debugger { ident; which_parameter; } ->
- fprintf ppf "name_for_debugger %a%s=%a"
- V.print ident
- (match which_parameter with
- | None -> ""
- | Some index -> sprintf "[P%d]" index)
- reg arg.(0)
+ | Iopaque -> fprintf ppf "opaque %a" reg arg.(0)
| Ispecific op ->
Arch.print_specific_operation reg op ppf arg
+ | Ipoll { return_label } ->
+ fprintf ppf "poll call";
+ match return_label with
+ | None -> ()
+ | Some return_label ->
+ fprintf ppf " returning to L%d" return_label
let rec instr ppf i =
if !Clflags.dump_live then begin
fprintf ppf "@[<1>{%a" regsetaddr i.live;
if Array.length i.arg > 0 then fprintf ppf "@ +@ %a" regs i.arg;
fprintf ppf "}@]@,";
- if !Clflags.dump_avail then begin
- let module RAS = Reg_availability_set in
- fprintf ppf "@[<1>AB={%a}" (RAS.print ~print_reg:reg) i.available_before;
- begin match i.available_across with
- | None -> ()
- | Some available_across ->
- fprintf ppf ",AA={%a}" (RAS.print ~print_reg:reg) available_across
- end;
- fprintf ppf "@]@,"
- end
end;
begin match i.desc with
| Iend -> ()
(* Volatile registers: those that change value when read *)
val regs_are_volatile: Reg.t array -> bool
-(* Pure operations *)
-val op_is_pure: Mach.operation -> bool
-
(* Info for laying out the stack frame *)
val frame_required : Mach.fundecl -> bool
| _ ->
(arg, res)
end
+ | Iopaque ->
+ (* arg = result, can be on stack or register *)
+ assert (arg.(0).stamp = res.(0).stamp);
+ (arg, res)
| _ ->
(self#makeregs arg, self#makeregs res)
| Imultsubf true ->
fprintf ppf "-f (%a *f %a -f %a)"
printreg arg.(0) printreg arg.(1) printreg arg.(2)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure _ = true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false
open Mach
open Linear
open Emitaux
+open Emitenv
(* Layout of the stack. The stack is kept 16-aligned. *)
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let contains_calls = ref false
-
-let frame_size () =
+let frame_size env =
let size =
- !stack_offset + (* Trap frame, outgoing parameters *)
- size_int * num_stack_slots.(0) + (* Local int variables *)
- size_float * num_stack_slots.(1) + (* Local float variables *)
- (if !contains_calls then size_addr else 0) in (* The return address *)
+ env.stack_offset + (* Trap frame, outgoing parameters *)
+ size_int * env.f.fun_num_stack_slots.(0) + (* Local int variables *)
+ size_float * env.f.fun_num_stack_slots.(1) + (* Local float variables *)
+ (if env.f.fun_contains_calls then size_addr else 0) (* Return address *)
+ in
Misc.align size 16
-let slot_offset loc cls =
+let slot_offset env loc cls =
match loc with
| Local n ->
if cls = 0
- then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
- else !stack_offset + n * size_float
- | Incoming n -> frame_size() + n
+ then env.stack_offset + env.f.fun_num_stack_slots.(1) * size_float
+ + n * size_int
+ else env.stack_offset + n * size_float
+ | Incoming n -> frame_size env + n
| Outgoing n -> n
(* Output a symbol *)
(* Names for special regs *)
-let reg_tmp = phys_reg 22
+let reg_tmp = phys_reg 23
let reg_t2 = phys_reg 16
-let reg_domain_state_ptr = phys_reg 23
+let reg_domain_state_ptr = phys_reg 26
let reg_trap = phys_reg 24
let reg_alloc_ptr = phys_reg 25
-let reg_alloc_lim = phys_reg 26
(* Output a pseudo-register *)
(* Record live pointers at call points *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label () in
let live_offset = ref [] in
Reg.Set.iter
{typ = Val; loc = Reg r} ->
live_offset := (r lsl 1) + 1 :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ()
)
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in
`{emit_label lbl}:\n`
-(* Record calls to the GC -- we've moved them out of the way *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame_lbl: label } (* Label of frame descriptor *)
-
-let call_gc_sites = ref ([] : gc_call list)
-
let emit_call_gc gc =
`{emit_label gc.gc_lbl}:\n`;
` {emit_call "caml_call_gc"}\n`;
`{emit_label gc.gc_frame_lbl}:\n`;
` j {emit_label gc.gc_return_lbl}\n`
-(* Record calls to caml_ml_array_bound_error.
- In debug mode, we maintain one call to caml_ml_array_bound_error
- per bound check site. Otherwise, we can share a single call. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame_lbl: label } (* Label of frame descriptor *)
-
-let bound_error_sites = ref ([] : bound_error_call list)
-
-let bound_error_label dbg =
- if !Clflags.debug || !bound_error_sites = [] then begin
+let bound_error_label env dbg =
+ if !Clflags.debug || env.bound_error_sites = [] then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <-
{ bd_lbl = lbl_bound_error;
- bd_frame_lbl = lbl_frame } :: !bound_error_sites;
+ bd_frame = lbl_frame; } :: env.bound_error_sites;
lbl_bound_error
end else
- let bd = List.hd !bound_error_sites in
+ let bd = List.hd env.bound_error_sites in
bd.bd_lbl
let emit_call_bound_error bd =
`{emit_label bd.bd_lbl}:\n`;
` {emit_call "caml_ml_array_bound_error"}\n`;
- `{emit_label bd.bd_frame_lbl}:\n`
-
-(* Record floating-point literals *)
-
-let float_literals = ref ([] : (int64 * int) list)
+ `{emit_label bd.bd_frame}:\n`
(* Names for various instructions *)
| Imultsubf false -> "fmsub.d"
| Imultsubf true -> "fnmsub.d"
-(* Name of current function *)
-let function_name = ref ""
-
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-
(* Output the assembly code for an instruction *)
-let emit_instr i =
+let emit_instr env i =
emit_debug_info i.dbg;
match i.desc with
Lend -> ()
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env in
emit_stack_adjustment (-n);
- if !contains_calls then store_ra n
+ if env.f.fun_contains_calls then store_ra n
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
if src.loc <> dst.loc then begin
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Val | Int | Addr)} ->
` fmv.x.d {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
- let ofs = slot_offset s (register_class dst) in
+ let ofs = slot_offset env s (register_class dst) in
emit_store src ofs
| {loc = Reg _; typ = Float}, {loc = Stack s} ->
- let ofs = slot_offset s (register_class dst) in
+ let ofs = slot_offset env s (register_class dst) in
emit_float_store src ofs
| {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
- let ofs = slot_offset s (register_class src) in
+ let ofs = slot_offset env s (register_class src) in
emit_load dst ofs
| {loc = Stack s; typ = Float}, {loc = Reg _} ->
- let ofs = slot_offset s (register_class src) in
+ let ofs = slot_offset env s (register_class src) in
emit_float_load dst ofs
| {loc = Stack _}, {loc = Stack _}
| {loc = Unknown}, _ | _, {loc = Unknown} ->
` li {emit_reg i.res.(0)}, {emit_nativeint n}\n`
| Lop(Iconst_float f) ->
let lbl = new_label() in
- float_literals := (f, lbl) :: !float_literals;
+ env.float_literals <- {fl=f; lbl} :: env.float_literals;
` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp}\n`
| Lop(Iconst_symbol s) ->
` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
| Lop(Icall_ind) ->
` jalr {emit_reg i.arg.(0)}\n`;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Icall_imm {func}) ->
` {emit_call func}\n`;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Itailcall_ind) ->
- let n = frame_size() in
- if !contains_calls then reload_ra n;
+ let n = frame_size env in
+ if env.f.fun_contains_calls then reload_ra n;
emit_stack_adjustment n;
` jr {emit_reg i.arg.(0)}\n`
| Lop(Itailcall_imm {func}) ->
- if func = !function_name then begin
- ` j {emit_label !tailrec_entry_point}\n`
+ if func = env.f.fun_name then begin
+ ` j {emit_label env.f.fun_tailrec_entry_point_label}\n`
end else begin
- let n = frame_size() in
- if !contains_calls then reload_ra n;
+ let n = frame_size env in
+ if env.f.fun_contains_calls then reload_ra n;
emit_stack_adjustment n;
` {emit_tail func}\n`
end
| Lop(Iextcall{func; alloc = true}) ->
` la {emit_reg reg_t2}, {emit_symbol func}\n`;
` {emit_call "caml_c_call"}\n`;
- record_frame i.live (Dbg_other i.dbg)
+ record_frame env i.live (Dbg_other i.dbg)
| Lop(Iextcall{func; alloc = false}) ->
` {emit_call func}\n`
| Lop(Istackoffset n) ->
assert (n mod 16 = 0);
emit_stack_adjustment (-n);
- stack_offset := !stack_offset + n
- | Lop(Iload(Single, Iindexed ofs)) ->
+ env.stack_offset <- env.stack_offset + n
+ | Lop(Iload(Single, Iindexed ofs, _mut)) ->
` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
- | Lop(Iload(chunk, Iindexed ofs)) ->
+ | Lop(Iload(chunk, Iindexed ofs, _mut)) ->
let instr =
match chunk with
| Byte_unsigned -> "lbu"
in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
| Lop(Ialloc {bytes; dbginfo}) ->
- let lbl_frame_lbl = record_frame_label i.live (Dbg_alloc dbginfo) in
+ let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc dbginfo) in
let lbl_after_alloc = new_label () in
let lbl_call_gc = new_label () in
let n = -bytes in
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
if is_immediate n then
` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n`
else begin
` li {emit_reg reg_tmp}, {emit_int n}\n`;
` add {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n`
end;
- ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`;
+ ` ld {emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
+ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`;
`{emit_label lbl_after_alloc}:\n`;
` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites
+ gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites
+ | Lop(Ipoll { return_label }) ->
+ let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc []) in
+ let lbl_after_poll = match return_label with
+ | None -> new_label()
+ | Some(lbl) -> lbl in
+ let lbl_call_gc = new_label () in
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` ld {emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
+ begin match return_label with
+ | None -> ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`;
+ `{emit_label lbl_after_poll}:\n`;
+ | Some lbl -> ` bgeu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl}\n`;
+ ` j {emit_label lbl_call_gc}\n`
+ end;
+ env.call_gc_sites <-
+ { gc_lbl = lbl_call_gc;
+ gc_return_lbl = lbl_after_poll;
+ gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites
| Lop(Iintop(Icomp cmp)) ->
begin match cmp with
| Isigned Clt ->
` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
end
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
| Lop(Iintop op) ->
let instr = name_for_intop op in
` fcvt.d.l {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
| Lop(Iintoffloat) ->
` fcvt.l.d {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, rtz\n`
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific sop) ->
let instr = name_for_specific sop in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
- | Lop (Iname_for_debugger _) ->
- ()
| Lreloadretaddr ->
- let n = frame_size () in
+ let n = frame_size env in
reload_ra n
| Lreturn ->
- let n = frame_size() in
+ let n = frame_size env in
emit_stack_adjustment n;
` ret\n`
| Llabel lbl ->
| Ladjust_trap_depth { delta_traps } ->
(* each trap occupes 16 bytes on the stack *)
let delta = 16 * delta_traps in
- stack_offset := !stack_offset + delta
+ env.stack_offset <- env.stack_offset + delta
| Lpushtrap {lbl_handler} ->
` la {emit_reg reg_tmp}, {emit_label lbl_handler}\n`;
` addi sp, sp, -16\n`;
- stack_offset := !stack_offset + 16;
+ env.stack_offset <- env.stack_offset + 16;
emit_store reg_tmp size_addr;
emit_store reg_trap 0;
` mv {emit_reg reg_trap}, sp\n`
| Lpoptrap ->
emit_load reg_trap 0;
` addi sp, sp, 16\n`;
- stack_offset := !stack_offset - 16
+ env.stack_offset <- env.stack_offset - 16
| Lraise k ->
begin match k with
| Lambda.Raise_regular ->
let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
` sd zero, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
` {emit_call "caml_raise_exn"}\n`;
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_reraise ->
` {emit_call "caml_raise_exn"}\n`;
- record_frame Reg.Set.empty (Dbg_raise i.dbg)
+ record_frame env Reg.Set.empty (Dbg_raise i.dbg)
| Lambda.Raise_notrace ->
` mv sp, {emit_reg reg_trap}\n`;
emit_load reg_tmp size_addr;
(* Emit a sequence of instructions *)
-let rec emit_all = function
- | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next
+let rec emit_all env = function
+ | {desc = Lend} -> () | i -> emit_instr env i; emit_all env i.next
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- contains_calls := fundecl.fun_contains_calls;
- float_literals := [];
+ let env = mk_env fundecl in
` .globl {emit_symbol fundecl.fun_name}\n`;
` .type {emit_symbol fundecl.fun_name}, @function\n`;
` {emit_string code_space}\n`;
` .align 2\n`;
`{emit_symbol fundecl.fun_name}:\n`;
emit_debug_info fundecl.fun_dbg;
- emit_all fundecl.fun_body;
- List.iter emit_call_gc !call_gc_sites;
- List.iter emit_call_bound_error !bound_error_sites;
+ emit_all env fundecl.fun_body;
+ List.iter emit_call_gc env.call_gc_sites;
+ List.iter emit_call_bound_error env.bound_error_sites;
` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
(* Emit the float literals *)
- if !float_literals <> [] then begin
+ if env.float_literals <> [] then begin
` {emit_string rodata_space}\n`;
` .align 3\n`;
List.iter
- (fun (f, lbl) ->
+ (fun {fl; lbl} ->
`{emit_label lbl}:\n`;
- emit_float64_directive ".quad" f)
- !float_literals;
+ emit_float64_directive ".quad" fl)
+ env.float_literals;
end
(* Emission of data *)
a0-a7 0-7 arguments/results
s2-s9 8-15 arguments/results (preserved by C)
t2-t6 16-20 temporary
- t0 21 temporary
- t1 22 temporary (used by code generator)
- s0 23 domain pointer (preserved by C)
+ s0 21 general purpose (preserved by C)
+ t0 22 temporary
+ t1 23 temporary (used by code generator)
s1 24 trap pointer (preserved by C)
s10 25 allocation pointer (preserved by C)
- s11 26 allocation limit (preserved by C)
+ s11 26 domain pointer (preserved by C)
Floating-point register map
---------------------------
*)
let int_reg_name =
- [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7";
- "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9";
- "t2"; "t3"; "t4"; "t5"; "t6";
- "t0"; "t1";
- "s0"; "s1"; "s10"; "s11" |]
+ [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7"; (* 0 - 7 *)
+ "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9"; (* 8 - 15 *)
+ "t2"; "t3"; "t4"; "t5"; "t6"; (* 16 - 20 *)
+ "s0"; (* 21 *)
+ "t0"; "t1"; (* 22 - 23 *)
+ "s1"; "s10"; "s11" |] (* 24 - 26 *)
let float_reg_name =
[| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7";
| Val | Int | Addr -> 0
| Float -> 1
-let num_available_registers = [| 22; 32 |]
+let num_available_registers = [| 23; 32 |]
let first_available_register = [| 0; 100 |]
(* Registers destroyed by operations *)
let destroyed_at_c_call =
- (* s0-s11 and fs0-fs11 are callee-save *)
+ (* s0-s11 and fs0-fs11 are callee-save. However s2 needs to be in this
+ list since it is clobbered by caml_c_call itself. *)
Array.of_list(List.map phys_reg
- [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; 21;
+ [0; 1; 2; 3; 4; 5; 6; 7; 8; 16; 17; 18; 19; 20; 22;
100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
117; 128; 129; 130; 131])
let destroyed_at_alloc =
- (* t0-t3 are used for PLT stubs *)
- if !Clflags.dlcode then Array.map phys_reg [|16; 17; 18; 19; 20; 21|]
+ (* t0-t6 are used for PLT stubs *)
+ if !Clflags.dlcode then Array.map phys_reg [|16; 17; 18; 19; 20; 22|]
else [| |]
let destroyed_at_oper = function
| Iop(Icall_ind | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
| Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
- | Iop(Ialloc _) -> destroyed_at_alloc
+ | Iop(Ialloc _) | Iop(Ipoll _) -> destroyed_at_alloc
| Iop(Istore(Single, _, _)) -> [| phys_reg 100 |]
- | Iswitch _ -> [| phys_reg 21 |]
+ | Iswitch _ -> [| phys_reg 22 |] (* t0 *)
| _ -> [||]
let destroyed_at_raise = all_phys_regs
(* Maximal register pressure *)
let safe_register_pressure = function
- | Iextcall _ -> 15
- | _ -> 22
+ | Iextcall _ -> 9
+ | _ -> 23
let max_register_pressure = function
- | Iextcall _ -> [| 15; 18 |]
- | _ -> [| 22; 30 |]
-
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
- | Ispecific(Imultaddf _ | Imultsubf _) -> true
- | _ -> true
+ | Iextcall _ -> [| 9; 12 |]
+ | _ -> [| 23; 30 |]
(* Layout of the stack *)
[| 10; 11; 12; 13; 14; 15; 16; 17;
18; 19; 20; 21; 22; 23; 24; 25;
7; 28; 29; 30; 31;
+ 8;
5; 6;
- 8; 9; 26; 27;
+ 9; 26; 27;
|]
let float_dwarf_reg_numbers =
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f =
+ (new selector)#emit_fundecl ~future_funcnames f
| Imultsubf ->
fprintf ppf "%a *f %a -f %a"
printreg arg.(0) printreg arg.(1) printreg arg.(2)
+
+(* Specific operations that are pure *)
+
+let operation_is_pure _ = true
+
+(* Specific operations that can raise *)
+
+let operation_can_raise _ = false
open Mach
open Linear
open Emitaux
+open Emitenv
-(* Layout of the stack. The stack is kept 8-aligned. *)
-
-let stack_offset = ref 0
-
-let num_stack_slots = Array.make Proc.num_register_classes 0
-
-let prologue_required = ref false
-
-let contains_calls = ref false
-
-let frame_size () =
+let frame_size env =
let size =
- !stack_offset + (* Trap frame, outgoing parameters *)
- size_int * num_stack_slots.(0) + (* Local int variables *)
- size_float * num_stack_slots.(1) + (* Local float variables *)
- (if !contains_calls then size_addr else 0) in (* The return address *)
+ env.stack_offset + (* Trap frame, outgoing parameters *)
+ size_int * env.f.fun_num_stack_slots.(0) + (* Local int variables *)
+ size_float * env.f.fun_num_stack_slots.(1) + (* Local float variables *)
+ (if env.f.fun_contains_calls then size_addr else 0) in (* The return address *)
Misc.align size 8
-let slot_offset loc cls =
+let slot_offset env loc cls =
match loc with
Local n ->
if cls = 0
- then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
- else !stack_offset + n * size_float
- | Incoming n -> frame_size() + n
+ then env.stack_offset +
+ env.f.fun_num_stack_slots.(1) * size_float + n * size_int
+ else env.stack_offset + n * size_float
+ | Incoming n -> frame_size env + n
| Outgoing n -> n
(* Output a symbol *)
(* Output a stack reference *)
-let emit_stack r =
+let emit_stack env r =
match r.loc with
Stack s ->
- let ofs = slot_offset s (register_class r) in `{emit_int ofs}(%r15)`
+ let ofs = slot_offset env s (register_class r) in `{emit_int ofs}(%r15)`
| _ -> fatal_error "Emit.emit_stack"
(* Record live pointers at call points *)
-let record_frame_label live dbg =
+let record_frame_label env live dbg =
let lbl = new_label() in
let live_offset = ref [] in
Reg.Set.iter
| {typ = Val; loc = Reg r} ->
live_offset := (r lsl 1) + 1 :: !live_offset
| {typ = Val; loc = Stack s} as reg ->
- live_offset := slot_offset s (register_class reg) :: !live_offset
+ live_offset := slot_offset env s (register_class reg) :: !live_offset
| {typ = Addr} as r ->
Misc.fatal_error ("bad GC root " ^ Reg.name r)
| _ -> ())
live;
- record_frame_descr ~label:lbl ~frame_size:(frame_size())
+ record_frame_descr ~label:lbl ~frame_size:(frame_size env)
~live_offset:!live_offset dbg;
lbl
-let record_frame live dbg =
- let lbl = record_frame_label live dbg in
+let record_frame env live dbg =
+ let lbl = record_frame_label env live dbg in
`{emit_label lbl}:`
-(* Record calls to caml_call_gc, emitted out of line. *)
-
-type gc_call =
- { gc_lbl: label; (* Entry label *)
- gc_return_lbl: label; (* Where to branch after GC *)
- gc_frame_lbl: label } (* Label of frame descriptor *)
-
-let call_gc_sites = ref ([] : gc_call list)
-
let emit_call_gc gc =
`{emit_label gc.gc_lbl}:`; emit_call "caml_call_gc";
`{emit_label gc.gc_frame_lbl}: brcl 15, {emit_label gc.gc_return_lbl}\n`
-(* Record calls to caml_ml_array_bound_error, emitted out of line. *)
-
-type bound_error_call =
- { bd_lbl: label; (* Entry label *)
- bd_frame: label } (* Label of frame descriptor *)
-
-let bound_error_sites = ref ([] : bound_error_call list)
-let bound_error_call = ref 0
-
-let bound_error_label dbg =
+let bound_error_label env dbg =
if !Clflags.debug then begin
let lbl_bound_error = new_label() in
- let lbl_frame = record_frame_label Reg.Set.empty (Dbg_other dbg) in
- bound_error_sites :=
- { bd_lbl = lbl_bound_error; bd_frame = lbl_frame } :: !bound_error_sites;
+ let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
+ env.bound_error_sites <-
+ { bd_lbl = lbl_bound_error; bd_frame = lbl_frame; }
+ :: env.bound_error_sites;
lbl_bound_error
end else begin
- if !bound_error_call = 0 then bound_error_call := new_label();
- !bound_error_call
+ match env.bound_error_call with
+ | None -> let lbl = new_label() in
+ env.bound_error_call <- Some lbl;
+ lbl
+ | Some lbl -> lbl
end
let emit_call_bound_error bd =
`{emit_label bd.bd_lbl}:`; emit_call "caml_ml_array_bound_error";
`{emit_label bd.bd_frame}:\n`
-let emit_call_bound_errors () =
- List.iter emit_call_bound_error !bound_error_sites;
- if !bound_error_call > 0 then begin
- `{emit_label !bound_error_call}:`; emit_call "caml_ml_array_bound_error";
- end
-
-(* Record floating-point and large integer literals *)
-
-let float_literals = ref ([] : (int64 * int) list)
-let int_literals = ref ([] : (nativeint * int) list)
+let emit_call_bound_errors env =
+ List.iter emit_call_bound_error env.bound_error_sites;
+ match env.bound_error_call with
+ | None -> ()
+ | Some lbl ->
+ `{emit_label lbl}:`; emit_call "caml_ml_array_bound_error"
(* Masks for conditional branches after comparisons *)
Imultaddf -> "madbr"
| Imultsubf -> "msdbr"
-(* Name of current function *)
-let function_name = ref ""
-(* Entry point for tail recursive calls *)
-let tailrec_entry_point = ref 0
-
(* Output the assembly code for an instruction *)
-let emit_instr i =
+let emit_instr env i =
emit_debug_info i.dbg;
match i.desc with
Lend -> ()
| Lprologue ->
- assert (!prologue_required);
- let n = frame_size() in
+ assert (env.f.fun_prologue_required);
+ let n = frame_size env in
emit_stack_adjust n;
- if !contains_calls then
+ if env.f.fun_contains_calls then
` stg %r14, {emit_int(n - size_addr)}(%r15)\n`
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
` ldr {emit_reg dst}, {emit_reg src}\n`
| {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack _} ->
- ` stg {emit_reg src}, {emit_stack dst}\n`
+ ` stg {emit_reg src}, {emit_stack env dst}\n`
| {loc = Reg _; typ = Float}, {loc = Stack _} ->
- ` std {emit_reg src}, {emit_stack dst}\n`
+ ` std {emit_reg src}, {emit_stack env dst}\n`
| {loc = Stack _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
- ` lg {emit_reg dst}, {emit_stack src}\n`
+ ` lg {emit_reg dst}, {emit_stack env src}\n`
| {loc = Stack _; typ = Float}, {loc = Reg _} ->
- ` ldy {emit_reg dst}, {emit_stack src}\n`
+ ` ldy {emit_reg dst}, {emit_stack env src}\n`
| (_, _) ->
fatal_error "Emit: Imove"
end
end else if n >= -0x8000_0000n && n <= 0x7FFF_FFFFn then begin
` lgfi {emit_reg i.res.(0)}, {emit_nativeint n}\n`;
end else begin
- let lbl = new_label() in
- int_literals := (n, lbl) :: !int_literals;
- ` lgrl {emit_reg i.res.(0)}, {emit_label lbl}\n`;
+ let n_lbl = new_label() in
+ env.int_literals <- {n; n_lbl} :: env.int_literals;
+ ` lgrl {emit_reg i.res.(0)}, {emit_label n_lbl}\n`;
end
- | Lop(Iconst_float f) ->
+ | Lop(Iconst_float fl) ->
let lbl = new_label() in
- float_literals := (f, lbl) :: !float_literals;
+ env.float_literals <- { fl; lbl } :: env.float_literals;
` larl %r1, {emit_label lbl}\n`;
` ld {emit_reg i.res.(0)}, 0(%r1)\n`
| Lop(Iconst_symbol s) ->
emit_load_symbol_addr i.res.(0) s
| Lop(Icall_ind) ->
` basr %r14, {emit_reg i.arg.(0)}\n`;
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
| Lop(Icall_imm { func; }) ->
emit_call func;
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
| Lop(Itailcall_ind) ->
- let n = frame_size() in
- if !contains_calls then
+ let n = frame_size env in
+ if env.f.fun_contains_calls then
` lg %r14, {emit_int(n - size_addr)}(%r15)\n`;
emit_stack_adjust (-n);
` br {emit_reg i.arg.(0)}\n`
| Lop(Itailcall_imm { func; }) ->
- if func = !function_name then
- ` brcl 15, {emit_label !tailrec_entry_point}\n`
+ if func = env.f.fun_name then
+ ` brcl 15, {emit_label env.f.fun_tailrec_entry_point_label}\n`
else begin
- let n = frame_size() in
- if !contains_calls then
+ let n = frame_size env in
+ if env.f.fun_contains_calls then
` lg %r14, {emit_int(n - size_addr)}(%r15)\n`;
emit_stack_adjust (-n);
if !pic_code then
else begin
emit_load_symbol_addr reg_r7 func;
emit_call "caml_c_call";
- `{record_frame i.live (Dbg_other i.dbg)}\n`
+ `{record_frame env i.live (Dbg_other i.dbg)}\n`
end
| Lop(Istackoffset n) ->
emit_stack_adjust n;
- stack_offset := !stack_offset + n
+ env.stack_offset <- env.stack_offset + n
- | Lop(Iload(chunk, addr)) ->
+ | Lop(Iload(chunk, addr, _mut)) ->
let loadinstr =
match chunk with
Byte_unsigned -> "llgc"
let lbl_after_alloc = new_label() in
let lbl_call_gc = new_label() in
let lbl_frame =
- record_frame_label i.live (Dbg_alloc dbginfo)
+ record_frame_label env i.live (Dbg_alloc dbginfo)
in
- call_gc_sites :=
+ env.call_gc_sites <-
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_after_alloc;
- gc_frame_lbl = lbl_frame } :: !call_gc_sites;
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites;
` lay %r11, {emit_int(-n)}(%r11)\n`;
let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
` clg %r11, {emit_int offset}(%r10)\n`;
` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *)
`{emit_label lbl_after_alloc}:`;
` la {emit_reg i.res.(0)}, 8(%r11)\n`
-
+ | Lop(Ipoll { return_label }) ->
+ let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
+ ` clg %r11, {emit_int offset}(%r10)\n`;
+ let lbl_call_gc = new_label () in
+ let label_after_gc = match return_label with
+ | None -> new_label()
+ | Some(lbl) -> lbl in
+ let lbl_frame =
+ record_frame_label env i.live (Dbg_alloc [])
+ in
+ begin match return_label with
+ | None -> ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *)
+ | Some return_label -> ` brcl 10, {emit_label return_label}\n`; (* greater or equal *)
+ end;
+ env.call_gc_sites <-
+ { gc_lbl = lbl_call_gc;
+ gc_return_lbl = label_after_gc;
+ gc_frame_lbl = lbl_frame; } :: env.call_gc_sites;
+ begin match return_label with
+ | None -> `{emit_label label_after_gc}:`;
+ | Some _ -> ` brcl 15, {emit_label lbl_call_gc}\n`; (* unconditional *)
+ end
| Lop(Iintop Imulh) ->
(* Hacker's Delight section 8.3:
mul-high-signed(a, b) = mul-high-unsigned(a, b)
` lghi {emit_reg i.res.(0)}, 0\n`;
`{emit_label lbl}:\n`
| Lop(Iintop (Icheckbound)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
` clgr {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` brcl 12, {emit_label lbl}\n` (* branch if unsigned le *)
| Lop(Iintop op) ->
` lghi {emit_reg i.res.(0)}, 0\n`;
`{emit_label lbl}:\n`
| Lop(Iintop_imm(Icheckbound, n)) ->
- let lbl = bound_error_label i.dbg in
+ let lbl = bound_error_label env i.dbg in
if n >= 0 then begin
` clgfi {emit_reg i.arg.(0)}, {emit_int n}\n`;
` brcl 12, {emit_label lbl}\n` (* branch if unsigned le *)
| Lop(Iintoffloat) ->
(* rounding method #5 = round toward 0 *)
` cgdbr {emit_reg i.res.(0)}, 5, {emit_reg i.arg.(0)}\n`
+ | Lop(Iopaque) ->
+ assert (i.arg.(0).loc = i.res.(0).loc)
| Lop(Ispecific sop) ->
assert (i.arg.(2).loc = i.res.(0).loc);
let instr = name_for_specific sop in
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
- | Lop (Iname_for_debugger _) -> ()
| Lreloadretaddr ->
- let n = frame_size() in
+ let n = frame_size env in
` lg %r14, {emit_int(n - size_addr)}(%r15)\n`
| Lreturn ->
- let n = frame_size() in
+ let n = frame_size env in
emit_stack_adjust (-n);
` br %r14\n`
| Llabel lbl ->
(* each trap occupies 16 bytes on the stack *)
let delta = 16 * delta_traps in
emit_stack_adjust delta;
- stack_offset := !stack_offset + delta
+ env.stack_offset <- env.stack_offset + delta
| Lpushtrap { lbl_handler; } ->
- stack_offset := !stack_offset + 16;
+ env.stack_offset <- env.stack_offset + 16;
emit_stack_adjust 16;
` larl %r14, {emit_label lbl_handler}\n`;
` stg %r14, 0(%r15)\n`;
| Lpoptrap ->
` lg %r13, {emit_int size_addr}(%r15)\n`;
emit_stack_adjust (-16);
- stack_offset := !stack_offset - 16
+ env.stack_offset <- env.stack_offset - 16
| Lraise k ->
begin match k with
| Lambda.Raise_regular->
` lghi %r1, 0\n`;
` stg %r1, {emit_int offset}(%r10)\n`;
emit_call "caml_raise_exn";
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_reraise ->
emit_call "caml_raise_exn";
- `{record_frame Reg.Set.empty (Dbg_raise i.dbg)}\n`
+ `{record_frame env Reg.Set.empty (Dbg_raise i.dbg)}\n`
| Lambda.Raise_notrace ->
` lg %r1, 0(%r13)\n`;
` lgr %r15, %r13\n`;
(* Emit a sequence of instructions *)
-let rec emit_all i =
+let rec emit_all env i =
match i with
{desc = Lend} -> ()
| _ ->
- emit_instr i;
- emit_all i.next
+ emit_instr env i;
+ emit_all env i.next
(* Emission of a function declaration *)
let fundecl fundecl =
- function_name := fundecl.fun_name;
- tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
- stack_offset := 0;
- call_gc_sites := [];
- bound_error_sites := [];
- bound_error_call := 0;
- float_literals := [];
- int_literals := [];
- for i = 0 to Proc.num_register_classes - 1 do
- num_stack_slots.(i) <- fundecl.fun_num_stack_slots.(i);
- done;
- prologue_required := fundecl.fun_prologue_required;
- contains_calls := fundecl.fun_contains_calls;
+ let env = mk_env fundecl in
` .globl {emit_symbol fundecl.fun_name}\n`;
emit_debug_info fundecl.fun_dbg;
` .type {emit_symbol fundecl.fun_name}, @function\n`;
emit_string code_space;
` .align 8\n`;
`{emit_symbol fundecl.fun_name}:\n`;
- emit_all fundecl.fun_body;
+ emit_all env fundecl.fun_body;
(* Emit the glue code to call the GC *)
- List.iter emit_call_gc !call_gc_sites;
+ List.iter emit_call_gc env.call_gc_sites;
(* Emit the glue code to handle bound errors *)
- emit_call_bound_errors();
+ emit_call_bound_errors env;
(* Emit the numeric literals *)
- if !float_literals <> [] || !int_literals <> [] then begin
+ if env.float_literals <> [] || env.int_literals <> [] then begin
emit_string rodata_space;
` .align 8\n`;
List.iter
- (fun (f, lbl) ->
+ (fun {fl; lbl} ->
`{emit_label lbl}:`;
- emit_float64_directive ".quad" f)
- !float_literals;
+ emit_float64_directive ".quad" fl)
+ env.float_literals;
List.iter
- (fun (n, lbl) ->
- `{emit_label lbl}: .quad {emit_nativeint n}\n`)
- !int_literals
+ (fun {n; n_lbl} ->
+ `{emit_label n_lbl}: .quad {emit_nativeint n}\n`)
+ env.int_literals
end
(* Emission of data *)
Iextcall _ -> [| 4; 7 |]
| _ -> [| 9; 15 |]
-(* Pure operations (without any side effect besides updating their result
- registers). *)
-
-let op_is_pure = function
- | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
- | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
- | Iintop(Icheckbound) | Iintop_imm(Icheckbound, _) -> false
- | Ispecific(Imultaddf | Imultsubf) -> true
- | _ -> true
-
(* Layout of the stack *)
let frame_required fd =
method oper_latency = function
Ireload -> 4
- | Iload(_, _) -> 4
+ | Iload(_, _, _) -> 4
| Iconst_float _ -> 4 (* turned into a load *)
| Iintop(Imul) -> 10
| Iintop_imm(Imul, _) -> 10
(* Issue cycles. Rough approximations. *)
method oper_issue_cycles = function
- | Ialloc _ -> 4
+ | Ialloc _ | Ipoll _ -> 4
| Iintop(Imulh) -> 15
| Iintop(Idiv|Imod) -> 20
| Iintop(Icomp _) -> 4
end
-let fundecl f = (new selector)#emit_fundecl f
+let fundecl ~future_funcnames f =
+ (new selector)#emit_fundecl ~future_funcnames f
node.length <-
List.fold_left
(fun len (son, delay) ->
- max len (longest_path critical_outputs son + delay))
+ Int.max len (longest_path critical_outputs son + delay))
0 sons
end;
node.length
(* We treat Lreloadretaddr as a word-sized load *)
-let some_load = (Iload(Cmm.Word_int, Arch.identity_addressing))
+let some_load = (Iload(Cmm.Word_int, Arch.identity_addressing, Mutable))
(* The generic scheduler *)
| Itailcall_imm _ -> false
| Iextcall _ -> false
| Istackoffset _ -> false
- | Ialloc _ -> false
+ | Ialloc _ | Ipoll _ -> false
| _ -> true
(* Determine whether an instruction ends a basic block or not *)
| _ -> false
method is_load = function
- Iload(_, _) -> true
+ Iload(_, _, _) -> true
| _ -> false
method is_checkbound = function
| Cintoffloat -> typ_int
| Craise _ -> typ_void
| Ccheckbound -> typ_void
+ | Copaque -> typ_val
(* Infer the size in bytes of the result of an expression whose evaluation
may be deferred (cf. [emit_parts]). *)
| Cop(op, args, _) ->
begin match op with
(* The following may have side effects *)
- | Capply _ | Cextcall _ | Calloc | Cstore _ | Craise _ -> false
+ | Capply _ | Cextcall _ | Calloc | Cstore _ | Craise _ | Copaque -> false
(* The remaining operations are simple if their args are *)
| Cload _ | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor
| Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf
| Cop (op, args, _) ->
let from_op =
match op with
- | Capply _ | Cextcall _ -> EC.arbitrary
+ | Capply _ | Cextcall _ | Copaque -> EC.arbitrary
| Calloc -> EC.none
| Cstore _ -> EC.effect_only Effect.Arbitrary
| Craise _ | Ccheckbound -> EC.effect_only Effect.Raise
self#mark_call
| Iop (Itailcall_ind | Itailcall_imm _) ->
self#mark_tailcall
- | Iop (Ialloc _) ->
- self#mark_call (* caml_alloc*, caml_garbage_collection *)
- | Iop (Iintop(Icheckbound) | Iintop_imm(Icheckbound, _)) ->
+ | Iop (Ialloc _) | Iop (Ipoll _) ->
+ self#mark_call (* caml_alloc*, caml_garbage_collection (incl. polls) *)
+ | Iop (Iintop (Icheckbound) | Iintop_imm(Icheckbound, _)) ->
self#mark_c_tailcall (* caml_ml_array_bound_error *)
| Iraise raise_kind ->
begin match raise_kind with
(Icall_ind, args)
| (Cextcall(func, ty_res, ty_args, alloc), _) ->
Iextcall { func; ty_res; ty_args; alloc; }, args
- | (Cload (chunk, _mut), [arg]) ->
+ | (Cload (chunk, mut), [arg]) ->
let (addr, eloc) = self#select_addressing chunk arg in
- (Iload(chunk, addr), [eloc])
+ (Iload(chunk, addr, mut), [eloc])
| (Cstore (chunk, init), [arg1; arg2]) ->
let (addr, eloc) = self#select_addressing chunk arg1 in
let is_assign =
method insert _env desc arg res =
instr_seq <- instr_cons desc arg res instr_seq
-method extract =
+method extract_onto o =
let rec extract res i =
if i == dummy_instr
- then res
- else extract {i with next = res} i.next in
- extract (end_instr ()) instr_seq
+ then res
+ else extract {i with next = res} i.next in
+ extract o instr_seq
+
+method extract =
+ self#extract_onto (end_instr ())
(* Insert a sequence of moves from one pseudoreg set to another. *)
self#insert env (Iop Imove) [|src|] [|dst|]
method insert_moves env src dst =
- for i = 0 to min (Array.length src) (Array.length dst) - 1 do
+ for i = 0 to Stdlib.Int.min (Array.length src) (Array.length dst) - 1 do
self#insert_move env src.(i) dst.(i)
done
dbg, Cconst_int (1, dbg),
dbg, Cconst_int (0, dbg),
dbg))
+ | Cop(Copaque, args, dbg) ->
+ begin match self#emit_parts_list env args with
+ None -> None
+ | Some (simple_args, env) ->
+ let rs = self#emit_tuple env simple_args in
+ Some (self#insert_op_debug env Iopaque dbg rs rs)
+ end
| Cop(op, args, dbg) ->
begin match self#emit_parts_list env args with
None -> None
(* Sequentialization of a function definition *)
-method emit_fundecl f =
+method emit_fundecl ~future_funcnames f =
current_function_name := f.Cmm.fun_name;
let rargs =
List.map
List.fold_right2
(fun (id, _ty) r env -> env_add id r env)
f.Cmm.fun_args rargs env_empty in
- self#insert_moves env loc_arg rarg;
self#emit_tail env f.Cmm.fun_body;
let body = self#extract in
- instr_iter (fun instr -> self#mark_instr instr.Mach.desc) body;
+ instr_seq <- dummy_instr;
+ self#insert_moves env loc_arg rarg;
+ let polled_body =
+ if Polling.requires_prologue_poll ~future_funcnames
+ ~fun_name:f.Cmm.fun_name body
+ then
+ instr_cons (Iop(Ipoll { return_label = None })) [||] [||] body
+ else
+ body
+ in
+ let body_with_prologue = self#extract_onto polled_body in
+ instr_iter (fun instr -> self#mark_instr instr.Mach.desc) body_with_prologue;
{ fun_name = f.Cmm.fun_name;
fun_args = loc_arg;
- fun_body = body;
+ fun_body = body_with_prologue;
fun_codegen_options = f.Cmm.fun_codegen_options;
fun_dbg = f.Cmm.fun_dbg;
fun_num_stack_slots = Array.make Proc.num_register_classes 0;
(* The following methods must or can be overridden by the processor
description *)
method is_immediate : Mach.integer_operation -> int -> bool
- (* Must be overriden to indicate whether a constant is a suitable
+ (* Must be overridden to indicate whether a constant is a suitable
immediate operand to the given integer arithmetic instruction.
The default implementation handles shifts by immediate amounts,
but produces no immediate operations otherwise. *)
above; overloading this is useful if Ispecific instructions need
marking *)
- (* The following method is the entry point and should not be overridden. *)
- method emit_fundecl : Cmm.fundecl -> Mach.fundecl
+ (* The following method is the entry point and should not be overridden *)
+ method emit_fundecl : future_funcnames:Misc.Stdlib.String.Set.t
+ -> Cmm.fundecl -> Mach.fundecl
(* The following methods should not be overridden. They cannot be
declared "private" in the current implementation because they
are not always applied to "self", but ideally they should be private. *)
+ method extract_onto : Mach.instruction -> Mach.instruction
method extract : Mach.instruction
method insert :
environment -> Mach.instruction_desc -> Reg.t array -> Reg.t array -> unit
(* Selection of pseudo-instructions, assignment of pseudo-registers,
sequentialization. *)
-val fundecl: Cmm.fundecl -> Mach.fundecl
+val fundecl: future_funcnames:Misc.Stdlib.String.Set.t
+ -> Cmm.fundecl -> Mach.fundecl
(fun r i -> instr_cons (Iop Ireload) [|spill_reg r|] [|r|] i)
regset i
-let reload_at_exit = ref []
+let reload_at_exit : (int, Reg.Set.t) Hashtbl.t = Hashtbl.create 20
-let find_reload_at_exit k =
- try
- List.assoc k !reload_at_exit
- with
- | Not_found -> Misc.fatal_error "Spill.find_reload_at_exit"
+let get_reload_at_exit k =
+ match Hashtbl.find_opt reload_at_exit k with
+ | None -> Reg.Set.empty
+ | Some s -> s
+
+let set_reload_at_exit k s =
+ Hashtbl.replace reload_at_exit k s
let rec reload i before =
incr current_date;
let date_ifso = !current_date in
current_date := date_fork;
let (new_ifnot, after_ifnot) = reload ifnot at_fork in
- current_date := max date_ifso !current_date;
+ current_date := Int.max date_ifso !current_date;
let (new_next, finally) =
reload i.next (Reg.Set.union after_ifso after_ifnot) in
let new_i =
current_date := date_fork;
let (new_c, after_c) = reload c at_fork in
after_cases := Reg.Set.union !after_cases after_c;
- date_join := max !date_join !current_date;
+ date_join := Int.max !date_join !current_date;
new_c)
cases in
current_date := !date_join;
i.arg i.res new_next),
finally)
| Icatch(rec_flag, handlers, body) ->
- let new_sets = List.map
- (fun (nfail, _) -> nfail, ref Reg.Set.empty) handlers in
- let previous_reload_at_exit = !reload_at_exit in
- reload_at_exit := new_sets @ !reload_at_exit ;
let (new_body, after_body) = reload body before in
let rec fixpoint () =
- let at_exits = List.map (fun (nfail, set) -> (nfail, !set)) new_sets in
+ let at_exits =
+ List.map (fun (nfail, _) -> (nfail, get_reload_at_exit nfail))
+ handlers in
let res =
- List.map2 (fun (nfail', handler) (nfail, at_exit) ->
+ List.map2
+ (fun (nfail', handler) (nfail, at_exit) ->
assert(nfail = nfail');
- reload handler at_exit) handlers at_exits in
+ reload handler at_exit)
+ handlers at_exits in
match rec_flag with
| Cmm.Nonrecursive ->
res
| Cmm.Recursive ->
- let equal = List.for_all2 (fun (nfail', at_exit) (nfail, new_set) ->
- assert(nfail = nfail');
- Reg.Set.equal at_exit !new_set)
- at_exits new_sets in
+ let equal =
+ List.for_all2
+ (fun (nfail', _) (nfail, at_exit) ->
+ assert(nfail = nfail');
+ Reg.Set.equal at_exit (get_reload_at_exit nfail))
+ handlers at_exits in
if equal
then res
else fixpoint ()
in
let res = fixpoint () in
- reload_at_exit := previous_reload_at_exit;
let union = List.fold_left
(fun acc (_, after_handler) -> Reg.Set.union acc after_handler)
after_body res in
(Icatch(rec_flag, new_handlers, new_body)) i.arg i.res new_next,
finally)
| Iexit nfail ->
- let set = find_reload_at_exit nfail in
- set := Reg.Set.union !set before;
+ set_reload_at_exit nfail
+ (Reg.Set.union (get_reload_at_exit nfail) before);
(i, Reg.Set.empty)
| Itrywith(body, handler) ->
let (new_body, after_body) = reload body before in
NB ter: is it the same thing for catch bodies ?
*)
-(* CR mshinwell for pchambart: Try to test the new algorithms for dealing
- with Icatch. *)
+let spill_at_exit : (int, Reg.Set.t) Hashtbl.t = Hashtbl.create 20
-let spill_at_exit = ref []
-let find_spill_at_exit k =
- try
- let used, set = List.assoc k !spill_at_exit in
- used := true;
- set
- with
- | Not_found -> Misc.fatal_error "Spill.find_spill_at_exit"
+let get_spill_at_exit k =
+ match Hashtbl.find_opt spill_at_exit k with
+ | None -> Reg.Set.empty
+ | Some s -> s
+
+let set_spill_at_exit k s =
+ Hashtbl.replace spill_at_exit k s
let spill_at_raise = ref Reg.Set.empty
let inside_loop = ref false
let before1 = Reg.diff_set_array after i.res in
(instr_cons i.desc i.arg i.res new_next,
Reg.add_set_array before1 i.res)
- | Iop _ ->
+ | Iop op ->
let (new_next, after) = spill i.next finally in
let before1 = Reg.diff_set_array after i.res in
let before =
- match i.desc with
- Iop(Icall_ind) | Iop(Icall_imm _) | Iop(Iextcall _) | Iop(Ialloc _)
- | Iop(Iintop (Icheckbound)) | Iop(Iintop_imm(Icheckbound, _)) ->
- Reg.Set.union before1 !spill_at_raise
- | _ ->
- before1 in
+ if operation_can_raise op
+ then Reg.Set.union before1 !spill_at_raise
+ else before1 in
(instr_cons_debug i.desc i.arg i.res i.dbg
(add_spills (Reg.inter_set_array after i.res) new_next),
before)
let (new_next, at_join) = spill i.next finally in
let saved_inside_catch = !inside_catch in
inside_catch := true ;
- let previous_spill_at_exit = !spill_at_exit in
- let spill_at_exit_add at_exits = List.map2
- (fun (nfail,_) at_exit -> nfail, (ref false, at_exit))
- handlers at_exits
- in
- let rec fixpoint at_exits =
- let spill_at_exit_add = spill_at_exit_add at_exits in
- spill_at_exit := spill_at_exit_add @ !spill_at_exit;
+ let rec fixpoint () =
let res =
- List.map (fun (_, handler) -> spill handler at_join) handlers
- in
- spill_at_exit := previous_spill_at_exit;
- match rec_flag with
- | Cmm.Nonrecursive ->
- res
- | Cmm.Recursive ->
- let equal =
- List.for_all2
- (fun (_new_handler, new_at_exit) (_, (used, at_exit)) ->
- Reg.Set.equal at_exit new_at_exit || not !used)
- res spill_at_exit_add in
- if equal
- then res
- else fixpoint (List.map snd res)
+ List.map (fun (_, handler) -> spill handler at_join) handlers in
+ let update changed (k, _handler) (_new_handler, before_handler) =
+ if Reg.Set.equal before_handler (get_spill_at_exit k)
+ then changed
+ else (set_spill_at_exit k before_handler; true) in
+ let changed =
+ List.fold_left2 update false handlers res in
+ if rec_flag = Cmm.Recursive && changed
+ then fixpoint ()
+ else res
in
- let res = fixpoint (List.map (fun _ -> Reg.Set.empty) handlers) in
+ let res = fixpoint () in
inside_catch := saved_inside_catch ;
- let spill_at_exit_add = spill_at_exit_add (List.map snd res) in
- spill_at_exit := spill_at_exit_add @ !spill_at_exit;
let (new_body, before) = spill body at_join in
- spill_at_exit := previous_spill_at_exit;
let new_handlers = List.map2
- (fun (nfail, _) (handler, _) -> nfail, handler)
+ (fun (nfail, _) (new_handler, _) -> (nfail, new_handler))
handlers res in
(instr_cons (Icatch(rec_flag, new_handlers, new_body))
i.arg i.res new_next,
before)
| Iexit nfail ->
- (i, find_spill_at_exit nfail)
+ (i, get_spill_at_exit nfail)
| Itrywith(body, handler) ->
let (new_next, at_join) = spill i.next finally in
let (new_handler, before_handler) = spill handler at_join in
spill_env := Reg.Map.empty;
use_date := Reg.Map.empty;
current_date := 0;
- destroyed_at_fork := []
+ destroyed_at_fork := [];
+ Hashtbl.clear reload_at_exit;
+ Hashtbl.clear spill_at_exit
let fundecl f =
reset ();
-
let (body1, _) = reload f.fun_body Reg.Set.empty in
let (body2, tospill_at_entry) = spill body1 Reg.Set.empty in
let new_body =
add_spills (Reg.inter_set_array tospill_at_entry f.fun_args) body2 in
- spill_env := Reg.Map.empty;
- use_date := Reg.Map.empty;
- destroyed_at_fork := [];
+ reset ();
{ fun_name = f.fun_name;
fun_args = f.fun_args;
fun_body = new_body;
[]
| y :: ys ->
if cmp x y = 0 then
- uniq1 compare x ys
+ uniq1 cmp x ys
else
y :: uniq1 cmp y ys
accu
| Cons (x, xs) ->
f x (foldr f xs accu)
-
end
module Convert = struct
(******************************************************************************)
| Rejected
(* [offer] allows the user to resume the parser after it has suspended
- itself with a checkpoint of the form [InputNeeded env]. [offer] expects the
- old checkpoint as well as a new token and produces a new checkpoint. It does not
- raise any exception. *)
+ itself with a checkpoint of the form [InputNeeded env]. [offer] expects
+ the old checkpoint as well as a new token and produces a new checkpoint.
+ It does not raise any exception. *)
val offer:
'a checkpoint ->
(* [resume] allows the user to resume the parser after it has suspended
itself with a checkpoint of the form [AboutToReduce (env, prod)] or
- [HandlingError env]. [resume] expects the old checkpoint and produces a new
- checkpoint. It does not raise any exception. *)
+ [HandlingError env]. [resume] expects the old checkpoint and produces a
+ new checkpoint. It does not raise any exception. *)
+
+ (* The optional argument [strategy] influences the manner in which [resume]
+ deals with checkpoints of the form [ErrorHandling _]. Its default value
+ is [`Legacy]. It can be briefly described as follows:
+
+ - If the [error] token is used only to report errors (that is, if the
+ [error] token appears only at the end of a production, whose semantic
+ action raises an exception) then the simplified strategy should be
+ preferred. (This includes the case where the [error] token does not
+ appear at all in the grammar.)
+
+ - If the [error] token is used to recover after an error, or if
+ perfect backward compatibility is required, the legacy strategy
+ should be selected.
+
+ More details on these strategies appear in the file [Engine.ml]. *)
+
+ type strategy =
+ [ `Legacy | `Simplified ]
val resume:
+ ?strategy:strategy ->
'a checkpoint ->
'a checkpoint
type supplier =
unit -> token * position * position
- (* A pair of a lexer and a lexing buffer can be easily turned into a supplier. *)
+ (* A pair of a lexer and a lexing buffer can be easily turned into a
+ supplier. *)
val lexer_lexbuf_to_supplier:
(Lexing.lexbuf -> token) ->
(* [loop supplier checkpoint] begins parsing from [checkpoint], reading
tokens from [supplier]. It continues parsing until it reaches a
checkpoint of the form [Accepted v] or [Rejected]. In the former case, it
- returns [v]. In the latter case, it raises the exception [Error]. *)
+ returns [v]. In the latter case, it raises the exception [Error].
+ The optional argument [strategy], whose default value is [Legacy],
+ is passed to [resume] and influences the error-handling strategy. *)
- val loop: supplier -> 'a checkpoint -> 'a
+ val loop: ?strategy:strategy -> supplier -> 'a checkpoint -> 'a
(* [loop_handle succeed fail supplier checkpoint] begins parsing from
[checkpoint], reading tokens from [supplier]. It continues parsing until
observed first). In the former case, it calls [succeed v]. In the latter
case, it calls [fail] with this checkpoint. It cannot raise [Error].
- This means that Menhir's traditional error-handling procedure (which pops
- the stack until a state that can act on the [error] token is found) does
- not get a chance to run. Instead, the user can implement her own error
- handling code, in the [fail] continuation. *)
+ This means that Menhir's error-handling procedure does not get a chance
+ to run. For this reason, there is no [strategy] parameter. Instead, the
+ user can implement her own error handling code, in the [fail]
+ continuation. *)
val loop_handle:
('a -> 'answer) ->
exception Error
val entry:
+ (* strategy: *) [ `Legacy | `Simplified ] -> (* see [IncrementalEngine] *)
state ->
(Lexing.lexbuf -> token) ->
Lexing.lexbuf ->
(* ------------------------------------------------------------------------ *)
+ (* As of 2020/12/16, we introduce a choice between multiple error handling
+ strategies. *)
+
+ (* Regardless of the strategy, when a syntax error is encountered, the
+ function [initiate] is called, a [HandlingError] checkpoint is produced,
+ and (after resuming) the function [error] is called. This function checks
+ whether the current state allows shifting, reducing, or neither, when the
+ lookahead token is [error]. Its behavior, then, depends on the strategy,
+ as follows. *)
+
+ (* In the legacy strategy, which until now was the only strategy,
+
+ - If shifting is possible, then a [Shifting] checkpoint is produced,
+ whose field [please_discard] is [true], so (after resuming) an
+ [InputNeeded] checkpoint is produced, and (after a new token
+ has been provided) the parser leaves error-handling mode and
+ returns to normal mode.
+
+ - If reducing is possible, then one or more reductions are performed.
+ Default reductions are announced via [AboutToReduce] checkpoints,
+ whereas ordinary reductions are performed silently. (It is unclear
+ why this is so.) The parser remains in error-handling mode, so
+ another [HandlingError] checkpoint is produced, and the function
+ [error] is called again.
+
+ - If neither action is possible and if the stack is nonempty, then a
+ cell is popped off the stack, then a [HandlingError] checkpoint is
+ produced, and the function [error] is called again.
+
+ - If neither action is possible and if the stack is empty, then the
+ parse dies with a [Reject] checkpoint. *)
+
+ (* The simplified strategy differs from the legacy strategy as follows:
+
+ - When shifting, a [Shifting] checkpoint is produced, whose field
+ [please_discard] is [false], so the parser does not request another
+ token, and the parser remains in error-handling mode. (If the
+ destination state of this shift transition has a default reduction,
+ then the parser will perform this reduction as its next step.)
+
+ - When reducing, all reductions are announced by [AboutToReduce]
+ checkpoints.
+
+ - If neither shifting [error] nor reducing on [error] is possible,
+ then the parser dies with a [Reject] checkpoint. (The parser does
+ not attempt to pop cells off the stack one by one.)
+
+ This simplified strategy is appropriate when the grammar uses the [error]
+ token in a limited way, where the [error] token always appears at the end
+ of a production whose semantic action raises an exception (whose purpose
+ is to signal a syntax error and perhaps produce a custom message). Then,
+ the parser must not request one token past the syntax error. (In a REPL,
+ that would be undesirable.) It must perform as many reductions on [error]
+ as possible, then (if possible) shift the [error] token and move to a new
+ state where a default reduction will be possible. (Because the [error]
+ token always appears at the end of a production, no other action can
+ exist in that state, so a default reduction must exist.) The semantic
+ action raises an exception, and that is it. *)
+
+ (* Let us note that it is also possible to perform no error handling at
+ all, or to perform customized error handling, by stopping as soon as
+ the first [ErrorHandling] checkpoint appears. *)
+
+ type strategy =
+ [ `Legacy | `Simplified ]
+
+ (* ------------------------------------------------------------------------ *)
+
(* In the code-based back-end, the [run] function is sometimes responsible
for pushing a new cell on the stack. This is motivated by code sharing
concerns. In this interpreter, there is no such concern; [run]'s caller
(* Note that, if [please_discard] was true, then we have just called
[discard], so the lookahead token cannot be [error]. *)
- (* Returning [HandlingError env] is equivalent to calling [error env]
- directly, except it allows the user to regain control. *)
+ (* Returning [HandlingError env] is like calling [error ~strategy env]
+ directly, except it allows the user to regain control and choose an
+ error-handling strategy. *)
if env.error then begin
if log then
(* [error] handles errors. *)
- and error env =
+ and error ~strategy env =
assert env.error;
(* Consult the column associated with the [error] pseudo-token in the
env.current (* determines a row *)
T.error_terminal (* determines a column *)
T.error_value
- error_shift (* shift continuation *)
- error_reduce (* reduce continuation *)
- error_fail (* failure continuation *)
+ (error_shift ~strategy) (* shift continuation *)
+ (error_reduce ~strategy) (* reduce continuation *)
+ (error_fail ~strategy) (* failure continuation *)
env
- and error_shift env please_discard terminal value s' =
-
- (* Here, [terminal] is [T.error_terminal],
- and [value] is [T.error_value]. *)
-
+ and error_shift ~strategy env please_discard terminal value s' =
assert (terminal = T.error_terminal && value = T.error_value);
(* This state is capable of shifting the [error] token. *)
if log then
Log.handling_error env.current;
+
+ (* In the simplified strategy, we change [please_discard] to [false],
+ which means that we won't request the next token and (therefore)
+ we will remain in error-handling mode after shifting the [error]
+ token. *)
+
+ let please_discard =
+ match strategy with `Legacy -> please_discard | `Simplified -> false
+ in
+
shift env please_discard terminal value s'
- and error_reduce env prod =
+ and error_reduce ~strategy env prod =
(* This state is capable of performing a reduction on [error]. *)
if log then
Log.handling_error env.current;
- reduce env prod
- (* Intentionally calling [reduce] instead of [announce_reduce].
- It does not seem very useful, and it could be confusing, to
- expose the reduction steps taken during error handling. *)
- and error_fail env =
+ (* In the legacy strategy, we call [reduce] instead of [announce_reduce],
+ apparently in an attempt to hide the reduction steps performed during
+ error handling. This seems inconsistent, as the default reduction steps
+ are still announced. In the simplified strategy, all reductions are
+ announced. *)
+
+ match strategy with
+ | `Legacy ->
+ reduce env prod
+ | `Simplified ->
+ announce_reduce env prod
+
+ and error_fail ~strategy env =
- (* This state is unable to handle errors. Attempt to pop a stack
- cell. *)
+ (* This state is unable to handle errors. In the simplified strategy, we
+ die immediately. In the legacy strategy, we attempt to pop a stack
+ cell. (This amounts to forgetting part of what we have just read, in
+ the hope of reaching a state where we can shift the [error] token and
+ resume parsing in normal mode. Forgetting past input is not appropriate
+ when the goal is merely to produce a good syntax error message.) *)
+
+ match strategy with
+ | `Simplified ->
+ Rejected
+ | `Legacy ->
+
+ (* Attempt to pop a stack cell. *)
let cell = env.stack in
let next = cell.next in
| _ ->
invalid_arg "offer expects InputNeeded"
- let resume : 'a . 'a checkpoint -> 'a checkpoint = function
+ let resume : 'a . ?strategy:strategy -> 'a checkpoint -> 'a checkpoint =
+ fun ?(strategy=`Legacy) checkpoint ->
+ match checkpoint with
| HandlingError env ->
- Obj.magic error env
+ Obj.magic error ~strategy env
| Shifting (_, env, please_discard) ->
Obj.magic run env please_discard
| AboutToReduce (env, prod) ->
All of the cheating resides in the types assigned to [offer] and [handle]
above. *)
- let rec loop : 'a . supplier -> 'a checkpoint -> 'a =
- fun read checkpoint ->
+ let rec loop : 'a . ?strategy:strategy -> supplier -> 'a checkpoint -> 'a =
+ fun ?(strategy=`Legacy) read checkpoint ->
match checkpoint with
| InputNeeded _ ->
(* The parser needs a token. Request one from the lexer,
checkpoint. Then, repeat. *)
let triple = read() in
let checkpoint = offer checkpoint triple in
- loop read checkpoint
+ loop ~strategy read checkpoint
| Shifting _
| AboutToReduce _
| HandlingError _ ->
(* The parser has suspended itself, but does not need
new input. Just resume the parser. Then, repeat. *)
- let checkpoint = resume checkpoint in
- loop read checkpoint
+ let checkpoint = resume ~strategy checkpoint in
+ loop ~strategy read checkpoint
| Accepted v ->
(* The parser has succeeded and produced a semantic value.
Return this semantic value to the user. *)
(* The parser rejects this input. Raise an exception. *)
raise Error
- let entry (s : state) lexer lexbuf : semantic_value =
+ let entry strategy (s : state) lexer lexbuf : semantic_value =
let initial = lexbuf.Lexing.lex_curr_p in
- loop (lexer_lexbuf_to_supplier lexer lexbuf) (start s initial)
+ loop ~strategy (lexer_lexbuf_to_supplier lexer lexbuf) (start s initial)
(* ------------------------------------------------------------------------ *)
loop_handle succeed fail read checkpoint
| Shifting _
| AboutToReduce _ ->
+ (* Which strategy is passed to [resume] here is irrelevant,
+ since this checkpoint is not [HandlingError _]. *)
let checkpoint = resume checkpoint in
loop_handle succeed fail read checkpoint
| HandlingError _
loop_handle_undo succeed fail read (inputneeded, checkpoint)
| Shifting _
| AboutToReduce _ ->
+ (* Which strategy is passed to [resume] here is irrelevant,
+ since this checkpoint is not [HandlingError _]. *)
let checkpoint = resume checkpoint in
loop_handle_undo succeed fail read (inputneeded, checkpoint)
| HandlingError _
Some env
| AboutToReduce _ ->
(* The parser wishes to reduce. Just follow. *)
+ (* Which strategy is passed to [resume] here is irrelevant,
+ since this checkpoint is not [HandlingError _]. *)
shifts (resume checkpoint)
| HandlingError _ ->
(* The parser fails, which means it rejects the terminal symbol
| Two (_, x1), x2 ->
Two (x1, x2)
-(* [show f buffer] prints the contents of the buffer. The function [f] is
- used to print an element. *)
-
let show f buffer : string =
match !buffer with
| Zero ->
(* In the most likely case, we have read two tokens. *)
Printf.sprintf "after '%s' and before '%s'" (f valid) (f invalid)
-(* [last buffer] returns the last element of the buffer (that is, the invalid
- token). *)
-
let last buffer =
match !buffer with
| Zero ->
| Two (_, invalid) ->
invalid
-(* [wrap buffer lexer] *)
-
open Lexing
let wrap lexer =
update buffer (lexbuf.lex_start_p, lexbuf.lex_curr_p);
token
+let wrap_supplier supplier =
+ let buffer = ref Zero in
+ buffer,
+ fun () ->
+ let (_token, pos1, pos2) as triple = supplier() in
+ update buffer (pos1, pos2);
+ triple
+
(* -------------------------------------------------------------------------- *)
+
+let extract text (pos1, pos2) : string =
+ let ofs1 = pos1.pos_cnum
+ and ofs2 = pos2.pos_cnum in
+ let len = ofs2 - ofs1 in
+ try
+ String.sub text ofs1 len
+ with Invalid_argument _ ->
+ (* In principle, this should not happen, but if it does, let's make this
+ a non-fatal error. *)
+ "???"
+
+let sanitize text =
+ String.map (fun c ->
+ if Char.code c < 32 then ' ' else c
+ ) text
+
+(* If we were willing to depend on [Str], we could implement [compress] as
+ follows:
+
+ let compress text =
+ Str.global_replace (Str.regexp "[ \t\n\r]+") " " text
+
+ *)
+
+let rec compress n b i j skipping =
+ if j < n then
+ let c, j = Bytes.get b j, j + 1 in
+ match c with
+ | ' ' | '\t' | '\n' | '\r' ->
+ let i = if not skipping then (Bytes.set b i ' '; i + 1) else i in
+ let skipping = true in
+ compress n b i j skipping
+ | _ ->
+ let i = Bytes.set b i c; i + 1 in
+ let skipping = false in
+ compress n b i j skipping
+ else
+ Bytes.sub_string b 0 i
+
+let compress text =
+ let b = Bytes.of_string text in
+ let n = Bytes.length b in
+ compress n b 0 0 false
+
+let shorten k text =
+ let n = String.length text in
+ if n <= 2 * k + 3 then
+ text
+ else
+ String.sub text 0 k ^
+ "..." ^
+ String.sub text (n - k) k
+
+let is_digit c =
+ let c = Char.code c in
+ Char.code '0' <= c && c <= Char.code '9'
+
+exception Copy
+
+let expand f text =
+ let n = String.length text in
+ let b = Buffer.create n in
+ let rec loop i =
+ if i < n then begin
+ let c, i = text.[i], i + 1 in
+ loop (
+ try
+ if c <> '$' then raise Copy;
+ let j = ref i in
+ while !j < n && is_digit text.[!j] do incr j done;
+ if i = !j then raise Copy;
+ let k = int_of_string (String.sub text i (!j - i)) in
+ Buffer.add_string b (f k);
+ !j
+ with Copy ->
+ (* We reach this point if either [c] is not '$' or [c] is '$'
+ but is not followed by an integer literal. *)
+ Buffer.add_char b c;
+ i
+ )
+ end
+ else
+ Buffer.contents b
+ in
+ loop 0
+end
+module LexerUtil = struct
+(******************************************************************************)
+(* *)
+(* Menhir *)
+(* *)
+(* François Pottier, Inria Paris *)
+(* Yann Régis-Gianas, PPS, Université Paris Diderot *)
+(* *)
+(* Copyright Inria. All rights reserved. This file is distributed under the *)
+(* terms of the GNU Library General Public License version 2, with a *)
+(* special exception on linking, as described in the file LICENSE. *)
+(* *)
+(******************************************************************************)
+
+open Lexing
+open Printf
+
+let init filename lexbuf =
+ lexbuf.lex_curr_p <- {
+ pos_fname = filename;
+ pos_lnum = 1;
+ pos_bol = 0;
+ pos_cnum = 0
+ };
+ lexbuf
+
+let read filename =
+ let c = open_in filename in
+ let text = really_input_string c (in_channel_length c) in
+ close_in c;
+ let lexbuf = Lexing.from_string text in
+ text, init filename lexbuf
+
+let newline lexbuf =
+ let pos = lexbuf.lex_curr_p in
+ lexbuf.lex_curr_p <- { pos with
+ pos_lnum = pos.pos_lnum + 1;
+ pos_bol = pos.pos_cnum;
+ }
+
+let is_dummy (pos1, pos2) =
+ pos1 == dummy_pos || pos2 == dummy_pos
+
+let range ((pos1, pos2) as range) =
+ if is_dummy range then
+ sprintf "At an unknown location:\n"
+ else
+ let file = pos1.pos_fname in
+ let line = pos1.pos_lnum in
+ let char1 = pos1.pos_cnum - pos1.pos_bol in
+ let char2 = pos2.pos_cnum - pos1.pos_bol in (* yes, [pos1.pos_bol] *)
+ sprintf "File \"%s\", line %d, characters %d-%d:\n"
+ file line char1 char2
+ (* use [char1 + 1] and [char2 + 1] if *not* using Caml mode *)
end
module Printers = struct
(******************************************************************************)
type item =
int * int
+ let low_bits =
+ 10
+
+ let low_limit =
+ 1 lsl low_bits
+
let export t : item =
- (t lsr 7, t mod 128)
+ (t lsr low_bits, t mod low_limit)
let items s =
(* Map [s] to its LR(0) core. *)
end
end
module StaticVersion = struct
-let require_20190924 = ()
+let require_20201216 = ()
end
| Rejected
(* [offer] allows the user to resume the parser after it has suspended
- itself with a checkpoint of the form [InputNeeded env]. [offer] expects the
- old checkpoint as well as a new token and produces a new checkpoint. It does not
- raise any exception. *)
+ itself with a checkpoint of the form [InputNeeded env]. [offer] expects
+ the old checkpoint as well as a new token and produces a new checkpoint.
+ It does not raise any exception. *)
val offer:
'a checkpoint ->
(* [resume] allows the user to resume the parser after it has suspended
itself with a checkpoint of the form [AboutToReduce (env, prod)] or
- [HandlingError env]. [resume] expects the old checkpoint and produces a new
- checkpoint. It does not raise any exception. *)
+ [HandlingError env]. [resume] expects the old checkpoint and produces a
+ new checkpoint. It does not raise any exception. *)
+
+ (* The optional argument [strategy] influences the manner in which [resume]
+ deals with checkpoints of the form [ErrorHandling _]. Its default value
+ is [`Legacy]. It can be briefly described as follows:
+
+ - If the [error] token is used only to report errors (that is, if the
+ [error] token appears only at the end of a production, whose semantic
+ action raises an exception) then the simplified strategy should be
+ preferred. (This includes the case where the [error] token does not
+ appear at all in the grammar.)
+
+ - If the [error] token is used to recover after an error, or if
+ perfect backward compatibility is required, the legacy strategy
+ should be selected.
+
+ More details on these strategies appear in the file [Engine.ml]. *)
+
+ type strategy =
+ [ `Legacy | `Simplified ]
val resume:
+ ?strategy:strategy ->
'a checkpoint ->
'a checkpoint
type supplier =
unit -> token * position * position
- (* A pair of a lexer and a lexing buffer can be easily turned into a supplier. *)
+ (* A pair of a lexer and a lexing buffer can be easily turned into a
+ supplier. *)
val lexer_lexbuf_to_supplier:
(Lexing.lexbuf -> token) ->
(* [loop supplier checkpoint] begins parsing from [checkpoint], reading
tokens from [supplier]. It continues parsing until it reaches a
checkpoint of the form [Accepted v] or [Rejected]. In the former case, it
- returns [v]. In the latter case, it raises the exception [Error]. *)
+ returns [v]. In the latter case, it raises the exception [Error].
+ The optional argument [strategy], whose default value is [Legacy],
+ is passed to [resume] and influences the error-handling strategy. *)
- val loop: supplier -> 'a checkpoint -> 'a
+ val loop: ?strategy:strategy -> supplier -> 'a checkpoint -> 'a
(* [loop_handle succeed fail supplier checkpoint] begins parsing from
[checkpoint], reading tokens from [supplier]. It continues parsing until
observed first). In the former case, it calls [succeed v]. In the latter
case, it calls [fail] with this checkpoint. It cannot raise [Error].
- This means that Menhir's traditional error-handling procedure (which pops
- the stack until a state that can act on the [error] token is found) does
- not get a chance to run. Instead, the user can implement her own error
- handling code, in the [fail] continuation. *)
+ This means that Menhir's error-handling procedure does not get a chance
+ to run. For this reason, there is no [strategy] parameter. Instead, the
+ user can implement her own error handling code, in the [fail]
+ continuation. *)
val loop_handle:
('a -> 'answer) ->
exception Error
val entry:
+ (* strategy: *) [ `Legacy | `Simplified ] -> (* see [IncrementalEngine] *)
state ->
(Lexing.lexbuf -> token) ->
Lexing.lexbuf ->
which internally relies on [lexer] and updates [buffer] on the fly whenever
a token is demanded. *)
+(* The type of the buffer is [(position * position) buffer], which means that
+ it stores two pairs of positions, which are the start and end positions of
+ the last two tokens. *)
+
open Lexing
val wrap:
(lexbuf -> 'token) ->
(position * position) buffer * (lexbuf -> 'token)
+val wrap_supplier:
+ (unit -> 'token * position * position) ->
+ (position * position) buffer * (unit -> 'token * position * position)
+
(* [show f buffer] prints the contents of the buffer, producing a string that
is typically of the form "after '%s' and before '%s'". The function [f] is
used to print an element. The buffer MUST be nonempty. *)
val last: 'a buffer -> 'a
(* -------------------------------------------------------------------------- *)
+
+(* [extract text (pos1, pos2)] extracts the sub-string of [text] delimited
+ by the positions [pos1] and [pos2]. *)
+
+val extract: string -> position * position -> string
+
+(* [sanitize text] eliminates any special characters from the text [text].
+ A special character is a character whose ASCII code is less than 32.
+ Every special character is replaced with a single space character. *)
+
+val sanitize: string -> string
+
+(* [compress text] replaces every run of at least one whitespace character
+ with exactly one space character. *)
+
+val compress: string -> string
+
+(* [shorten k text] limits the length of [text] to [2k+3] characters. If the
+ text is too long, a fragment in the middle is replaced with an ellipsis. *)
+
+val shorten: int -> string -> string
+
+(* [expand f text] searches [text] for occurrences of [$k], where [k]
+ is a nonnegative integer literal, and replaces each such occurrence
+ with the string [f k]. *)
+
+val expand: (int -> string) -> string -> string
+end
+module LexerUtil : sig
+(******************************************************************************)
+(* *)
+(* Menhir *)
+(* *)
+(* François Pottier, Inria Paris *)
+(* Yann Régis-Gianas, PPS, Université Paris Diderot *)
+(* *)
+(* Copyright Inria. All rights reserved. This file is distributed under the *)
+(* terms of the GNU Library General Public License version 2, with a *)
+(* special exception on linking, as described in the file LICENSE. *)
+(* *)
+(******************************************************************************)
+
+open Lexing
+
+(* [init filename lexbuf] initializes the lexing buffer [lexbuf] so
+ that the positions that are subsequently read from it refer to the
+ file [filename]. It returns [lexbuf]. *)
+
+val init: string -> lexbuf -> lexbuf
+
+(* [read filename] reads the entire contents of the file [filename] and
+ returns a pair of this content (a string) and a lexing buffer that
+ has been initialized, based on this string. *)
+
+val read: string -> string * lexbuf
+
+(* [newline lexbuf] increments the line counter stored within [lexbuf]. It
+ should be invoked by the lexer itself every time a newline character is
+ consumed. This allows maintaining a current the line number in [lexbuf]. *)
+
+val newline: lexbuf -> unit
+
+(* [range (startpos, endpos)] prints a textual description of the range
+ delimited by the start and end positions [startpos] and [endpos].
+ This description is one line long and ends in a newline character.
+ This description mentions the file name, the line number, and a range
+ of characters on this line. The line number is correct only if [newline]
+ has been correctly used, as described dabove. *)
+
+val range: position * position -> string
end
module Printers : sig
(******************************************************************************)
and type nonterminal = int
end
module StaticVersion : sig
-val require_20190924 : unit
+val require_20201216: unit
end
(* This generated code requires the following version of MenhirLib: *)
let () =
- MenhirLib.StaticVersion.require_20190924
+ MenhirLib.StaticVersion.require_20201216
module MenhirBasics = struct
| VAL
| UNDERSCORE
| UIDENT of (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
# 22 "parsing/parser.ml"
)
| THEN
| STRUCT
| STRING of (
-# 689 "parsing/parser.mly"
+# 743 "parsing/parser.mly"
(string * Location.t * string option)
# 34 "parsing/parser.ml"
)
| RBRACKET
| RBRACE
| QUOTED_STRING_ITEM of (
-# 693 "parsing/parser.mly"
- (string * Location.t * string * Location.t * string option)
+# 747 "parsing/parser.mly"
+ (string * Location.t * string * Location.t * string option)
# 47 "parsing/parser.ml"
)
| QUOTED_STRING_EXPR of (
-# 691 "parsing/parser.mly"
- (string * Location.t * string * Location.t * string option)
+# 745 "parsing/parser.mly"
+ (string * Location.t * string * Location.t * string option)
# 52 "parsing/parser.ml"
)
| QUOTE
| QUESTION
| PRIVATE
| PREFIXOP of (
-# 675 "parsing/parser.mly"
+# 729 "parsing/parser.mly"
(string)
# 60 "parsing/parser.ml"
)
| PERCENT
| OR
| OPTLABEL of (
-# 668 "parsing/parser.mly"
+# 722 "parsing/parser.mly"
(string)
# 70 "parsing/parser.ml"
)
| MATCH
| LPAREN
| LIDENT of (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
# 88 "parsing/parser.ml"
)
| LETOP of (
-# 633 "parsing/parser.mly"
+# 687 "parsing/parser.mly"
(string)
# 93 "parsing/parser.ml"
)
| LBRACE
| LAZY
| LABEL of (
-# 638 "parsing/parser.mly"
+# 692 "parsing/parser.mly"
(string)
# 113 "parsing/parser.ml"
)
| INT of (
-# 637 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * char option)
# 118 "parsing/parser.ml"
)
| INITIALIZER
| INHERIT
| INFIXOP4 of (
-# 631 "parsing/parser.mly"
+# 685 "parsing/parser.mly"
(string)
# 125 "parsing/parser.ml"
)
| INFIXOP3 of (
-# 630 "parsing/parser.mly"
+# 684 "parsing/parser.mly"
(string)
# 130 "parsing/parser.ml"
)
| INFIXOP2 of (
-# 629 "parsing/parser.mly"
+# 683 "parsing/parser.mly"
(string)
# 135 "parsing/parser.ml"
)
| INFIXOP1 of (
-# 628 "parsing/parser.mly"
+# 682 "parsing/parser.mly"
(string)
# 140 "parsing/parser.ml"
)
| INFIXOP0 of (
-# 627 "parsing/parser.mly"
+# 681 "parsing/parser.mly"
(string)
# 145 "parsing/parser.ml"
)
| IN
| IF
| HASHOP of (
-# 686 "parsing/parser.mly"
+# 740 "parsing/parser.mly"
(string)
# 153 "parsing/parser.ml"
)
| FUN
| FOR
| FLOAT of (
-# 616 "parsing/parser.mly"
+# 670 "parsing/parser.mly"
(string * char option)
# 166 "parsing/parser.ml"
)
| ELSE
| DOWNTO
| DOTOP of (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
# 180 "parsing/parser.ml"
)
| DOT
| DONE
| DOCSTRING of (
-# 709 "parsing/parser.mly"
+# 764 "parsing/parser.mly"
(Docstrings.docstring)
# 188 "parsing/parser.ml"
)
| DO
| CONSTRAINT
| COMMENT of (
-# 708 "parsing/parser.mly"
+# 763 "parsing/parser.mly"
(string * Location.t)
# 195 "parsing/parser.ml"
)
| COLON
| CLASS
| CHAR of (
-# 596 "parsing/parser.mly"
+# 650 "parsing/parser.mly"
(char)
# 206 "parsing/parser.ml"
)
| ASSERT
| AS
| ANDOP of (
-# 634 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
# 219 "parsing/parser.ml"
)
let _eRR =
MenhirBasics.Error
-# 18 "parsing/parser.mly"
+# 25 "parsing/parser.mly"
open Asttypes
mkexp ~loc (mkexp_cons_desc consloc args)
let mkpat_cons_desc consloc args =
- Ppat_construct(mkrhs (Lident "::") consloc, Some args)
+ Ppat_construct(mkrhs (Lident "::") consloc, Some ([], args))
let mkpat_cons ~loc consloc args =
mkpat ~loc (mkpat_cons_desc consloc args)
let ghexp_cons_desc consloc args =
Pexp_construct(ghrhs (Lident "::") consloc, Some args)
let ghpat_cons_desc consloc args =
- Ppat_construct(ghrhs (Lident "::") consloc, Some args)
+ Ppat_construct(ghrhs (Lident "::") consloc, Some ([], args))
let rec mktailexp nilloc = let open Location in function
[] ->
let expecting loc nonterm =
raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
+(* Using the function [not_expecting] in a semantic action means that this
+ syntactic form is recognized by the parser but is in fact incorrect. This
+ idiom is used in a few places to produce ad hoc syntax error messages. *)
+
+(* This idiom should be used as little as possible, because it confuses the
+ analyses performed by Menhir. Because Menhir views the semantic action as
+ opaque, it believes that this syntactic form is correct. This can lead
+ [make generate-parse-errors] to produce sentences that cause an early
+ (unexpected) syntax error and do not achieve the desired effect. This could
+ also lead a completion system to propose completions which in fact are
+ incorrect. In order to avoid these problems, the productions that use
+ [not_expecting] should be marked with AVOID. *)
+
let not_expecting loc nonterm =
raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
-let dotop ~left ~right ~assign ~ext ~multi =
- let assign = if assign then "<-" else "" in
- let mid = if multi then ";.." else "" in
- String.concat "" ["."; ext; left; mid; right; assign]
-let paren = "(",")"
-let brace = "{", "}"
-let bracket = "[", "]"
-let lident x = Lident x
-let ldot x y = Ldot(x,y)
-let dotop_fun ~loc dotop =
- ghexp ~loc (Pexp_ident (ghloc ~loc dotop))
+(* Helper functions for desugaring array indexing operators *)
+type paren_kind = Paren | Brace | Bracket
-let array_function ~loc str name =
- ghloc ~loc (Ldot(Lident str,
- (if !Clflags.unsafe then "unsafe_" ^ name else name)))
+(* We classify the dimension of indices: Bigarray distinguishes
+ indices of dimension 1,2,3, or more. Similarly, user-defined
+ indexing operator behave differently for indices of dimension 1
+ or more.
+*)
+type index_dim =
+ | One
+ | Two
+ | Three
+ | Many
+type ('dot,'index) array_family = {
-let array_get_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "Array" "get"))
-let string_get_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "String" "get"))
+ name:
+ Lexing.position * Lexing.position -> 'dot -> assign:bool -> paren_kind
+ -> index_dim -> Longident.t Location.loc
+ (*
+ This functions computes the name of the explicit indexing operator
+ associated with a sugared array indexing expression.
-let array_set_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "Array" "set"))
-let string_set_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
+ For instance, for builtin arrays, if Clflags.unsafe is set,
+ * [ a.[index] ] => [String.unsafe_get]
+ * [ a.{x,y} <- 1 ] => [ Bigarray.Array2.unsafe_set]
-let multi_indices ~loc = function
- | [a] -> false, a
- | l -> true, mkexp ~loc (Pexp_array l)
+ User-defined indexing operator follows a more local convention:
+ * [ a .%(index)] => [ (.%()) ]
+ * [ a.![1;2] <- 0 ] => [(.![;..]<-)]
+ * [ a.My.Map.?(0) => [My.Map.(.?())]
+ *);
-let index_get ~loc get_fun array index =
- let args = [Nolabel, array; Nolabel, index] in
- mkexp ~loc (Pexp_apply(get_fun, args))
+ index:
+ Lexing.position * Lexing.position -> paren_kind -> 'index
+ -> index_dim * (arg_label * expression) list
+ (*
+ [index (start,stop) paren index] computes the dimension of the
+ index argument and how it should be desugared when transformed
+ to a list of arguments for the indexing operator.
+ In particular, in both the Bigarray case and the user-defined case,
+ beyond a certain dimension, multiple indices are packed into a single
+ array argument:
+ * [ a.(x) ] => [ [One, [Nolabel, <<x>>] ]
+ * [ a.{1,2} ] => [ [Two, [Nolabel, <<1>>; Nolabel, <<2>>] ]
+ * [ a.{1,2,3,4} ] => [ [Many, [Nolabel, <<[|1;2;3;4|]>>] ] ]
+ *);
-let index_set ~loc set_fun array index value =
- let args = [Nolabel, array; Nolabel, index; Nolabel, value] in
- mkexp ~loc (Pexp_apply(set_fun, args))
+}
-let array_get ~loc = index_get ~loc (array_get_fun ~loc)
-let string_get ~loc = index_get ~loc (string_get_fun ~loc)
-let dotop_get ~loc path (left,right) ext array index =
- let multi, index = multi_indices ~loc index in
- index_get ~loc
- (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
- array index
+let bigarray_untuplify = function
+ { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
+ | exp -> [exp]
-let array_set ~loc = index_set ~loc (array_set_fun ~loc)
-let string_set ~loc = index_set ~loc (string_set_fun ~loc)
-let dotop_set ~loc path (left,right) ext array index value=
- let multi, index = multi_indices ~loc index in
- index_set ~loc
- (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
- array index value
+let builtin_arraylike_name loc _ ~assign paren_kind n =
+ let opname = if assign then "set" else "get" in
+ let opname = if !Clflags.unsafe then "unsafe_" ^ opname else opname in
+ let prefix = match paren_kind with
+ | Paren -> Lident "Array"
+ | Bracket -> Lident "String"
+ | Brace ->
+ let submodule_name = match n with
+ | One -> "Array1"
+ | Two -> "Array2"
+ | Three -> "Array3"
+ | Many -> "Genarray" in
+ Ldot(Lident "Bigarray", submodule_name) in
+ ghloc ~loc (Ldot(prefix,opname))
+let builtin_arraylike_index loc paren_kind index = match paren_kind with
+ | Paren | Bracket -> One, [Nolabel, index]
+ | Brace ->
+ (* Multi-indices for bigarray are comma-separated ([a.{1,2,3,4}]) *)
+ match bigarray_untuplify index with
+ | [x] -> One, [Nolabel, x]
+ | [x;y] -> Two, [Nolabel, x; Nolabel, y]
+ | [x;y;z] -> Three, [Nolabel, x; Nolabel, y; Nolabel, z]
+ | coords -> Many, [Nolabel, ghexp ~loc (Pexp_array coords)]
-let bigarray_function ~loc str name =
- ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
+let builtin_indexing_operators : (unit, expression) array_family =
+ { index = builtin_arraylike_index; name = builtin_arraylike_name }
-let bigarray_untuplify = function
- { pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
- | exp -> [exp]
+let paren_to_strings = function
+ | Paren -> "(", ")"
+ | Bracket -> "[", "]"
+ | Brace -> "{", "}"
+
+let user_indexing_operator_name loc (prefix,ext) ~assign paren_kind n =
+ let name =
+ let assign = if assign then "<-" else "" in
+ let mid = match n with
+ | Many | Three | Two -> ";.."
+ | One -> "" in
+ let left, right = paren_to_strings paren_kind in
+ String.concat "" ["."; ext; left; mid; right; assign] in
+ let lid = match prefix with
+ | None -> Lident name
+ | Some p -> Ldot(p,name) in
+ ghloc ~loc lid
+
+let user_index loc _ index =
+ (* Multi-indices for user-defined operators are semicolon-separated
+ ([a.%[1;2;3;4]]) *)
+ match index with
+ | [a] -> One, [Nolabel, a]
+ | l -> Many, [Nolabel, mkexp ~loc (Pexp_array l)]
+
+let user_indexing_operators:
+ (Longident.t option * string, expression list) array_family
+ = { index = user_index; name = user_indexing_operator_name }
-let bigarray_get ~loc arr arg =
- let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
- let bigarray_function = bigarray_function ~loc in
- let get = if !Clflags.unsafe then "unsafe_get" else "get" in
- match bigarray_untuplify arg with
- [c1] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
- [Nolabel, arr; Nolabel, c1]))
- | [c1;c2] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
- [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
- | [c1;c2;c3] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
- [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
- | coords ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
- [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
+let mk_indexop_expr array_indexing_operator ~loc
+ (array,dot,paren,index,set_expr) =
+ let assign = match set_expr with None -> false | Some _ -> true in
+ let n, index = array_indexing_operator.index loc paren index in
+ let fn = array_indexing_operator.name loc dot ~assign paren n in
+ let set_arg = match set_expr with
+ | None -> []
+ | Some expr -> [Nolabel, expr] in
+ let args = (Nolabel,array) :: index @ set_arg in
+ mkexp ~loc (Pexp_apply(ghexp ~loc (Pexp_ident fn), args))
-let bigarray_set ~loc arr arg newval =
- let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
- let bigarray_function = bigarray_function ~loc in
- let set = if !Clflags.unsafe then "unsafe_set" else "set" in
- match bigarray_untuplify arg with
- [c1] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
- [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
- | [c1;c2] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
- [Nolabel, arr; Nolabel, c1;
- Nolabel, c2; Nolabel, newval]))
- | [c1;c2;c3] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
- [Nolabel, arr; Nolabel, c1;
- Nolabel, c2; Nolabel, c3; Nolabel, newval]))
- | coords ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
- [Nolabel, arr;
- Nolabel, ghexp(Pexp_array coords);
- Nolabel, newval]))
+let indexop_unclosed_error loc_s s loc_e =
+ let left, right = paren_to_strings s in
+ unclosed left loc_s right loc_e
let lapply ~loc p1 p2 =
if !Clflags.applicative_functors
type let_binding =
{ lb_pattern: pattern;
lb_expression: expression;
+ lb_is_pun: bool;
lb_attributes: attributes;
lb_docs: docs Lazy.t;
lb_text: text Lazy.t;
type let_bindings =
{ lbs_bindings: let_binding list;
lbs_rec: rec_flag;
- lbs_extension: string Asttypes.loc option;
- lbs_loc: Location.t }
+ lbs_extension: string Asttypes.loc option }
-let mklb first ~loc (p, e) attrs =
+let mklb first ~loc (p, e, is_pun) attrs =
{
lb_pattern = p;
lb_expression = e;
+ lb_is_pun = is_pun;
lb_attributes = attrs;
lb_docs = symbol_docs_lazy loc;
lb_text = (if first then empty_text_lazy
lb_loc = make_loc loc;
}
-let mklbs ~loc ext rf lb =
- {
- lbs_bindings = [lb];
- lbs_rec = rf;
- lbs_extension = ext ;
- lbs_loc = make_loc loc;
- }
-
let addlb lbs lb =
+ if lb.lb_is_pun && lbs.lbs_extension = None then syntax_error ();
{ lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+let mklbs ext rf lb =
+ let lbs = {
+ lbs_bindings = [];
+ lbs_rec = rf;
+ lbs_extension = ext;
+ } in
+ addlb lbs lb
+
let val_of_let_bindings ~loc lbs =
let bindings =
List.map
}
-# 797 "parsing/parser.ml"
+# 835 "parsing/parser.ml"
module Tables = struct
Obj.repr ()
and default_reduction =
- (16, "\000\000\000\000\000\000\002\247\002\246\002\245\002\244\002\243\002\198\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\229\002\228\002\227\002\226\002\225\002\224\002\197\002\223\002\222\002\221\002\220\002\219\002\218\002\217\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\002\204\002\203\002\202\002\201\002\200\002\199\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003<\001\168\001\147\001\165\001\164\001\163\001\169\001\173\000\000\003=\001\167\001\166\001\148\001\171\001\162\001\161\001\160\001\159\001\158\001\156\001\172\001\170\000\000\000\000\000\000\000\220\000\000\000\000\001\151\000\000\000\000\000\000\001\153\000\000\000\000\000\000\001\155\001\177\001\174\001\157\001\149\001\175\001\176\000\000\003;\003:\003>\000\000\000\000\000\024\001B\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\199\001\198\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0037\000\000\0032\000\000\000\000\0034\000\000\0036\000\000\0033\0035\000\000\003-\000\000\003,\003(\0022\000\000\003+\000\000\0023\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001N\000\000\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000\000\000\000\001L\000\000\000\000\001O\001M\001U\000A\002\134\000\000\001\018\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\179\000\000\002e\002f\000\000\002c\002d\000\000\000\000\000\000\000\000\000\000\001e\001d\000\000\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\223\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\016\003\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002h\002g\000\000\000\000\000\000\001\181\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001T\000\000\001S\000\000\001C\001R\000\000\001A\000b\000\030\000\000\000\000\001|\000\025\000\000\000\000\000\000\000\000\003'\000(\000\000\000\000\000\031\000\026\000\000\000\000\000\000\000\201\000\000\000\000\000\000\000\203\002<\002.\000\000\000\"\000\000\002/\000\000\000\000\001\178\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\017\000\000\003\018\000\000\000y\000\000\000\000\000!\000\000\000\000\000\000\000#\000\000\000$\000\000\000&\000\000\000\000\000'\002$\002#\000\000\000\000\000\000\000\000\000\000\000\000\000c\000\000\002\184\000f\000i\000d\002\173\003?\002\174\001\239\002\176\000\000\000\000\002\181\002b\002\183\000\000\000\000\000\000\002\190\002\187\000\000\000\000\000\000\001\236\001\222\000\000\000\000\000\000\000\000\001\226\000\000\001\221\000\000\001\238\002\196\000\000\001\237\000q\001\229\000\000\000o\000\000\002\189\002\188\000\000\001\232\000\000\000\000\001\228\000\000\000\000\001\224\001\223\000\000\002\186\000\000\002j\002i\000\000\000\000\002F\002\185\002\182\000\000\000\000\000\000\000\000\001\183\001-\001.\002l\000\000\002m\002k\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001o\000\000\000\000\000\000\000\000\000\000\000\000\003T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002,\000\000\000\000\002-\000\000\000\000\001n\000\000\000\000\000\000\001K\001t\001J\001r\002 \002\031\000\000\001m\001l\000\000\000\205\000\000\000\000\001^\000\000\000\000\001b\000\000\001\203\001\202\000\000\000\000\001\201\001\200\001a\001_\000\000\001c\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\138\001P\002\143\002\141\000\000\000\000\000\000\002\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\172\000\000\002\171\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\250\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\249\000\240\000\000\000\000\000\000\001~\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\234\000\000\000\235\000\000\000\000\000\000\002\151\000\000\000\000\000\000\002r\002q\000\000\000\000\000\000\000\000\003@\002\153\002\140\002\139\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\183\000\000\000\000\000\000\000\168\000\000\000\000\000\000\002M\002L\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\002\250\000\000\003$\000\000\000\000\003#\000\000\000\000\000\000\000\000\000\000\000\195\000\194\000\244\000\000\002\251\002\252\000\000\000\000\000p\000\000\002\191\002\175\000\000\002\194\000\000\002\193\002\192\000\000\000\000\000\000\000\000\000\000\000\000\000\248\000\000\000\000\002&\000\000\000\000\000\000\000\247\000\000\000\000\000\246\000\245\000\000\000\000\000\000\000\000\000\250\000\000\000\000\000\249\000\000\001\235\000\000\000\000\001\246\000\000\000\000\001\248\000\000\000\000\001\244\001\243\001\241\001\242\000\000\000\000\000\000\000\000\000\000\001\024\000\018\000\252\000\000\000\000\000\000\002t\002s\000\000\000\000\002\130\002\129\000\000\000\000\000\000\000\000\002~\002}\000\000\000\000\002@\000\000\000\000\002|\002{\000\000\000\000\002\128\002\127\002\147\000\000\000\000\000\000\000\000\000\000\002x\000\000\000\000\000\000\000\000\000\000\002v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\"\002!\000\167\000\000\002w\000\000\000\000\002u\000\000\000\000\002y\000\000\000z\000{\000\000\000\000\000\000\000\000\000\138\000\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\198\000\199\000\131\000\000\000\130\000\000\000\000\0010\000\000\0011\001/\002(\000\000\000\000\002)\002'\000\000\000\000\000\000\000\000\000\000\001\003\000\000\000\000\001\004\000\000\000\000\000\170\000\000\001\006\001\005\000\000\000\000\002\155\002\148\000\000\002\164\000\000\002\165\002\163\000\000\002\169\000\000\002\170\002\168\000\000\000\000\002\150\002\149\000\000\000\000\000\000\002\016\000\000\001\197\000\000\000\000\000\000\002I\002\015\000\000\002\159\002\158\000\000\000\000\000\000\001Q\000\000\002\132\000\000\002\133\002\131\000\000\002\157\002\156\000\000\000\000\000\000\002C\002\146\000\000\002\145\002\144\000\000\002\167\002\166\000\128\000\000\000\000\000\000\000\000\000\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\000\000\001X\000\000\000\000\000\000\000k\000\000\000\000\000l\000\000\000\000\000\000\000\000\001v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\225\000\000\000\000\000u\000\000\000\228\000\226\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000~\000m\000\000\000\000\002\014\000\000\000\000\000\251\001\195\000\000\000\237\000\238\001\002\000\000\000\000\000\000\000\000\000\000\001\210\001\204\000\000\001\209\000\000\001\207\000\000\001\208\000\000\001\205\000\000\000\000\001\206\000\000\001\144\000\000\000\000\000\000\001\143\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001s\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\014\003\t\000\000\000\000\003\b\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\128\000\000\002\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\249\000\000\000\000\002N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\146\000\000\000\000\000\000\001\145\000\000\000\000\000\000\000\000\000\000\001g\000\000\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\002\\\000\000\000\000\000\000\002Z\000\000\000\000\000\000\002Y\000\000\001Z\000\000\000\000\000\000\000\000\002_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003H\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\000\000\000\000\000\000\000\000\001{\000\000\001z\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\012\000\000\002\011\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\000\000\000\000\000O\000M\000\000\000R\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000\000\000\000\000\000\000J\000\000\000Q\000P\000\000\000K\000L\000\000\001!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\012\000a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000^\000\000\000`\000_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\n\002`\002R\000\000\002X\002S\002^\002]\002[\001\027\000\000\002P\000\000\000\000\000\000\000\000\000\000\002\029\000\000\000\000\001\020\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\139\001\135\000\000\000\000\000\000\000\210\000\000\000\000\002\019\002\029\000\000\000\000\001\022\002\017\002\018\000\000\000\000\000\000\000\000\000\000\001\142\001\138\001\134\000\000\000\000\000\211\000\000\000\000\001\141\001\137\001\133\001\131\002U\002Q\002a\001\026\001\252\002O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003C\000\000\000\000\003E\000\000\0006\000\000\000\000\003K\000\000\003J\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003B\000\000\000\000\003D\000\000\000\000\000\000\002\007\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001?\000\000\000\000\001=\001;\000\000\0007\000\000\000\000\003N\000\000\003M\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\001<\001:\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000X\000\000\000\000\000\000\000\000\000\000\000\000\0003\000\000\000\000\000W\000\000\0001\000\255\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\253\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\185\000\000\0005\000\000\000\000\000\000\0004\000\000\000\000\000\000\0008\000\000\000Y\000\\\000\000\000:\000;\000\000\001#\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\003\012\003\003\000\000\000\000\003\007\002\248\003\002\003\011\003\n\001\031\000\000\000\000\003\000\000\000\003\004\003\001\003\r\001\251\000\000\000\000\002\254\000\000\000\191\002\253\000\000\000\000\000\222\000\000\000\000\001\030\001\029\000\000\001\\\001[\000\000\000\000\002\195\002\178\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\162\000\000\002\161\002\160\002\142\000\000\000\000\000\000\000\000\002\135\000\000\002\137\000\000\002\136\000\000\002o\002n\000\000\002p\000\000\000\000\000\134\000\000\000\000\002\004\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\006\002\024\002\025\002\020\002\022\002\021\002\023\000\000\000\000\000\000\000\190\000\000\000\000\002\029\000\000\000\214\000\000\000\000\000\000\000\000\003\005\000\000\000\187\000\000\000\000\000\000\000\000\0018\0012\000\000\000\000\0013\000\029\000\000\000\028\000\000\000\000\000\202\000\000\000\000\000\000\000 \000\027\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\000\001\140\001\136\000\000\001\132\003&\000\000\002\029\000\000\000\213\000\000\000\000\000\000\000\000\002W\002\028\002\026\002\027\000\000\000\000\000\000\002\029\000\000\000\212\000\000\000\000\000\000\000\000\002V\000\000\001i\001h\000\000\000\022\000\000\003F\000\000\000+\000\000\000\000\000\000\000\000\000\137\000\000\000\218\000\001\000\000\000\000\000\221\000\002\000\000\000\000\000\000\001E\001F\000\003\000\000\000\000\000\000\000\000\001H\001I\001G\000\019\001D\000\020\000\000\001\211\000\000\000\004\000\000\001\212\000\000\000\005\000\000\001\213\000\000\000\000\001\214\000\006\000\000\000\007\000\000\001\215\000\000\000\b\000\000\001\216\000\000\000\t\000\000\001\217\000\000\000\000\001\218\000\n\000\000\000\000\001\219\000\011\000\000\000\000\000\000\000\000\000\000\003\025\003\020\003\021\003\024\003\022\000\000\003\029\000\012\000\000\003\028\000\000\001%\000\000\000\000\003\026\000\000\003\027\000\000\000\000\000\000\000\000\001)\001*\000\000\000\000\001(\001'\000\r\000\000\000\000\000\000\0039\000\000\0038")
+ (16, "\000\000\000\000\000\000\002\253\002\252\002\251\002\250\002\249\002\204\002\248\002\247\002\246\002\245\002\244\002\243\002\242\002\241\002\240\002\239\002\238\002\237\002\236\002\235\002\234\002\233\002\232\002\231\002\230\002\203\002\229\002\228\002\227\002\226\002\225\002\224\002\223\002\222\002\221\002\220\002\219\002\218\002\217\002\216\002\215\002\214\002\213\002\212\002\211\002\210\002\209\002\208\002\207\002\206\002\205\000\000\000\000\000*\000\186\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003B\001\172\001\151\001\169\001\168\001\167\001\173\001\177\000\000\003C\001\171\001\170\001\152\001\175\001\166\001\165\001\164\001\163\001\162\001\160\001\176\001\174\000\000\000\000\000\000\000\220\000\000\000\000\001\155\000\000\000\000\000\000\001\157\000\000\000\000\000\000\001\159\001\181\001\178\001\161\001\153\001\179\001\180\000\000\003A\003@\003D\000\000\000\000\000\024\001E\000\188\000\000\000\216\000\217\000\023\000\000\000\000\001\203\001\202\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003=\000\000\0038\000\000\000\000\003:\000\000\003<\000\000\0039\003;\000\000\0033\000\000\0032\003.\0027\000\000\0031\000\000\0028\000\000\000\000\000\000\000\000\000j\000\000\000\000\000h\000\000\000\000\001C\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\184\001Q\000\000\000\000\000\000\000\000\000\000\000\000\002\"\000\000\000\000\000\000\000\000\000\000\000\000\000e\000\000\000\000\000\000\000\000\001O\000\000\000\000\001R\001P\001X\000A\002\140\000\000\001\021\000\000\000\000\000\000\000\015\000\014\000\000\000\000\000\000\000\000\002\185\000\000\002k\002l\000\000\002i\002j\000\000\000\000\000\000\000\000\000\000\001h\001g\000\000\002\183\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\223\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\022\003\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000g\000\000\000\231\000\000\002n\002m\000\000\000\000\000\000\001\185\000\000\000\000\000%\000\000\000\000\000\000\000\000\000\000\001W\000\000\001V\000\000\001F\001U\000\000\001D\000b\000\030\000\000\000\000\001\128\000\025\000\000\000\000\000\000\000\000\003-\000(\000\000\000\000\000\031\000\026\000\000\000\000\000\000\000\201\000\000\000\000\000\000\000\203\002A\0023\000\000\000\"\000\000\0024\000\000\000\000\001\182\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\017\003\023\000\000\003\024\000\000\000y\000\000\000\000\000!\000\000\000\000\000\000\000#\000\000\000$\000\000\000&\000\000\000\000\000'\002)\002(\000\000\000\000\000\000\000\000\000\000\000\000\000c\000\000\002\190\000f\000i\000d\002\179\003E\002\180\001\244\002\182\000\000\000\000\002\187\002h\002\189\000\000\000\000\000\000\002\196\002\193\000\000\000\000\000\000\001\240\001\226\000\000\000\000\000\000\000\000\001\230\000\000\001\225\000\000\001\243\002\202\000\000\000\000\000\000\000\000\001\130\000\000\000\000\001\242\002\188\000q\000\000\000\000\000p\000\000\002\197\002\181\000\000\001\236\000\000\000\000\002\200\000\000\002\199\002\198\000\000\001\232\000\000\000\000\001\228\001\227\001\241\001\233\000\000\000o\000\000\002\195\002\194\000\000\002\192\000\000\002p\002o\000\000\000\000\002K\002\191\000\000\000\000\000\000\000\000\001\187\0010\0011\002r\000\000\002s\002q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\204\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001r\000\000\000\000\000\000\000\000\000\000\000\000\003\\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0030\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\000\000\000\001N\001x\001M\001u\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0021\000\000\000\000\0022\002%\002$\000\000\001p\001o\000\000\000\205\000\000\000\000\001a\000\000\000\000\001e\000\000\001\207\001\206\000\000\000\000\001\205\001\204\001d\001b\000\000\001f\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\144\001S\002\149\002\147\000\000\000\000\000\000\002\160\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\178\000\000\002\177\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\255\000\000\000\000\000\000\000\000\000\000\000\000\000\239\001\254\000\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\234\000\000\000\235\000\000\000\000\000\000\002\157\000\000\000\000\000\000\002\128\002w\000\000\000\000\000\000\000\000\003F\002\159\002\146\002\145\000\000\000\000\000\169\000\000\000\000\000\000\000\000\000\000\000\183\000\000\000\000\000\000\000\168\000\000\000\000\000\000\002R\002Q\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\243\000\000\003\000\000\000\003*\000\000\000\000\003)\000\000\000\000\000\000\000\000\000\000\000\195\000\194\000\244\000\000\003\001\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\250\000\000\000\000\002+\000\000\000\000\000\000\000\249\000\000\000\000\000\248\000\247\000\000\000\000\000\000\000\000\000\252\000\000\000\000\000\251\000\000\001\239\000\000\000\000\001\251\000\000\000\000\001\253\000\000\000\000\001\249\001\248\001\246\001\247\000\000\000\000\000\000\000\245\000\000\000\000\001\027\000\018\000\254\000\000\000\000\000\000\002\130\002y\000\000\000\000\002\129\002x\000\000\000\000\000\000\000\000\002\132\002{\000\000\000\000\002E\000\000\000\000\002\136\002\127\000\000\000\000\002\134\002}\002\153\000\000\000\000\000\000\000\000\000\000\002\131\000\000\000\000\000\000\000\000\000\000\002\135\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002'\002&\000\167\000\000\002z\000\000\000\000\002~\000\000\000\000\002|\000\000\000z\000{\000\000\000\000\000\000\000\000\000\138\000\196\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\198\000\199\000\131\000\000\000\130\000\000\000\000\0013\000\000\0014\0012\002-\000\000\000\000\002.\002,\000\000\000\000\000\000\000\000\000\000\001\006\000\000\000\000\001\007\000\000\000\000\000\170\000\000\001\t\001\b\000\000\000\000\002\161\002\154\000\000\002\170\000\000\002\171\002\169\000\000\002\175\000\000\002\176\002\174\000\000\000\000\002\156\002\155\000\000\000\000\000\000\002\021\000\000\001\201\000\000\000\000\000\000\002N\002\020\000\000\002\165\002\164\000\000\000\000\000\000\001T\000\000\002\138\000\000\002\139\002\137\000\000\002\163\002\162\000\000\000\000\000\000\002H\002\152\000\000\002\151\002\150\000\000\002\173\002\172\000\128\000\000\000\000\000\000\000\000\000\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\000\000\001[\000\000\000\000\000\000\000k\000\000\000\000\000l\000\000\000\000\000\000\000\000\001z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\225\000\000\000\000\000u\000\000\000\228\000\226\000\000\000\000\000\000\000\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000~\000m\000\000\000\000\002\019\000\000\000\000\000\253\001\199\000\000\000\237\000\238\001\004\000\000\000\000\000\000\000\000\000\000\001\214\001\208\000\000\001\213\000\000\001\211\000\000\001\212\000\000\001\209\000\000\000\000\001\210\000\000\001\148\000\000\000\000\000\000\001\147\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\017\003\015\000\000\000\000\003\014\000\000\000\000\000\000\000\000\000\000\002\004\000\000\000\000\000\000\000\000\000\000\000\000\003\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\132\000\000\002\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\255\000\000\000\000\002S\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\150\000\000\000\000\000\000\001\149\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\000\000\000\000\000\000\001j\000\000\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\019\002a\000\000\000\000\000\000\002_\000\000\000\000\000\000\002^\000\000\001]\000\000\000\000\000\000\000\000\002e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003N\000\000\000\000\000\000\000\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000E\000\000\000\000\000\000\000\000\001\127\000\000\001~\000\000\000\000\000\000\000\000\000H\000\000\000\000\000\000\002\017\000\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\000\000\000\000\000\000\000O\000M\000\000\000R\000\000\000\000\000\000\000\000\000\000\000G\000\000\000\000\000\000\000\000\000\000\000\000\000J\000\000\000Q\000P\000\000\000K\000L\000\000\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\015\000a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000^\000\000\000`\000_\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\r\002f\002W\000\000\002]\002X\002d\002c\002b\002`\001\030\000\000\002U\000\000\000\000\000\000\000\000\000\000\002\"\000\000\000\000\001\023\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\143\001\139\000\000\000\000\000\000\000\210\000\000\000\000\002\024\002\"\000\000\000\000\001\025\002\022\002\023\000\000\000\000\000\000\000\000\000\000\001\146\001\142\001\138\000\000\000\000\000\211\000\000\000\000\001\145\001\141\001\137\001\135\002Z\002V\002g\001\029\002\001\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003I\000\000\000\000\003K\000\000\0006\000\000\000\000\003Q\000\000\003P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003H\000\000\000\000\003J\000\000\000\000\000\000\002\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\001@\001>\000\000\0007\000\000\000\000\003T\000\000\003S\000\000\000\000\000\000\001<\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001A\000\000\000\000\001?\001=\000\000\000\000\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000X\000\000\000\000\000\000\000\000\000\000\000\000\0003\000\000\000\000\000W\000\000\0001\001\001\000\000\000@\000-\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\255\000\000\000V\000U\000\000\000\000\000[\000Z\000\000\000\000\001\189\000\000\0005\000\000\000\000\000\000\0004\000\000\000\000\000\000\0008\000\000\000Y\000\\\000\000\000:\000;\000\000\001&\000\000\000\000\000\000\000\000\000\000\000\000\000>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\011\003\018\003\t\000\000\000\000\003\r\002\254\003\b\003\017\003\016\001\"\000\000\000\000\003\006\000\000\003\n\003\007\003\019\002\000\000\000\000\000\003\004\000\000\000\191\003\003\000\000\000\000\000\222\000\000\000\000\001!\001 \000\000\001_\001^\000\000\000\000\002\201\002\184\000\000\000B\000\000\000\000\000C\000\000\000\000\000\142\000\141\002\168\000\000\002\167\002\166\002\148\000\000\000\000\000\000\000\000\002\141\000\000\002\143\000\000\002\142\000\000\002u\002t\000\000\002v\000\000\000\000\000\134\000\000\000\000\002\t\000\215\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\000\003\012\002\029\002\030\002\025\002\027\002\026\002\028\000\000\000\000\000\000\000\190\000\000\000\000\002\"\000\000\000\214\000\000\000\000\000\000\000\000\003\011\000\000\000\187\000\000\000\000\000\000\000\000\001;\0015\000\000\000\000\0016\000\029\000\000\000\028\000\000\000\000\000\202\000\000\000\000\000\000\000 \000\027\000\000\000\000\000\000\000\021\000\000\000\000\000\000\000\000\001\144\001\140\000\000\001\136\003,\000\000\002\"\000\000\000\213\000\000\000\000\000\000\000\000\002\\\002!\002\031\002 \000\000\000\000\000\000\002\"\000\000\000\212\000\000\000\000\000\000\000\000\002[\000\000\001l\001k\000\000\000\022\000\000\003L\000\000\000+\000\000\000\000\000\000\000\000\000\137\000\000\000\218\000\001\000\000\000\000\000\221\000\002\000\000\000\000\000\000\001H\001I\000\003\000\000\000\000\000\000\000\000\001K\001L\001J\000\019\001G\000\020\000\000\001\215\000\000\000\004\000\000\001\216\000\000\000\005\000\000\001\217\000\000\000\000\001\218\000\006\000\000\000\007\000\000\001\219\000\000\000\b\000\000\001\220\000\000\000\t\000\000\001\221\000\000\000\000\001\222\000\n\000\000\000\000\001\223\000\011\000\000\000\000\000\000\000\000\000\000\003\031\003\026\003\027\003\030\003\028\000\000\003#\000\012\000\000\003\"\000\000\001(\000\000\000\000\003 \000\000\003!\000\000\000\000\000\000\000\000\001,\001-\000\000\000\000\001+\001*\000\r\000\000\000\000\000\000\003?\000\000\003>")
and error =
- (124, "'\225 \197\138\173\2433\208\020\015\228\000\003\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224}\246D\b/\227P\000L\028\030\227\139\002\131@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235f\245\155\175\2437\252\149\031\226\017\007\158\007\223d@\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241'\208\004\015\128\000\001\142\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\016(\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\002\012\\ \000\016\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\132\128 \128\b \002\020\000\016\000b\000\002\000\bH\002\b\000\130\000!\000\001\000\006 \000 \000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\bH\002(\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\001\000\012\\(\000\016\b\002\000\001\000\003\000\bp\016 \197\194\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001f\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bP\t\026\000\001$!\192\192\018\001!\018\000\016}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\0000\000\002H\000L\000\000\b\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\253\155\239\247\255\252\157?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\136G\226\173\245#\211\230/\144@\025\174\184\018\016\132@\b\012\0189\000\000\024\000\000\024\192#a\000E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\004\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136G\224,\229\"\211\227!\176@\025,\184\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\131\000\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\167\225 \197\138\173\2437\208\020\015\226\000\003\142\n~\018\012X\170\2233=\001@\254 \0008\224\167\225\"\197\138\173\2433\208\020\015\230\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\005\002\000@\000\000\129\000\000\000\016\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004\\(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\020@\003!\002@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\003\000\002p\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\128\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\184\000\131!!\192\193\018\007`\022!\022\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\011\184\000\131!!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000@\000\000@\000\002\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\002\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000 \000\000\000\017 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\184\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\003!\000@\192\004\193&\144\001\001\128\000\001\004\0002\016\004\b\000L\018i\000\016\024\000\000\016@\003!\000@\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\193&\176\001\001\148 mU\000\000\016\000\b\000@\000\001\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\145\181\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\132\b\000L\018-\000\016\026\000\000\144@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\128\020\193&\208\001\001\180\000MU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\017\180\b\001L\018m\000\016\027@\004\213P\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\128\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016$\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\018\000\000\000\000\004\000\000\000\000\000HQ\b2\016$\b\000L\018-\000\016\026\000\000\020@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\016\000\000\004\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\001\001\144\000M\021\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016D\012\130L\018m\000\016\026\000\000\016@\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000@\b\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\0000\000\007\129\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\001@0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\001\"\001LH\002\168\000\131\001!\192\001\016\007`\018 \004\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\016\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\016\"\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\000&\000@P \132\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\016&\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\002E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\000@\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\001!\000D\000\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000#a\000E\194\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018}\000@\248 \000\024\224#a\000E\130\141\241#\208\004\015\130\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\004\000\b\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b2\016\132\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\144\005\r\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\002\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b:\024\132~\002\206R->2\027\004\001\146\203\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\004\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\193\"\176\001\001\128\000\005\004\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\196\148\187\131\232>\022\028\015\251`w\219~p\240\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\240\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\207\196\148\187\131\232>\022\028\015\251`w\219~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\188~\171\255s\253\255\214\255x\183\255\239}\246D\b/\227P\000L\028\030\227\139\002\131B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193&\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\003)\000P\144\004\193&\176\001\001\144\000m\021\b:\024\132~\002\206R->2\027\004\001\146\203\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000%\004\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\000\000\000\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000 \000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000%\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\bH\002(\000\130\001!\128\001\144\006`\000 \004\132\128\"\128\b\"\018\024\012\025\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\129\003\224\012\004\004\003\224 \016\000X 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\176>\000\192@@>\002\001\000\005\134\003\163a\011E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\248\000\t\016>\000\192@@>\002\001\000\005\130\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\b\016>\000\192@@>\002\001\000\005\130\003\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\139\237s\251\255\182\031}\183\255\223\197\189\187\215\248\190\215?\191\249a\247\139\127\252\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b:\024\132~\002\206R->2\027\004\001\146\203\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\193\"\176\001\001\128\000\005\004\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\016@\000\000\001\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\001L\018+\000\016\024\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\016\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2402\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\b#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\018\016\132@\b\012\0189\000\000\024\000\000\024\192\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\028\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\002E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192@\000\000\000\000\000\000\000\000\003\000\000P\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b\016\000\016\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\016>\000\192@@>\006\001\000\005\130\003\128\000\016\000\000\000\000\000\000\000@\000\000\000\000\b\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\144\006`\000 \004\001\000@@\000 \193\000\000\000\016\000\000\000\000\004\000\000\000\000\001\000\000@\000\000\001\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\144\006`\000 \004\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\128\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000@\000\128\000\000\000@\000\003\000\000`\000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\001\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\bX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bX\n(\000\130\005!\192\001\144\006`\016!\004\003\000\000`\000\000\197\194\128\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\bX\002(\000\130\005!\192\001\144\006`\016!\004\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000@\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\004@\128\004\193&\208\001\001\128\000\001\004\0002\016D\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\024\000\000\016@\132\128\"\128\b \018\024\000\025\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\017@\196\148\187\131\232>\022\028\015\249`w\139~p\248\000\b\128>\000\192@@>\002\001\000\007\194\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\000@\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000@\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\007`\000 \000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\001!\192\001\016\006`\000 \000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\003\000\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000 \000\000\000\000@\000\000\000\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\001\002\000@@\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\bH\002(\000\130\t!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\132\129\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000`\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \018\028\000\017\000f\016\002\016\000\016\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000x\002/\001\130\012} \001\016\006\000\000 \000\132\128\"\128\b \002\016\000\016\000f\000\002\000\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\128\001\000\000\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0008\000@\004\000\000\000@\000\000\000\000\000\000\000\003\000\004\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\020\000\b\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\003\000\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\132\128\"\128\b \002\024\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \002\028\000\016\000f\000\006\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\b@\000\b\000\000(!@@\000\000 \016\000\000\132\000\000\128\000\002\130\016\004\000\000\002\001\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\000\b\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\001 \016\000\000\132\000\000\128\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\018\001\000\000\000\016\000\004\000 \005\016`\000\000\000\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000 \000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\004\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002\168\000\130!!\192A\016\007`\016 \004\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\000\b@\000\b\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bX\n\168\000\131\004!\192\001\016\007`\000`\004\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\004\000\000\000\000\000@\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\133\128\170\128\b0B\028\000\017\000v\000\002\000HX\n\168\000\131\004!\192\001\016\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130\000!\192\001\000\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\016\000\016\000f\000\002\000@ \000\002H\000L\000@\b\000\000\000\000\000\128\002\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\016\000\016\000f\000\002\000@ \000\002H\000L\000@\b\000\000\000\000\000\128\002\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\0002\000\007\129\000\012\\(\000\016\b\002\000\001\000\003\000\002p\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bZ\002(\000\130\t!\160\001\016\014`\016 \004\132\128\"\128\012 \018\028\000\017\000f\001\006\016HH\002(\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016!\004\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\132\128\"\128\b \002\016\000\016\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000v\001\002\000@\018\000\000\128\000\b\000(\000\000\b\002\000\001\000\001 \000\000\000\000\128\002\128\000\000\128 \000\016\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\012 \018\028\000\017\000f\001\006\016HH\002(\000\130\001!\192\001\016\006`\016!\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\000\000\000\000\000\000\b\128\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\b@\000\b\000\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\016\012\000\000\002\001\000\000\b@\000\b\000\000 !\000\192\000\000 \016\000\000\b\000\000\000\000@@\004\000\000\000\000\000\000\b\000\000\000\000\000\004\004\000@\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000$\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000$\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\004\000\000\000\000\000\000\b\000\000\000\000\128\000\004\000@\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\003\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\003\128\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000 \r\016`\000\000@\000\000\000\128\001\000\000@\002\000\209\006\000\000\004\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\0002\016D\012\128L\018m\000\016\024\000\000\016@}\246D\b/\227P\000L\028\030\227\139\002\131@2\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\b\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193\"\176\001\001\128\000\001\004\0002\144\005\t\001L\018+\000\016\024\000\000\016@\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\169*\212\024\162\211?\188\017\001\230\001\007\141HZ\146\173A\138-3\251\193\016\030`\016x\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\003!\004@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\b\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\016\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000@0\000\007\001 \r\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000@2\144\005\t\000L\018+\000\016\025\000\000P@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\0002\144\005\t\000L\018+\000\016\025\000\000P@\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\000\006`\000 \000\003!\004@\192\004\193&\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\016\006`\000 \004\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\000\006`\000 \000\132\128\"\128\b \018\016\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\144\006`\000 \004\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007`\002 \004\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\193\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\b\000\000\000\128\004\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\000@\128\004\193\"\208\001\001\160\000\001\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\240\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \018\028\000\017\000v\000\006\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\012 \018\028\000\017\000v\000\006\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\128\b \018\024\000\017\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000 \000\000\000\000\000\000\001\000\000\000\000\000\000\000\002\000\000\000\000\000\003\000\000`\000\000\197\198\000\001 \000 \000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\001\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \002\024\000\016\000v\001\018\000@2\000\007\129\000\012\\(\000\016\b\002\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\132\128\"\128\b \002\024\000\016\000f\000\002\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\000!\000\001\000\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\012\000 \000\000\b\000\000\000\000\128\000\136\007\224,$\000\003\226 \016@\024(\176\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\b\000\b\000~\002\194@\000>\"\001\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000A\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\004\000H\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\002~\018\012X\170\2233=\001P\254@\0008\224\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000Z\018\b\000\130\r!\001\001\016\014@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\000\001\016\006A\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\016\000\016\000`\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\b\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002~\018\012X\170\2233=\001P\254@\0008\224'\225 \197\138\173\2433\208\021\015\228\000\003\142\000H\002\b\000\130\001!\000\001\016\006@\000 \000\004\128 \128\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\128\001\016\006@\000 \000\004\128 \128\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\024\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\001\016\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
+ (124, "'\225 \197\138\173\2433\208\020\015\228\000\003\142\0026\016\004\\(\223\018}\000@\248\000\000\024\224}\246D\b/\227P\000L\028\030\227\139\002\131@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235f\245\155\175\2437\252\149\031\226\017\007\158\007\223d@\130\2545\000\004\193\193\2388\176(4\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241'\208\004\015\128\000\001\142\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\000\000\000\004\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\016(\176\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\002\012\\ \000\016\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\132\128 \128\b \002\020\000\016\000b\000\002\000\bH\002\b\000\130\000!\000\001\000\006 \000 \000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000 \000\002\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\002\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000$\128\004\000\000\000\128\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\bH\002(\000\194\t!\192\001\016\006a\016a\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\000\007\001\000\012\\(\000\016\b\002\000\001\000\003\000\bp\016 \197\194\000\001\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\128\187\128\b2R\028\012\017 v\001f\017`0\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\018\000\002\000\000\000\001\000\016\000\000\000@\000\000\001 \000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bP\t\026\000\001$!\192\192\018\001!\018\000\016}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000$\193\004\192\004\000\128\000\000\000\000\b\0000\000\002H\016L\000@\b\000\000\000\000\000\128\003\000\000$\129\004\192\000\000\128\000\000\000\000\b\0000\000\002H\000L\000\000\b\000\000\000\000\000\128\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004}\246D\b/\227P\000L\028\030\227\139\002\131B~\018-X\170\2233=\001@\254\000\000x\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\175\235w\253\155\239\247\255\252\157?\230!\003\158@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\163a\136G\226\173\245#\211\230/\144@\025\174\184\018\016\132@\b\012\0189\000\000\024\000\000\024\192#a\000E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\004\000(!@\192\000\000 \016\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131!\136G\224,\229\"\211\227!\176@\025,\184\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\131\000\000\000@\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\167\225 \197\138\173\2437\208\020\015\226\000\003\142\n~\018\012X\170\2233=\001@\254 \0008\224\167\225\"\197\138\173\2433\208\020\015\230\000\003\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\005\002\000@\000\000\129\000\000\000\016\000\000\000\000\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004\\(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\128\004\193\"\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\026\000\000\020@\003!\002@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\003\000\002p\016\000\197\194\000\001\000\000\000\000\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\004\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\128\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\184\000\131!!\192\193\018\007`\022!\022\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\011\184\000\131!!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\012X\011\184\000\131%!\192\193\018\007`\022!\022\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000@\000\000@\000\002\000\000\000\001\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\002\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000 \000\000\000\017 \000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000@\000\002\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\003\184\000\131!!\192\193\018\007`\022!\020\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\0000\000\007\001\000\012\\ \000\016\000\000\000\000@\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000 \000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000 \000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\001\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\0002\016\004\b\000L\018-\000\016\026\000\000\016@\003!\000@\192\004\193&\144\001\001\128\000\001\004\0002\016\004\b\000L\018i\000\016\024\000\000\016@\003!\000@\128\004\193\"\144\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147)\027P\144\020\193&\176\001\001\148 mU\000\000\016\000\b\000@\000\001\000\000\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\145\181\t\001L\018o\000\016\027A\006\213P\001\000\000\000\000\000\128\"\128\000\000\000\000\000\000\b2\016\132\b\000L\018-\000\016\026\000\000\144@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\144\000\027\000\000\016\000\004\000\000\000\020\000LQ\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\147!\027@\128\020\193&\208\001\001\180\000MU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t2\017\180\b\001L\018m\000\016\027@\004\213P\131\161\136G\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000@\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\001\000\000\016\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\000\001\176\000\001\000\000@\000\000\001@\004\197\016\128\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\002@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001 \000\000\000\000@\000\000\000\000\004\133\016\131!\002@\128\004\193\"\208\001\001\160\000\001D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\016\000\000\000\000@\000\000\000\000\004\129\016\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\016\000\000\004\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\t\001\144\000M\021\128\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016D\012\130L\018m\000\016\026\000\000\016@\001\002\000@@\000\129\004\000\000\016\000\000\000\b\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\003\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\b\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\000@\b\000\000\000\002\000\000\000\000\000\000\000\000\000\000\003\000\000$\128\004\192\000\000\128\000\000\000\000\b\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\016\000\0000\000\007\129\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\000\"\001@0\000\007\001\000\012\\ \000\016\000\000\000\000\000\196\128*\128\b0\018\028\000\017\000v\001\"\001LH\002\168\000\131\001!\192\001\016\007`\018 \004\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\018 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\001\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\001\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\003 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\000\000\000\000\000\000\000\000\000\000\016\016\016\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\016\"\000@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\t!\192\001\016\007a\002 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012H\002\168\000\131\001!\192\001\016\007`\002 \004\000\128\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\b\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\000&\000@P \132\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\025\000v\016&\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\002E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\128\000\016\000\000\000\000\000\000\000@\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\001!\000D\000\128\193#\144\000\001\128\000\001\140\012\000\001\016\000\000\000\000\000\0000\001\005\002@\000#a\000E\194\141\241'\208\004\015\130\000\001\142\0026\016\004X(\223\018}\000@\248 \000\024\224#a\000E\130\141\241#\208\004\015\130\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\001!\000D\000\128\193#\144\000\001\128\000\001\140\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\223\001\000\000\000\000\000\192#\128\000\000\000\000\000\000\n6\024\132~*\223R=>b\249\004\001\154\235\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\000\000\000\000\004\000\b\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n6\016\132X(\223\018=\000@\248\000\000\024\224\163a\bE\130\141\241#\208\004\015\128\000\001\142\b2\016\132\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\004\000\000\000\016\000L\017\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224#a\000E\194\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018}\000@\248\000\000\024\224#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\016\004\012\000L\018m\000\016\026\000\000\017@\003!\000@\128\004\193&\208\001\001\160\000\001\020\0002\016\004\b\000L\018-\000\016\026\000\000\017@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\001\000\000\000\000\001\000\000@\000\000\000\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\0002\144\005\r\000L\018k\000\016\024\000\000\016@\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\002\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\128\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\001\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b:\024\132~\002\206R->2\027\004\001\146\203\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\193\"\176\001\001\128\000\005\004\0026\016\004X(\223\018=\000@\248\000\000\024\224\003!\000@\192\004\193&\208\001\001\160\000\001\004\0002\016\004\b\000L\018m\000\016\026\000\000\016@\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\018\016\004D\b\012\018y\000\000\024\000\000\024\192\001!\000D\000\128\193'\144\000\001\128\000\001\140\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\196\148\187\131\232>\022\028\015\251`w\219~p\240\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\240\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\012\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\197\189\187\215\248\190\215?\191\251a\247\219\127\252\252IK\184>\131\225a\192\255\182\007}\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237s\251\255\182\031}\183\255\207\196\148\187\131\232>\022\028\015\251`w\219~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\127[\188~\171\255s\253\255\214\255x\183\255\239}\246D\b/\227P\000L\028\030\227\139\002\131B6\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193&\208\001\001\128\000\001\004\0002\016\004\b\000L\018-\000\016\024\000\000\016@\135\169\"\208\152$\211>\176\025\001\246\000o\021H:\024\132~\002\206R->2\027\004\001\146\203\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000%\004\0002\016\004\b\000L\018)\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b0\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\001\144\000\000\000\000@\000\000\001\000\000\000\000\131\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000 \000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\128\000\025\000\000\000\000\004\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000%\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b8\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\193\016\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\131!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000H\017\b2\016\004\b\000L\018-\000\016\026\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\128\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\144\006`\000 \004\132\128\"\128\b\"\018\024\012\025\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\000\000\000\000\000\000\000\000\000\128\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\t\176>\000\192@@>\002\001\000\005\134\003\163a\011E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\016\004@\b\012\0189\000\000\024\000\000\024\192\197\189\187\215\248\190\215?\191\251a\247\219\127\253\240\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\001\000\000\000\000\000\192\002\128\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\b\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\001\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000P\000\000\000\000\000\000\000\000\b\000(\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\2426\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\012[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\197\189\187\215\248\190\223?\191\251a\247\219\127\252\2426\016\004X(\223\018=\000@\248\000\000\024\224\196\148\187\131\232>\022\028\015\249`w\139~p\252[\219\189\127\139\237\243\251\255\182\031}\183\255\207#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\197\189\187\215\248\190\215?\191\251a\247\219\127\253\252[\219\189\127\139\237s\251\255\150\031x\183\255\207\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\131\161\136G\224,\229\"\211\227!\176@\025,\176\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\0002\144\005\t\001L\018+\000\016\024\000\000P@\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\016\000\000\000\001\004\000\000\000\016\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\193\"\176\001\001\128\000\005\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\020\193\"\176\001\001\128\000\005\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\001\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015#a\000E\130\141\241#\208\004\015\128\000\001\142\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\004\129\016#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\1306\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016\004\b\000L\018-\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129!\bD\000\128\193#\144\000\001\128\000\001\140\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\206\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0026\016$X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001!\000D\000\128\193#\144\000\001\128\000\001\140\004\000\000\000\000\000\000\000\000\0000\000\005\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\017\000\000\000\000\000\000\000\000\016\000\000\000\b\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\129\000\001\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\003\000\000P\000\000\000\016\000\000\000\000\012\0028\000\000\000\000\000\000\000\192\000\017\000\000\000\000\000\000\003\000\016P$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\251`w\219~p\240\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\145\003\224\012\004\004\003\224`\016\000X 8\000\001\000\000\000\000\000\000\000\004\000\000\000\000\000\128\000\000\000\000\000@\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\128\004\000\b\000\000\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\004\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\000\000\000\016\000\004\000\000\000\016\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\025\000f\000\002\000@\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000@\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\004\000\b\000\000\000\004\000\0000\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\001\016\000\000\000\000@\000\002\000\000\000\000\016\000\000\017\000\000\000\000\004\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\000\000\000\000\004\000\000 \000\000\000\001\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\162\128\b0R\028\000\025\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\128\162\128\b R\028\000\025\000f\001\002\016@0\000\006\000\000\012\\(\000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\133\128\"\128\b R\028\000\025\000f\001\002\016HX\n(\000\131\005!\192\001\144\006`\016!\004\000\000\000\000\000\000\000\004\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002\016D\b\000L\018m\000\016\024\000\000\016@\003!\004@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\128\000\001\004\bH\002(\000\130\001!\128\001\144\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\148\187\131\232>\022\028\015\249`w\139~p\244\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\020\012IK\184>\131\225a\192\255\150\007x\183\231\015\128\000\136\003\224\012\004\004\003\224 \016\000| 0\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000v\000\002\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000@\000\000\000\000@\000\000\000\000\000\000\000\003\000\004\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@0\000\000\000\000\000\000@\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\001\000\000@\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\0002\016\004\b\000L\018-\000\016\026\000\000\016@\016\000\002\000\000\000\000\004\000\000\000\000\000H\017\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\223d@\130\2545\000\004\193\193\2388\176(4'\225\"\213\138\173\2433\208\020\015\224\000\007\142\000\016 \004\004\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016\000\000\001\000\000\000\000\000\132\128\"\128\b \146\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\192\004\000\000\000\000\000\000\000\000\000\000\000\000\000\012\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\018(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \018\028\000\017\000v\000\006\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\b\000\bH\002(\000\130\001!\192\001\016\006a\000!\000\001\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\132\128\"\128\b \018\028\000\017\000f\000\002\000\bH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \000\132\128\"\128\b \018\024\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\128\"\240\024 \199\210\000\017\000`\000\002\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\001\000\000\000@\000\000\004\000\000\000\000\000\000\b\000\016\000\000\004\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \130\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\128\004\000@\000\000\004\000\000\000\000\000\000\000\000\016\000\000\004\000\004\000@\000\000\000\000\000\000\000\001\000\000\000\000\000@\004\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000v\000\018\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\004\000\000\000\000\004\000\000\000\000\000\000\000\0000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\020\000\b\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\b!\128\001\000\006a\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\003\000\000\000\000\000\000\004\000\000\000\000\000\000\000\0000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\196\128\"\128\b0\002\028\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\016\000\004\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\132\128\"\128\b \002\024\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000@@@ \193\004\000\000\016\000\000\000\000\000\016\004\004\000\002\012\016@\000\001\000\000\000\000\000\001\000@@\000 \193\000\000\000\016\000\000\000\000\012H\002(\000\131\000!\192\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\004\000\b\000`\000\000\b\000\000\000\000\001 \000\000\000\000\128\006\000\000\000\128\000\000\000\000\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\132\128\"\128\012 \002\028\000\016\000f\000\006\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000@\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000 \000\002H\000@\000\000\b\000\000\000\000\000\128\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\b@\000\b\000\000(!@@\000\000 \016\000\000\132\000\000\128\000\002\130\016\004\000\000\002\001\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\016\004\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\000\b\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\001 \016\000\000\132\000\000\128\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\018\001\000\000\000\016\000\004\000 \005\016`\000\000\000\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\b\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000@\000\000\000\000 \000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\004\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\001\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002\168\000\130!!\192A\016\007`\016 \004\132\000\000\128\000\002\002\028\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\198\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\016\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\000\b@\000\b\000\000 !\128@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\004\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000@\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000Q\002\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\bX\n\168\000\131\004!\192\001\016\007`\000`\004\003\000\000`\000\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\001@\000\000\002\000\000\000\000\004\000\000\000\000\000@\016\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\0000\000\006\000\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\133\128\170\128\b0B\028\000\017\000v\000\002\000HX\n\168\000\131\004!\192\001\016\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130\000!\192\001\000\007`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001 \r\\ \000\016\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\000\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\128\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\007`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\016 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\000!\000\001\000\006`\000 \004\002\000\000$\128\004\192\004\000\128\000\000\000\000\b\000 \000\002H\000L\000\000\b\000\000\000\000\000\128\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\003 \000x\016\000\197\194\128\001\000\128 \000\016\0000\000'\001\000\012\\ \000\016\000\000\000\001@\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\133\160\"\128\b \146\026\000\017\000\230\001\002\000HH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\016@\018\000\000\000\000\b\000 \000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\001\002\000HH\002(\000\130\000!\000\001\000\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\007`\016 \004\001 \000\b\000\000\128\002\128\000\000\128 \000\016\000\018\000\000\000\000\b\000(\000\000\b\002\000\001\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\194\001!\192\001\016\006`\016a\004\132\128\"\128\b \018\028\000\017\000f\001\002\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\004\000\000\000\000\000\000\000\000\136\000\000\004\000\004\000`\000\000\000\000\000\000\000\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\130\020\012\000\000\002\001\000\000\b@\000\b\000\000(!\000\192\000\000 \016\000\000\132\000\000\128\000\002\002\016\012\000\000\002\001\000\000\000\128\000\000\000\004\004\000@\000\000\000\000\000\000\128\000\000\000\000\000@@\004\000\000\000\000\000\000\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000@@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\192\192\000\000 \016\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\002@\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\128\000\004\000@\000\000\000\000\000\000\128\000\000\000\b\000\000@\004\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\b\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\128\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\0008\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\001\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\0026\016\004X(\223\018=\000@\248\000\000\024\224\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241'\208\004\015\128\000\001\142\0026\016\004X(\223\018=\000@\248\000\000\024\224\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000@\002\000\209\006\000\000\004\000\000\000\b\000\016\000\004\000 \r\016`\000\000@\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003!\004@\200\004\193&\208\001\001\128\000\001\004\007\223d@\130\2545\000\004\193\193\2388\176(4\003!\004@\128\004\193&\208\001\001\128\000\001\004\0002\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000@\000\000\000\000\000\000\128\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\004\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193&\176\001\001\128\000\001\004\0002\144\005\t\000L\018+\000\016\024\000\000\016@\003)\000P\144\020\193\"\176\001\001\128\000\001\004\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000@\016\000\004\000 \r\016 \000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bZ\146\173A\138-3\251\193\016\030`\016x\212\133\169*\212\024\162\211?\188\017\001\230\001\007\141@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002\168\000\130!!\192\193\016\006`\016`\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\016\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\128*\128\b\"\018\028\012\017\000f\001\006\001@2\016D\b\000L\018-\000\016\024\000\000\016@\003!\000@\128\004\193\"\208\001\001\128\000\001\004\000\000\000\000\000\000\000\000\128\000\128\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\004\000 \r\016 \000\000@\000\000\000\000\132\000\000\128\000\002\002\028\012\000\000\002\001\000\001\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\`\000\016\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\b@\000\b\000\000 !\128\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\128\000\002\002\024\012\000\000\002\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000\192\000\000 \016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003\000\000p\018\000\213\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\001\000\000@\002\000\209\002\000\000\004\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000 \004\003)\000P\144\004\193\"\176\001\001\144\000\005\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\000\002\000HH\002(\000\130\001!\000\001\016\006`\000 \004\b\000\000\000\000\000@\006\000\000\000\000\000\000\000\000\128\000\000\000\000\004\000 \000\000\000\000\000\000\000\000\000\000\000\000\000@\002\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\003)\000P\144\004\193\"\176\001\001\144\000\005\004\bH\002(\000\130\001!\128\001\016\006`\000 \004\132\128\"\128\b \018\016\000\017\000f\000\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\016\000f\000\002\000\0002\016D\012\000L\018m\000\016\024\000\000\016@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\017\000f\000\002\000HH\002(\000\130\001!\128\001\016\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\000\001\016\006`\000 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\016\000f\000\002\000\bH\002(\000\130\001!\000\001\000\006`\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\016\000\025\000f\000\002\000@\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\000\006`\000 \000\132\128\"\128\b \018\016\000\016\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\196\128*\128\b0\146\028\000\017\000v\000\"\000L\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000L\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\128\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b@\000\b\000\000 !\000\192\000\000 \016\000\000\128\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\129\002\000@@\000\129\004\000\000\016\000\000\000\000\000\016 \004\000\000\b\016@\000\001\000\000\000\000\000\001\002\000@\000\000\129\000\000\000\016\000\000\000\000\000\000\000\128\000\000\b\000@\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\016\004\004\000\002\012\016\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\128\000\001\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\128\000\000\000\000\000\000\000\000\000\002@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b2\016\004\b\000L\018-\000\016\026\000\000\017@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012IK\184>\131\225a\192\255\150\007x\183\231\015\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\001 \000\b\000\000\128\002\000\000\000\128\000\000\016\000\018\000\000\000\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\194\001!\192\001\016\007`\000a\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\bH\002(\000\130\001!\192\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\132\128\"\130\b \018\024\000\017\000v\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\024\000\017\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\001!\128\001\016\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\002\000\000\000\000\000\000\000\016\000\000\000\000\000\000\000 \000\000\000\000\0000\000\006\000\000\012\\`\000\018\000\002\000\000\000\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\001\000\000\000\004\000\000\000\018\000\000\000\000\000\003\000\000`\000\000\197\194\000\001 \000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000@\000\000\016\000\000\000\000\004\000\000\000\016\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\128\000\000\000\000@\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0000\000\007\001\000\012\\ \000\016\000\000\000\000\000\000\000\b\000\000\000\000\004\000\000\000\000\000@\000\000\000\000\000\000\004\004\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bH\002(\000\130\001!\192\001\016\006`\016 \004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003 \000x\016\000\197\194\128\001\000\128 \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\000!\128\001\000\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\bH\002( \130\000!\128\001\000\007`\017 \004\003 \000x\016\000\197\194\128\001\000\128 \000\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \002\024\000\016\000f\001\002\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\018\000\000\128\000\b\000 \000\000\b\000\000\001\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\016\bH\002(\000\130\000!\128\001\000\006`\000!\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\b\000\000\016\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\128\"\128\b \018\028\000\017\000f\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \002\016\000\016\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\192\002\000\000\000\128\000\000\000\b\000\b\128~\002\194@\000>\"\001\004\001\130\139\000\000\b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000\128\000\128\007\224,$\000\003\226 \016@\024(\176\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001 \000\000\000\000\128\002\000\000\000\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000p\016\000\197\194\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000#a\000E\130\141\241#\208\004\015\128\000\001\142\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\128\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003!\000@\128\004\193\"\208\001\001\160\000\001\004\000\000\000\000\000\000\000\000@\000\000\000@\004\129\016\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\000\000\000\000\000\192\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\016\000\000\000\016\000\000\000\000\012\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\000\016\000\000\000\000\004\000\000\000\000\000\000\000\000\000\005\161 \128\b \210\016\016\017\000\228\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\016\000\017\000d\016\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\000\001\000\006\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\000\000\000\000\000\128\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\225 \197\138\173\2433\208\021\015\228\000\003\142\002~\018\012X\170\2233=\001P\254@\0008\224\004\128 \128\b \018\016\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\001\016\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\128 \128\b \018\024\000\017\000d\000\002\000\000H\002\b\000\130\001!\000\001\016\006@\000 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000H\002\b\000\130\001!\128\001\016\006@\000 \000\004\128 \128\b \018\016\000\017\000d\000\002\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000@\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000")
and start =
13
and action =
- ((16, "C\170P\226Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021HFf\000\000\000\000\020XFfC\170\020\182\000-\000[\\(\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\238\006\168\000\218\000\000\003\188\t|\000\000\001\208\003\232\nt\000\000\000\244\004\198\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\0046T\016\000\000\000\000\000\000\005.\000\000\000\000\000\000\005\022\005\b\000\000\000\000T\016H\254\020X\021\178^\128\020X\\\142P\226\020XR,\000\000\007\168\000\000Dp\007\214\000\000C\146\000\000\027\158\000\000\000\000\004\246\000\000\005.\000\000\000\000\000\000\002J\000\000C\146\000\000\006&v\246]\160d\194\000\000\132l\134\028\000\000LP_\014\000\000X\\\026\206K\200\005.p\026FfC\170\000\000\000\000P\226\020XS\148Dp\007\012v\246\000\000\128\178FfC\170P\226\020X\000\000\000\000\016x\023\022\001N\b\004\000\000\002\138\b\022\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\164C\170\000\000\000\000P\206\020XZ\024W\200\000\000\004\002\000\000\000\000\005\242\000\000\000\000H\166\004\002\024\138\003\130\0020\000\000\000\000\003\172\000\000\021\178\006\212\006\160\020X\028\254\020XC\170C\170\000\000M\\M\\\020X\028\254A\248\020X\000\000\000\000\000\000P\226\020X\000\000\000\248\000\000W\200y\188zJ\000\000\b\004\000\000\n\196\000\000\000\000A\214T\016\134h\000\000h\142\134h\000\000h\142h\142\000b\006:\0008\000\000\020\190\000\000\007b\000\000\000\000\b\198\000\000\000\000\000\000h\142\005.\000\000\000\000V\222T\016T\132_\014\000\000\000\000N*\000b\000\000\000\000_\014\007\162T\016\000\000O _\014P\022\000\000\000\000\000\000\011\190\000\000h\142\000\000\001\000\1310\000\000T\016\005\216T\016\000\000\022\\\b\150\005.\000\000\000\000\023\224\000\000\006\208\000\000Y\128\011\230\000\000\b\162h\142\012\182\000\000\012\222\000\000\007\200\000\000\000\000\004\184\000\000\000\000\000\000\021 4W\200P\206\020XW\200\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000M:\027v\000\000\000\000\000\000\001\244&\174t<\000\000\000\000P\206\020XW\200\000\000\000\000{hW\200\136.zJ\000\000\136v\000\000W\200\000\000\000\000X\180\000\000\000\000\000\000\n.\000\000\022\168\000\000\000\000z\214\000\000\136\208{\030\000\000\137\018\t\002\000\000\000\000z\214\000\000\004\024\000\000\000\000DHt\200\000\000\000\000\000\000Bn\023|\019\252\023\174\000\000\000\000\000\000\000\000\004\250\000\000\000\000Z\204\b\254\011F\000\017T\016\002\204\011\148\000\000\000\000\t\156\011F\006\172\000\000i\186P\234M\\\020X\028\254\000-\000\018\0020\000\000\n\240\021\178\021\178\000-\000\018\000\018\021\178\000\000jL\0050Dp\b\004\000\236\137`\000\000T\016ebT\016_ f\002T\016\000\144T\016f\156\000\000\000\000\020d\0008_\192\b\022\0008`\024\000\000j\230\0050\000\000\021\178k\128\000\000\b*\t\014`\184\000\000\000\000\000\000\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\007r\028\254\000\000\\\192A\248\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000[\132\000\000\001\200\000\000UP\001\130\005\"\000\000\0226V\170P\226\020XG,P\226\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000Q\150RJM\\\020X\028\254\b`\021\178\000\000\004*\000\000R\254S\178{\182I~T\016\002\128\000\000P\226\020X\000\000u\016\020Xy\188W\200E\178\000\000P\226\020Xw\\\004~\000\000W\200A\012T\016\003x\006\172\011\196\000\000\000\000\000\000H\166\003\138\003\138\000\000\012\154p\156\000\000P\206\020XW\200\025R\000\000P\226\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\012\148\000\000\r\000\000\000\016x\003\224\rX\000\000'\166\000\000\b\196\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\b\020\000\000\000\000\027\014\000\000\028\006\000\000\028\254\000\000\018h\024&\000\000\000\000\000\000Ff\000\000\000\000\000\000\000\000\029\246\000\000\030\238\000\000\031\230\000\000 \222\000\000!\214\000\000\"\206\000\000#\198\000\000$\190\000\000%\182\000\000&\174\000\000'\166\000\000(\158\000\000)\150\000\000*\142\000\000+\134\000\000,~\000\000-v\000\000.n\000\000/f\000\0000^\020XW\200ZJI\146\003\138\014,l\012W\200\000\000\000\000\000\000h\142\000\000\028\018\134\028\000\000\026\"T\016\029\220\r\198\000\000\000\000\000\000\000\000l\012\000\000\000\000\005\242\014\208\000\000B\170\000\000\000\000\135\176\000\000\bB\000\000\000\000K\200\003\138\014\140T\016\b`\000\000\000\000\007\006\005.\000\000T\016\n\146\000\000\000\000\014\244\000\000\000\000\000\000I\190T\016\0118\000\000\000\000\030*\000\000\000\000{\254\000\000\031\"|\138\000\000 \026|\210\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nW\200#\002p\234p\234\000\000\000\000\000\0001V\000\000\t\188\000\000\000\000\000\000q\140\000\000\000\000\002\138\023\248\000\000\b\226\000\000\000\000]bKl\000\000\000\000\n\180\000\000\000\000\000\000\rh\000\000\000\000\000\000\016x\004\216\024\232\000\000\t\218\000\000\005\208\000\0002N\000\000\012\142\000\000\006\200\000\0003F\000\000\015\138\007\192\000\0004>lt\000\000(\158\000\000\n\"\b\184\000\00056\000\000\r\178\t\176\000\0006.\000\000q\150\n\168\000\0007&\005\180\025\016\000\000\nX\011\160\000\0008\030\000\000\r\200\012\152\000\0009\022\000\000\r\172\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\n\210\000\000\000\000\014`\000\000\000\000\015\156\000\000\011\002\000\000\000\000\000\000\015\028\000\000\015*\000\000\000\000J~\003\138\015\218p\156_\014\000b\000\000\000\000p\156\000\000\000\000\000\000p\156\000\000\015\208\000\000\000\000\000\000\000\000\000\000\000\000;\254W\200\000\000\000\000\016\014\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\n\130\000\000\000\000W\200\000\000\000\000}j\011P\000\000\000\000G,\000\000\014\148\000\000\000\000V\020\000\000\014~\000\000\000\000\001\130\011\254\000\000\000\000\0226\022\028\b\004\000\000B>\000\000!,\023\176\021\220\000\000\000\000\014\002\000\000\000\000\001\238\025\030V\180\000\000\025\030\000\000\tX\000\000\000\000\014\142\000\000\000\000g>\t\004\004H\000\000\000\000\012H\000\000\000\000\014\192\000\000\000\000\000\000\020X\028\254\005\168\000\000\000\000\023&\003\130\0020\003\136\028\254w\228\021\178\001B\028\254xb\015\146\000\000\000\000\003\136\000\000H\232\019\248\021\204\000\000\007X\016\"\000\000\016$\000V_\014\006\196\000\000\016\n\015\170K\200\n|T\016\030\128\020F\r\018\004\248\000\000\031x\016\\\000\000\006\196\000\000\000\000\016\130_\014aX\000\000g\144_\014\016Z_\014m\012a\248\001N\016*\000\000\000\000\000\000\020X\128\252\000\000W\200p\234\000\000\000\000\016\156\000\000\000\000\000\000>\230\016\196y\188?\222h<\000\000\000\000HJ\000\000\005\128\000\000L\136\000\000\020X\000\000\021\178\006\026\000\000\128\178\000\000\020X\028\254\128\178\000\000\025D\023\022\001N\005.\130\144\021\178}\248p\234\000\000\005r\t\168\0020\003\136p\234\132\224\003\130\0020\003\136p\234\132\224\000\000\000\000\003\136p\234\000\000FfC\170W\200\027B\000\000\000\000FfC\170M\\\020X\028\254\128\178\000\000\020\182\000-\000[\015\240T\016\0120\016\190\131P\000\000p\234\000\000H\232\019\248\021\204x\186\023\228\0118~,\nZ\016\b\020Xp\234\000\000\020Xp\234\000\000h\142ff\019\134\002\222\001N\0008N\234\000\000\001N\0008N\234\000\000\025D\005r\n\160\0212\bZ\000\000N\234\000\000\0020\016\016\021\178p\234\134\222\003\130\0020\016 \021\178p\234\134\222\000\000\000\000\tX\000\000O\224\000\000\021\178\131\132N\234\000\000\b\242\000\000H\254\020X\021\178p\234\000\000H\232\019\248\021\204rFB\138\026\222\019\170\002\142\000\000\011vC\146\000\017\000\000\016\176\016b\024\196\020XT\184T\016\0120\000\000W\150\001N\005\204\r\216\000\000\n\024\000\000\016\188\016FT\016O(\000\000\0032\004\212\r\218\000\000\n\236\000\000\016\192\016JK\200\r\028T\016K\182O(\000\000UP\020X\024\196\016\232\011\028\001N\000\000\014\012\024\196T\016\012\208\000b\000\000T\016\n$\n\218\000\000\000\000mf\000\000\000\000\014b\024\196m\228O(\000\000\020XT\016\012\226T\016V\\O(\000\000\014\144\000\000\000\000O(\000\000\000\000W\150\000\000p\234\132\238\019\170\002\142\011v\016\218\016\140\024\196p\234\132\238\000\000\000\000\019\170\002\142\011v\016\230\016\138M\252LZ_\014\017\016M\252h\142\020\184\017\030M\252_\014\017 M\252n\132o\004\000\000\129\140\000\000\000\000p\234\134\236\019\170\002\142\011v\017\022\016\162M\252p\234\134\236\000\000\000\000\000\000ff\000\000\000\000\000\000\000\000\000\000\000\000N\234\000\000\133\128\020XDp\017 v\246\000\000\128\178\133\128\000\000\000\000\1358\020XDp\017*\016\188]\160\135\176\006\196\017l\000\000\000\000o\130rF\020X\000\000~\200\021\204\000\000\000\000\128\178\1358\000\000\000\000\000\000y6D\228I\154\006\196\017v\000\000\000\000\000\000rF\020X\000\000\006\196\017z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\168B\138\019\170\002\142\011v\017Xr\182\023\204\020XZ\024j\190\020(\001N\006\196\017Z\011l\000\000\000\000\017\b\000\000\000\000a\152\000\000\007\188\r\230\000\000\r\140\000\000\017`\016\244T\016d\240\017r\011\150\000\000\000\000\017\"\000\000\000\000\020F\0032\014\210\000\000\017~s8\137\172\003\138\017\028T\016\014 \000\000\000\000\017<\000\000\000\000\000\000a\152\000\000\0070\014\246\000\000\r\212\000\000\017\168\0176K\200\000\000\017\180s\186\137\248\003\138\017RT\016\015\024\000\000\000\000\017d\000\000\000\000\000\000\020X\000\000a\152\000\000\020z\020X\023\204\023\204u\168Ff\020X\128\252W\200\021\162\000\000\012V\001N\000\000\014\220\023\204T\016\014\186\b\004\000\000\020XW\200r\182\023\204\rh\023\204\000\000D\142Et\000\000bR\000\000\000\000b\238\000\000\000\000c\138\000\000\014\238\023\204d&\128\252W\200\021\162\000\000\000\"\000\000\000\000M\252\r\026\000\000\000\000d.\017\186\000\000a\152\000\000\023\204d.a\152\000\000\020XT\016a\152\000\000\015\136\000\000\000\000a\152\000\000\000\000j\190\000\000\129\192M\252\017r\023\204\130\\r\182\000\000p\234\133\142\019\170\002\142\011v\017\210r\182p\234\133\142\000\000\000\000\000\000\135\248P\206\000\000\000\000\000\000\000\000\000\000\000\000\132\022p\234\000\000\133\128\000\000\000\000\000\000\000\000p\234\135\248\000\000\018\014\000\000\000\000\132\022\018\020\000\000p\234\135\248\000\000\000\000\015\222\000\000\000\000i4\0032\000\000\000\000DH\000\000T\016\015\n\000\000j\190\015\240\000\000\000\000\000\000\015\156\000\000\000\000\000\000M\\\020X\028\254\006\178\000\000Z8\000\000\007p\000\000\000*\000\000\000\000\0184\000\000\018\\y\188\000\000@\214\018@\000\000\000\000\0182\026R\028B\021\204v0\023\228\020X\000\000\128\178\000\000\000\000\000\000\000\000\000\000\000\000\000\000v8\023\228\020X\000\000\015\190v\246\000\000\128\178\000\000\0184\026R\028B\128\178\000\000\018H\000\000\000\238\014\140\020X`\226\000\000\000\000\028\190y\242\000\000\000\000\017\214\000\000\018.T\016\000\000\015\170\012\166\000b\000\000\000\000T\016\004R\006B\000\000T\016\012\018\006\196\018\\\000\000\000\000\127\"\000\000\000\000]\160\000\000\128\178\000\000\018V\026R\029:N\234\000\000\000\000\000\000\000\000\015\214\127\188]\160\000\000\128\178\000\000\018`\026R\029:N\234\000\000\016\026\000\000\000\000\b\n\000\000p\234\000\000\018t\000\000\000\000\017\230\000\000\017\236\000\000\017\252\000\000\000\000\\\142\018\000\000\000\000\000%\182\\(\018\158\000\000\000\000\000\000\014z\011D]\232\018\164\000\000\000\000\000\000\000\000\000\000\000\000\018\022\000\000\023\228\000\000\018\030\000\000T\016\000\000\t\b\000\000\000\000\018 \000\000\000\000\0008\000\000\003\210\000\000\000\000\000\000\001\214\000\000\016\030\000\000\0180\000\000W\200\022\168\000\000\000\000\012<\018H\000\000\000\000\018B\r$G,\005.\128:\000\000\000\000\000\000\000\000\000\000YL\000\000\000\000\018\234\000\000\138<\000\000\016p\018\236\000\000\018\238\000\000G\224G\224[\190[\190\000\000\000\000p\234[\190\000\000\000\000\000\000p\234[\190\018Z\000\000\018f\000\000"), (16, "\t)\t)\000\006\001\002\001\190\t)\002\186\002\190\t)\002\234\002\130\t)\003\145\t)\018\158\002\246\t)\023\158\t)\t)\t)\025F\t)\t)\t)\001\210\004A\004A\004F\002\250\t)\003>\003B\t\242\t)\001\206\t)\023\162\003F\000\238\002\254\025J\t)\t)\003\214\003\218\t)\003\222\0032\003\234\003\242\006\214\007\018\t)\t)\002\178\001\206\006\242\003:\t)\t)\t)\b\026\b\030\b*\b>\001*\005v\t)\t)\t)\t)\t)\t)\t)\t)\t)\b\178\000\238\t)\015\154\t)\t)\003\145\b\190\b\214\t*\005\130\005\134\t)\t)\t)\r\190\t)\t)\t)\t)\002j\002\154\r\238\t)\006\178\t)\t)\0035\t)\t)\t)\t)\t)\t)\005\138\b2\t)\t)\t)\bJ\004r\t>\0035\t)\t)\t)\t)\012\245\012\245\023\166\n\206\004\154\012\245\n\218\012\245\012\245\000\238\012\245\012\245\012\245\012\245\004A\012\245\012\245\001f\012\245\012\245\012\245\003i\012\245\012\245\012\245\012\245\004A\012\245\015\250\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\007\190\007\030\007R\012\245\004\226\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\004A\012\245\003\238\012\245\012\245\012\245\000\238\007\194\012\245\012\245\012\245\012\245\012\245\012\245\012\245\000\238\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\007\138\012\245\012\245\001j\004A\007.\004A\012\245\012\245\012\245\012\245\012\245\004A\012\245\012\245\012\245\012\245\012\245\000\238\012\245\012\245\0076\012\245\012\245\000\238\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\012\245\b\"\004A\012\245\012\245\012\245\012\245\001\181\001\181\001\181\001f\015Z\001\181\003i\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\015\006\001\181\007\222\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003\134\003\138\001\181\000\238\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\006\246\001\181\001\181\001\181\b\022\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\002f\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\027\187\001\181\001\181\018\142\007\250\007\030\007n\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\202\bb\001\181\005\186\001\181\001\181\007\254\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\182\001\181\001\181\001\181\001\181\001\181\n]\n]\002\225\007\138\r\025\n]\003\149\n]\n]\000\238\n]\n]\n]\n]\001\186\n]\n]\r\025\n]\n]\n]\000\238\n]\n]\n]\n]\002j\n]\000\n\n]\n]\n]\n]\n]\n]\n]\n]\024\222\007\030\b\174\n]\004A\n]\n]\n]\n]\n]\000\238\n]\n]\012\"\n]\003\018\n]\n]\n]\002\225\024\226\n]\n]\n]\n]\n]\n]\n]\004A\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\149\n]\n]\007\138\n]\n]\004A\004A\007\030\004A\n]\n]\n]\n]\n]\004\001\n]\n]\n]\n]\tV\000\238\t\134\n]\005\241\n]\n]\007\202\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\n]\003\146\n]\n]\n]\n]\n]\003\173\003\173\001r\007\138\006\242\003\173\t\022\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\137\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\001\130\003\173\006Z\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\137\007\030\004\001\003\173\004B\003\173\003\173\003\173\003\173\003\173\015J\003\173\003\173\006^\003\173\t\005\003\173\003\173\003\173\005\241\b\146\003\173\003\173\003\173\003\173\003\173\003\173\003\173\015R\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\213\tN\t~\007\138\003\173\003\173\003\150\003^\b\230\027\171\003\173\003\173\003\173\003\173\003\173\004R\003\173\003\173\003\173\003\173\tV\000\238\t\134\003\173\b\"\003\173\003\173\003b\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\003\173\003\161\003\161\018\250\b\234\t\006\003\161\005R\003\161\003\161\t\005\003\161\003\161\003\161\003\161\001\146\003\161\003\161\006\154\003\161\003\161\003\161\002N\003\161\003\161\003\161\003\161\019\002\003\161\001\198\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\b\213\004A\003\161\002R\003\161\003\161\003\161\003\161\003\161\b\029\003\161\003\161\001\218\003\161\007\"\003\161\003\161\003\161\006\237\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004A\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\tN\t~\001\234\003\161\003\161\004A\004A\007\030\007^\003\161\003\161\003\161\003\161\003\161\001\222\003\161\003\161\003\161\003\161\tV\004A\t\134\003\161\004r\003\161\003\161\016v\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\237\003\161\003\161\003\161\003\161\003\161\t\217\t\217\018\206\007\138\b&\t\217\006\158\t\217\t\217\001\238\t\217\t\217\t\217\t\217\000\238\t\217\t\217\006\149\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\004A\t\217\007\222\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006\149\007\030\018\214\t\217\000\238\t\217\t\217\t\217\t\217\t\217\005\217\t\217\t\217\001\206\t\217\012\130\t\217\t\217\t\217\0152\016\146\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\026N\t\217\t\217\007\138\t\217\t\217\r\002\003j\003\018\004A\t\217\t\217\t\217\t\217\t\217\002v\t\217\t\217\t\217\t\217\t\217\000\238\t\217\t\217\004B\t\217\t\217\003n\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\000\238\004A\t\217\t\217\t\217\t\217\t\209\t\209\004\242\001f\003i\t\209\007\005\t\209\t\209\025.\t\209\t\209\t\209\t\209\003\158\t\209\t\209\003\162\t\209\t\209\t\209\003\137\t\209\t\209\t\209\t\209\b\241\t\209\004^\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\007\222\026R\015\162\t\209\001\206\t\209\t\209\t\209\t\209\t\209\005\209\t\209\t\209\000\238\t\209\012\154\t\209\t\209\t\209\022\130\011Z\t\209\t\209\t\209\t\209\t\209\t\209\t\209\000\238\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\006\210\t\209\t\209\022\138\t\209\t\209\002\214\004V\007\030\b\241\t\209\t\209\t\209\t\209\t\209\002\142\t\209\t\209\t\209\t\209\t\209\0252\t\209\t\209\b\021\t\209\t\209\025>\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\t\209\012\185\b\241\t\209\t\209\t\209\t\209\t\225\t\225\021\246\007\138\007\210\t\225\011b\t\225\t\225\006\242\t\225\t\225\t\225\t\225\012\185\t\225\t\225\012\189\t\225\t\225\t\225\000\238\t\225\t\225\t\225\t\225\005F\t\225\004\174\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\012\189\007\030\021\254\t\225\002\190\t\225\t\225\t\225\t\225\t\225\005\209\t\225\t\225\003\022\t\225\012\174\t\225\t\225\t\225\015\138\026\226\t\225\t\225\t\225\t\225\t\225\t\225\t\225\0112\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\017\242\t\225\t\225\007\138\t\225\t\225\003\n\001\206\0116\005J\t\225\t\225\t\225\t\225\t\225\003\026\t\225\t\225\t\225\t\225\t\225\000\238\t\225\t\225\004B\t\225\t\225\002&\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\190\004\214\t\225\t\225\t\225\t\225\t\193\t\193\000\238\0022\007\222\t\193\t\146\t\193\t\193\005\002\t\193\t\193\t\193\t\193\004V\t\193\t\193\000\238\t\193\t\193\t\193\012.\t\193\t\193\t\193\t\193\t\150\t\193\007\154\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006F\t\001\n\162\t\193\0122\t\193\t\193\t\193\t\193\t\193\011N\t\193\t\193\007\158\t\193\012\206\t\193\t\193\t\193\004b\014\254\t\193\t\193\t\193\t\193\t\193\t\193\t\193\b\134\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006\242\t\193\t\193\014\226\t\193\t\193\006\170\006\194\001\002\001\190\t\193\t\193\t\193\t\193\t\193\001\222\t\193\t\193\t\193\t\193\t\193\006U\t\193\t\193\000\238\t\193\t\193\005.\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\t\193\006U\t\001\t\193\t\193\t\193\t\193\t\201\t\201\003\134\003\138\006\242\t\201\012\006\t\201\t\201\027\139\t\201\t\201\t\201\t\201\018B\t\201\t\201\016\218\t\201\t\201\t\201\012z\t\201\t\201\t\201\t\201\001v\t\201\012\n\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\011\202\006\202\016F\t\201\012~\t\201\t\201\t\201\t\201\t\201\0186\t\201\t\201\014\230\t\201\012\226\t\201\t\201\t\201\018\218\t\146\t\201\t\201\t\201\t\201\t\201\t\201\t\201\018B\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\012\202\t\201\t\201\b\193\t\201\t\201\006\026\012.\001\002\001\190\t\201\t\201\t\201\t\201\t\201\003\022\t\201\t\201\t\201\t\201\t\201\006]\t\201\t\201\005\221\t\201\t\201\r\014\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\t\201\006]\000\238\t\201\t\201\t\201\t\201\n\001\n\001\003\134\017\234\011Z\n\001\012J\n\001\n\001\017\146\n\001\n\001\n\001\n\001\004\014\n\001\n\001\017\254\n\001\n\001\n\001\012z\n\001\n\001\n\001\n\001\001\134\n\001\012N\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004\018\019\006\b\193\n\001\rf\n\001\n\001\n\001\n\001\n\001\b\189\n\001\n\001\000\238\n\001\012\246\n\001\n\001\n\001\r\134\0142\n\001\n\001\n\001\n\001\n\001\n\001\n\001\004A\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\015\182\n\001\n\001\011j\n\001\n\001\b!\014N\007\158\000\238\n\001\n\001\n\001\n\001\n\001\002\142\n\001\n\001\n\001\n\001\n\001\006e\n\001\n\001\014:\n\001\n\001\014R\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\n\001\006e\000\238\n\001\n\001\n\001\n\001\t\241\t\241\027F\001\222\006\174\t\241\b\189\t\241\t\241\000\238\t\241\t\241\t\241\t\241\006\190\t\241\t\241\r\138\t\241\t\241\t\241\006\254\t\241\t\241\t\241\t\241\001\150\t\241\002\253\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\004\210\t\002\011\142\t\241\018\150\t\241\t\241\t\241\t\241\t\241\014\134\t\241\t\241\019>\t\241\r\018\t\241\t\241\t\241\011\018\005&\t\241\t\241\t\241\t\241\t\241\t\241\t\241\021\214\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\b\217\t\241\t\241\n\206\t\241\t\241\n\218\015\014\002\190\022\030\t\241\t\241\t\241\t\241\t\241\018\190\t\241\t\241\t\241\t\241\t\241\004A\t\241\t\241\n\206\t\241\t\241\n\218\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\000\238\012\146\t\241\t\241\t\241\t\241\t\233\t\233\001\002\001\190\014\138\t\233\004\214\t\233\t\233\000\238\t\233\t\233\t\233\t\233\001\206\t\233\t\233\012\150\t\233\t\233\t\233\t\"\t\233\t\233\t\233\t\233\b\237\t\233\000\238\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\0056\b\217\017^\t\233\015\018\t\233\t\233\t\233\t\233\t\233\tj\t\233\t\233\019V\t\233\r&\t\233\t\233\t\233\002\154\005>\t\233\t\233\t\233\t\233\t\233\t\233\t\233\023\174\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\003\022\t\233\t\233\015\198\t\233\t\233\023\022\003}\023\178\0266\t\233\t\233\t\233\t\233\t\233\011Z\t\233\t\233\t\233\t\233\t\233\000\238\t\233\t\233\tr\t\233\t\233\012Z\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\001\002\001\190\t\233\t\233\t\233\t\233\t\249\t\249\022\002\012^\019\158\t\249\004\214\t\249\t\249\019^\t\249\t\249\t\249\t\249\012Z\t\249\t\249\012\006\t\249\t\249\t\249\t\130\t\249\t\249\t\249\t\249\004\214\t\249\012J\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\r6\022\142\012\222\t\249\019\026\t\249\t\249\t\249\t\249\t\249\005\213\t\249\t\249\r\"\t\249\r:\t\249\t\249\t\249\023J\014\190\t\249\t\249\t\249\t\249\t\249\t\249\t\249\018\254\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\018\210\t\249\t\249\014\194\t\249\t\249\b\025\021\250\005\225\b%\t\249\t\249\t\249\t\249\t\249\r!\t\249\t\249\t\249\t\249\t\249\n\186\t\249\t\249\n\162\t\249\t\249\012\146\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\n\242\014v\t\249\t\249\t\249\t\249\nI\nI\rr\014\238\019\178\nI\014b\nI\nI\000\238\nI\nI\nI\nI\019J\nI\nI\014z\nI\nI\nI\025\250\nI\nI\nI\nI\014\242\nI\015\026\nI\nI\nI\nI\nI\nI\nI\nI\007n\007\241\022^\nI\004B\nI\nI\nI\nI\nI\023.\nI\nI\015\030\nI\rF\nI\nI\nI\011\022\019\130\nI\nI\nI\nI\nI\nI\nI\022>\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\000\238\nI\nI\007n\nI\nI\022\134\004\213\024\246\b\021\nI\nI\nI\nI\nI\027B\nI\nI\nI\nI\nI\019\182\nI\nI\011F\nI\nI\r-\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\nI\023\"\014f\nI\nI\nI\nI\003\157\003\157\000\238\023\130\023\238\003\157\019^\003\157\003\157\000\238\003\157\003\157\003\157\003\157\025\018\003\157\003\157\007n\003\157\003\157\003\157\011v\003\157\003\157\003\157\003\157\007n\003\157\012\170\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r~\001\206\022\190\003\157\0262\003\157\003\157\003\157\003\157\003\157\024\206\003\157\003\157\001\206\003\157\r\150\003\157\003\157\003\157\025\002\r\158\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\178\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\026\214\tN\t~\025\198\003\157\003\157\r\226\014\014\015f\002\006\003\157\003\157\003\157\003\157\003\157\026\170\003\157\003\157\003\157\003\157\tV\023\242\t\134\003\157\015\142\003\157\003\157\003\254\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\015\170\003\157\003\157\003\157\003\157\003\157\001\237\001\237\026B\025\022\001\222\001\237\015\174\002\190\001\237\015\214\002\130\001\237\tf\001\237\004Y\002\246\001\237\024\210\001\237\001\237\001\237\015\234\001\237\001\237\001\237\001\210\025\006\tn\016\002\002\250\001\237\001\237\001\237\001\237\001\237\tv\001\237\016\022\016B\016V\002\254\017V\001\237\001\237\001\237\001\237\001\237\026\218\0032\001\190\017b\001\237\006\022\001\237\001\237\002\178\002\226\018\006\003:\001\237\001\237\001\237\b\026\b\030\b*\018\030\012f\005v\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\018\166\tN\t~\018\170\001\237\001\237\018\226\018\230\019\014\019\018\005\130\005\134\001\237\001\237\001\237\019:\001\237\001\237\001\237\001\237\012n\019\230\012\190\001\237\019\234\001\237\001\237\020\014\001\237\001\237\001\237\001\237\001\237\001\237\005\138\b2\001\237\001\237\001\237\bJ\004r\020\018\020\"\001\237\001\237\001\237\001\237\n1\n1\0202\020>\020r\n1\020v\002\190\n1\020\194\002\130\n1\n1\n1\020\234\002\246\n1\020\238\n1\n1\n1\020\254\n1\n1\n1\001\210\021N\n1\021n\002\250\n1\n1\n1\n1\n1\n1\n1\021\174\021\210\021\226\002\254\022\n\n1\n1\n1\n1\n1\022\014\0032\001\190\022\026\n1\022*\n1\n1\002\178\022F\022V\003:\n1\n1\n1\b\026\b\030\b*\022j\n1\005v\n1\n1\n1\n1\n1\n1\n1\n1\n1\022\150\n1\n1\022\154\n1\n1\022\166\022\182\022\202\023\190\005\130\005\134\n1\n1\n1\024\022\n1\n1\n1\n1\n1\024>\n1\n1\024\166\n1\n1\024\182\n1\n1\n1\n1\n1\n1\005\138\b2\n1\n1\n1\bJ\004r\025R\025Z\n1\n1\n1\n1\n-\n-\025j\025v\025\218\n-\025\238\002\190\n-\026\030\002\130\n-\n-\n-\026&\002\246\n-\026b\n-\n-\n-\026\138\n-\n-\n-\001\210\026\194\n-\026\242\002\250\n-\n-\n-\n-\n-\n-\n-\026\254\027\006\027\015\002\254\027\031\n-\n-\n-\n-\n-\0272\0032\001\190\027N\n-\027k\n-\n-\002\178\027{\027\151\003:\n-\n-\n-\b\026\b\030\b*\027\203\n-\005v\n-\n-\n-\n-\n-\n-\n-\n-\n-\027\231\n-\n-\027\242\n-\n-\028'\028;\028C\028\127\005\130\005\134\n-\n-\n-\028\135\n-\n-\n-\n-\n-\000\000\n-\n-\000\000\n-\n-\000\000\n-\n-\n-\n-\n-\n-\005\138\b2\n-\n-\n-\bJ\004r\000\000\000\000\n-\n-\n-\n-\0029\0029\000\000\000\000\000\000\0029\000\000\002\190\0029\000\000\002\130\0029\tf\0029\000\000\002\246\0029\000\000\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\tn\000\000\002\250\0029\0029\0029\0029\0029\tv\0029\000\000\000\000\000\000\002\254\004A\0029\0029\0029\0029\0029\000\000\0032\001\190\000\000\0029\000\n\0029\0029\002\178\000\000\000\000\003:\0029\0029\0029\b\026\b\030\b*\000\000\012f\005v\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\173\0029\002\225\0029\0029\004A\006\130\002\190\004A\005\130\005\134\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004A\0029\004\173\0029\0029\004A\0029\0029\0029\0029\0029\0029\005\138\b2\0029\0029\0029\bJ\004r\000\000\004A\0029\0029\0029\0029\004A\007\030\004A\003\n\004A\004A\004A\004A\004A\004A\004A\017\186\004A\000\238\004A\004A\000\000\004A\004A\004A\016\134\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\004A\004A\000\000\000\000\004A\004A\000\238\004A\004A\004A\004A\004A\007\138\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\000\238\004A\004A\004A\004A\004A\004A\004A\004A\b\189\004N\004A\000\000\000\000\004A\004A\004A\000\238\004A\000\n\000\000\004A\004A\004A\004A\004A\004A\004A\004A\004A\000\000\021\198\004A\004A\002\225\002\225\007f\004A\004B\006\233\000\000\004A\004A\000\000\007n\016\138\0226\002\225\000\238\004A\004A\004A\007r\000\000\004A\004A\004A\004A\006\233\000\161\004A\000\161\006\233\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\022\234\000\161\000\161\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\161\000\161\000\161\000\161\000\000\000\161\004R\000\161\000\161\b\189\000\000\000\161\000\161\005\141\000\161\000\161\000\161\000\238\000\161\b\241\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\b\138\000\161\000\161\000\000\000\000\000\161\000\161\002\006\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\002\n\006\233\000\161\015\130\t\029\000\161\002\130\000\161\001\210\000\161\005\141\002\190\000\000\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\000\000\000\000\161\003\154\017\238\t\029\005\141\000\222\000\000\007\002\001\222\000\161\000\000\002\226\000\000\014\150\002\178\000\161\000\161\000\161\000\161\000\000\015\134\000\161\000\161\000\161\000\161\002)\002)\004Y\000\000\003\n\002)\000\000\002\190\002)\015\146\002\130\002)\001b\002)\000\000\002\246\002)\007\006\002)\002)\002)\000\000\002)\002)\002)\001\210\001z\000\000\001\138\002\250\002)\002)\002)\002)\002)\005\134\002)\000\000\000\000\000\000\002\254\b\169\002)\002)\002)\002)\002)\004Y\0032\b.\000\000\002)\000\000\002)\002)\002\178\000\000\006\"\003:\002)\002)\002)\b\026\b\030\b*\tN\t~\005v\002)\002)\002)\002)\002)\002)\002)\002)\002)\006&\tN\t~\b\169\002)\002)\000\000\tV\000\000\t\134\005\130\005\134\002)\002)\002)\000\000\002)\002)\002)\002)\tV\000\000\t\134\002)\b\169\002)\002)\000\000\002)\002)\002)\002)\002)\002)\005\138\b2\002)\002)\002)\bJ\004r\000\238\002\225\002)\002)\002)\002)\002E\002E\002\225\002\225\000\000\002E\000\000\000\000\002E\000\000\b\169\002E\000\000\002E\004\254\000\000\002E\b\169\002E\002E\002E\000\n\002E\002E\002E\000\000\027\215\000\000\000\000\000\n\002E\002E\002E\002E\002E\000\000\002E\002\225\006*\004\169\000\000\005\234\002E\002E\002E\002E\002E\000\000\0066\002\225\000\000\002E\006B\002E\002E\000\000\000\000\002\225\006~\002E\002E\002E\004\169\000\000\006\213\t\025\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\tN\t~\000\000\002E\002E\006\134\014\174\000\000\002\190\006\213\t\025\002E\002E\002E\000\000\002E\002E\002E\002E\tV\002\190\t\134\002E\002\130\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\165\000\000\002E\002E\002E\000\000\021\182\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\022\242\003\n\002A\022\246\003\022\002A\000\000\002\178\002A\000\000\002A\000\000\017\134\002A\023&\002A\002A\002A\tZ\002A\002A\002A\012&\b\165\000\000\000\000\015\146\002A\002A\002A\002A\002A\rj\002A\rv\000\000\012B\0236\012R\002A\002A\002A\002A\002A\b\165\bf\001\190\001*\002A\000\000\002A\002A\005\134\002\225\002\225\014V\002A\002A\002A\014j\014~\014\142\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\tN\t~\b\165\002A\002A\000\n\004\254\000\000\001\206\b\165\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\tV\000\000\t\134\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\174\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002\154\002-\0196\003\022\002-\000\000\002\178\002-\000\000\002-\000\000\000\000\002-\019N\002-\002-\002-\012r\002-\002-\002-\002\225\002\225\016\178\000\000\000\000\002-\002-\002-\002-\002-\012\138\002-\012\162\000\000\000\000\002\225\r\006\002-\002-\002-\002-\002-\000\000\bf\014\206\000\000\002-\000\n\002-\002-\r\026\000\000\r.\014V\002-\002-\002-\014j\014~\014\142\000\000\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\tN\t~\002\225\002-\002-\000\000\000\000\000\000\000\000\000\238\000\000\002-\002-\002-\000\000\002-\002-\002-\002-\tV\000\000\t\134\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\000\000\000\002-\002-\002-\000\000\t:\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\000\000\000\000\002=\012}\006*\002=\000\000\005\234\002=\000\000\002=\000\000\000\000\002=\0066\002=\002=\002=\006B\002=\002=\002=\012}\012}\000\000\000\000\012}\002=\002=\002=\002=\002=\000\000\002=\b\021\000\000\000\000\b\021\000\000\002=\002=\002=\002=\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\022>\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\238\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b\021\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b\021\002=\002=\002=\002=\012}\000\000\004\253\002=\000\000\002=\002=\002\225\t\158\002=\002=\002=\002=\002=\004\253\n\230\002=\002=\002=\000\000\000\000\b\021\000\000\002=\002=\002=\002=\t%\t%\000\000\000\000\000\000\t%\000\000\000\000\t%\000\n\000\000\t%\000\000\t%\000\000\000\000\t\202\004\253\t%\t\238\t%\b\021\t%\t%\t%\002\225\000\000\000\000\000\000\017\"\n\002\n\026\n\"\n\n\n*\000\000\t%\002\225\002\225\000\000\000\000\000\000\t%\t%\n2\n:\t%\004\253\007\245\000\000\004\253\t%\000\000\nB\t%\000\000\000\000\000\000\000\000\t%\t%\000\238\000\000\000\000\000\000\000\000\000\000\002\246\t%\t%\t\210\n\018\nJ\nR\nb\t%\t%\002\166\012\193\t%\000\000\t%\nj\000\000\003Z\000\000\000\000\000\238\000\000\t%\t%\nr\000\000\t%\t%\t%\t%\003f\012\193\000\000\t%\000\000\t%\t%\002B\n\146\t%\n\154\nZ\t%\t%\000\000\000\000\t%\nz\t%\000\000\002F\000\000\005v\t%\t%\n\130\n\138\002q\002q\000\000\000\000\000\000\002q\012\133\006*\002q\000\000\005\234\002q\000\000\002q\000\000\005\130\002q\0066\002q\002q\002q\006B\002q\002q\002q\012\133\012\133\000\000\000\000\012\133\002q\002q\002q\002q\002q\000\000\002q\015\130\000\000\005\138\002\130\000\000\002q\002q\002q\002q\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\000\000\000\238\002q\002q\t\210\002q\002q\002q\002q\002q\002q\000\000\015\134\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015\146\002q\002q\002q\002q\012\133\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\026\014\000\000\002q\002q\002q\000\000\000\000\005\134\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\190\002Y\000\000\000\000\002Y\000\000\002Y\003\170\000\000\002Y\002\154\002Y\002Y\002Y\025~\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015\130\000\000\000\000\002\130\000\000\002Y\002Y\002Y\002Y\002Y\004\154\003\202\000\000\004\217\002Y\000\000\002Y\002Y\002\178\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\t\210\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015\134\002Y\000\000\002Y\002Y\006\234\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015\146\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\129\000\000\002Y\002Y\002Y\000\000\000\000\005\134\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\129\012\129\002e\000\000\012\129\002e\000\000\002e\000\000\000\000\t\202\000\000\002e\002e\002e\021\026\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\n\n\002e\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\238\000\000\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\t\210\n\018\002e\002e\002e\002e\002e\000\000\012\129\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\t\002e\002e\002e\b\t\002e\002e\002e\002e\000\000\000\000\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\000\011\154\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\t\011\162\002u\000\000\011\174\002u\000\000\002u\000\000\000\000\002u\011\186\002u\002u\002u\011\198\002u\002u\002u\000\000\000\000\b\t\000\000\000\000\002u\002u\002u\002u\002u\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\002u\002u\002u\000\000\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\002u\002u\002u\000\000\000\000\004\254\000\000\000\000\000\000\002u\002u\t\210\002u\002u\002u\002u\002u\002u\000\000\007\234\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\005\002u\002u\002u\b\005\002u\002u\002u\002u\000\000\007\238\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\002u\002u\002u\000\000\000\000\002u\002u\002u\000\000\007\165\000\000\000\000\002u\002u\002u\002u\002U\002U\007\222\000\000\000\000\002U\b\005\007\165\002U\000\000\005\234\002U\000\000\002U\000\000\000\238\002U\007\165\002U\002U\002U\007\165\002U\002U\002U\000\000\000\000\b\005\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\006\253\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\006\253\002U\002U\002U\006\253\007\242\004\254\000\000\000\000\000\000\002U\002U\t\210\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\189\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\000\007\189\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005f\007\189\002a\000\000\005\234\002a\000\000\002a\000\000\000\000\t\202\007\189\002a\002a\002a\007\189\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\n\n\002a\000\000\002a\000\000\000\000\006\237\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\006\237\002a\002a\002a\006\237\000\000\000\000\000\000\000\000\000\000\002a\002a\t\210\n\018\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\002a\000\000\007\217\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b&\006*\002]\000\000\005\234\002]\000\000\002]\000\000\000\000\t\202\007\217\002]\002]\002]\007\217\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\n\n\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\t\210\n\018\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\209\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\007\209\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\011\222\002\133\000\000\007\209\002\133\000\000\002\133\000\000\000\000\t\202\007\209\002\133\002\133\002\133\007\209\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n2\n:\002\133\000\000\000\000\000\000\000\000\002\133\000\000\nB\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\t\210\n\018\nJ\nR\nb\002\133\002\133\000\000\000\000\002\133\000\000\002\133\nj\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\nr\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\002\133\002\133\002\133\nZ\002\133\002\133\000\000\000\000\002\133\nz\002\133\000\000\007\161\000\000\000\000\002\133\002\133\n\130\n\138\002m\002m\000\000\000\000\000\000\002m\000\000\007\161\002m\000\000\005\234\002m\000\000\002m\000\000\000\000\t\202\007\161\002m\002m\002m\007\161\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\n\n\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\t\210\n\018\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\238\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\002m\002m\002m\000\000\000\000\002m\002m\002m\000\000\014&\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\162\002i\000\000\011\174\002i\000\000\002i\000\000\000\000\t\202\011\186\002i\002i\002i\011\198\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\n\n\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\t\210\n\018\002i\002i\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002}\002}\000\000\000\000\000\000\002}\000\000\002\006\002}\000\000\002\130\002}\000\000\002}\000\000\000\000\t\202\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n2\n:\002}\000\000\027*\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015\146\000\000\000\000\000\000\000\000\000\000\002}\002}\t\210\n\018\nJ\nR\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005\134\002}\002}\002}\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\nZ\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\003\022\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\t\202\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\n\n\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\190\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\246\002Q\002Q\002Q\006N\000\000\004\002\000\000\000\000\000\000\002Q\002Q\t\210\n\018\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\000\000\000\000\002M\000\000\002\190\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\t\202\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n2\n:\002M\000\000\t\138\003\n\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\011\254\000\000\012\014\000\000\000\000\000\000\002M\002M\t\210\n\018\nJ\nR\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\nZ\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\190\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\t\202\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n2\n:\002\169\000\000\012\194\003\n\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\012\214\000\000\012\234\000\000\000\000\000\000\002\169\002\169\t\210\n\018\nJ\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\nZ\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002I\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\t\202\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n2\n:\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\t\210\n\018\nJ\nR\002I\002I\002I\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\nZ\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\t\202\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n2\n:\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\t\210\n\018\nJ\nR\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\nZ\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\t\202\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n2\n:\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\t\210\n\018\nJ\nR\002y\002y\002y\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\002y\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\nZ\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\137\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\t\202\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n2\n:\002\137\000\000\000\000\000\000\000\000\002\137\000\000\nB\002\137\000\000\000\000\000\000\000\000\002\137\002\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\t\210\n\018\nJ\nR\nb\002\137\002\137\000\000\000\000\002\137\000\000\002\137\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\nr\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\nZ\002\137\002\137\000\000\000\000\002\137\nz\002\137\000\000\000\000\000\000\000\000\002\137\002\137\n\130\n\138\002\141\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\t\202\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n2\n:\002\141\000\000\000\000\000\000\000\000\002\141\000\000\nB\002\141\000\000\000\000\000\000\000\000\002\141\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\t\210\n\018\nJ\nR\nb\002\141\002\141\000\000\000\000\002\141\000\000\002\141\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\nr\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\002\141\002\141\002\141\nZ\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\n\130\n\138\002\145\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\t\202\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n2\n:\002\145\000\000\000\000\000\000\000\000\002\145\000\000\nB\002\145\000\000\000\000\000\000\000\000\002\145\002\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\t\210\n\018\nJ\nR\nb\002\145\002\145\000\000\000\000\002\145\000\000\002\145\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\nr\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\nZ\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\n\130\n\138\b\225\b\225\000\000\000\000\000\000\b\225\000\000\000\000\b\225\000\000\000\000\b\225\000\000\b\225\000\000\000\000\t\202\000\000\b\225\b\225\b\225\000\000\b\225\b\225\b\225\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\b\225\000\000\000\000\000\000\000\000\000\000\b\225\b\225\n2\n:\b\225\000\000\000\000\000\000\000\000\b\225\000\000\nB\b\225\000\000\000\000\000\000\000\000\b\225\b\225\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\t\210\n\018\nJ\nR\nb\b\225\b\225\000\000\000\000\b\225\000\000\b\225\nj\000\000\000\000\000\000\000\000\000\000\000\000\b\225\b\225\nr\000\000\b\225\b\225\b\225\b\225\000\000\000\000\000\000\b\225\000\000\b\225\b\225\000\000\b\225\b\225\b\225\nZ\b\225\b\225\000\000\000\000\b\225\nz\b\225\000\000\000\000\000\000\000\000\b\225\b\225\n\130\n\138\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\t\202\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n2\n:\002\149\000\000\000\000\000\000\000\000\002\149\000\000\nB\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\t\210\n\018\nJ\nR\nb\002\149\002\149\000\000\000\000\002\149\000\000\002\149\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\nr\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\n\146\002\149\n\154\nZ\002\149\002\149\000\000\000\000\002\149\nz\002\149\000\000\000\000\000\000\000\000\002\149\002\149\n\130\n\138\b\221\b\221\000\000\000\000\000\000\b\221\000\000\000\000\b\221\000\000\000\000\b\221\000\000\b\221\000\000\000\000\t\202\000\000\b\221\b\221\b\221\000\000\b\221\b\221\b\221\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\b\221\000\000\000\000\000\000\000\000\000\000\b\221\b\221\n2\n:\b\221\000\000\000\000\000\000\000\000\b\221\000\000\nB\b\221\000\000\000\000\000\000\000\000\b\221\b\221\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\t\210\n\018\nJ\nR\nb\b\221\b\221\000\000\000\000\b\221\000\000\b\221\nj\000\000\000\000\000\000\000\000\000\000\000\000\b\221\b\221\nr\000\000\b\221\b\221\b\221\b\221\000\000\000\000\000\000\b\221\000\000\b\221\b\221\000\000\b\221\b\221\b\221\nZ\b\221\b\221\000\000\000\000\b\221\nz\b\221\000\000\000\000\000\000\000\000\b\221\b\221\n\130\n\138\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\t\202\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n2\n:\002\197\000\000\000\000\000\000\000\000\002\197\000\000\nB\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\t\210\n\018\nJ\nR\nb\002\197\002\197\000\000\000\000\002\197\000\000\002\197\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\nr\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\n\146\002\197\n\154\nZ\002\197\002\197\000\000\000\000\002\197\nz\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n\130\n\138\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\t\202\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n2\n:\002\193\000\000\000\000\000\000\000\000\002\193\000\000\nB\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\t\210\n\018\nJ\nR\nb\002\193\002\193\000\000\000\000\002\193\000\000\002\193\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\nr\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\n\146\002\193\n\154\nZ\002\193\002\193\000\000\000\000\002\193\nz\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n\130\n\138\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\t\202\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n2\n:\002\201\000\000\000\000\000\000\000\000\002\201\000\000\nB\002\201\000\000\000\000\000\000\000\000\002\201\002\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\t\210\n\018\nJ\nR\nb\002\201\002\201\000\000\000\000\002\201\000\000\002\201\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\nr\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\n\146\002\201\n\154\nZ\002\201\002\201\000\000\000\000\002\201\nz\002\201\000\000\000\000\000\000\000\000\002\201\002\201\n\130\n\138\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\t\202\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n2\n:\002\181\000\000\000\000\000\000\000\000\002\181\000\000\nB\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\t\210\n\018\nJ\nR\nb\002\181\002\181\000\000\000\000\002\181\000\000\002\181\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\nr\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\n\146\002\181\n\154\nZ\002\181\002\181\000\000\000\000\002\181\nz\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n\130\n\138\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\t\202\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n2\n:\002\185\000\000\000\000\000\000\000\000\002\185\000\000\nB\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\t\210\n\018\nJ\nR\nb\002\185\002\185\000\000\000\000\002\185\000\000\002\185\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\nr\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\n\146\002\185\n\154\nZ\002\185\002\185\000\000\000\000\002\185\nz\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n\130\n\138\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\t\202\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n2\n:\002\189\000\000\000\000\000\000\000\000\002\189\000\000\nB\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\t\210\n\018\nJ\nR\nb\002\189\002\189\000\000\000\000\002\189\000\000\002\189\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\nr\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\n\146\002\189\n\154\nZ\002\189\002\189\000\000\000\000\002\189\nz\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n\130\n\138\002\209\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\000\000\000\000\002\209\000\000\002\209\000\000\000\000\t\202\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n2\n:\002\209\000\000\000\000\000\000\000\000\002\209\000\000\nB\002\209\000\000\000\000\000\000\000\000\002\209\002\209\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\t\210\n\018\nJ\nR\nb\002\209\002\209\000\000\000\000\002\209\000\000\002\209\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\nr\000\000\002\209\002\209\002\209\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\n\146\002\209\n\154\nZ\002\209\002\209\000\000\000\000\002\209\nz\002\209\000\000\000\000\000\000\000\000\002\209\002\209\n\130\n\138\002\205\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\000\000\000\000\002\205\000\000\002\205\000\000\000\000\t\202\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n2\n:\002\205\000\000\000\000\000\000\000\000\002\205\000\000\nB\002\205\000\000\000\000\000\000\000\000\002\205\002\205\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\t\210\n\018\nJ\nR\nb\002\205\002\205\000\000\000\000\002\205\000\000\002\205\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\nr\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\n\146\002\205\n\154\nZ\002\205\002\205\000\000\000\000\002\205\nz\002\205\000\000\000\000\000\000\000\000\002\205\002\205\n\130\n\138\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\t\202\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n2\n:\002\213\000\000\000\000\000\000\000\000\002\213\000\000\nB\002\213\000\000\000\000\000\000\000\000\002\213\002\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\t\210\n\018\nJ\nR\nb\002\213\002\213\000\000\000\000\002\213\000\000\002\213\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\nr\000\000\002\213\002\213\002\213\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\n\146\002\213\n\154\nZ\002\213\002\213\000\000\000\000\002\213\nz\002\213\000\000\000\000\000\000\000\000\002\213\002\213\n\130\n\138\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\t\202\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n2\n:\002\177\000\000\000\000\000\000\000\000\002\177\000\000\nB\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\t\210\n\018\nJ\nR\nb\002\177\002\177\000\000\000\000\002\177\000\000\002\177\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\nr\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\n\146\002\177\n\154\nZ\002\177\002\177\000\000\000\000\002\177\nz\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n\130\n\138\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\002\001\r\254\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\029\002\029\000\000\000\000\000\000\002\029\000\000\000\000\002\029\000\000\000\000\002\029\000\000\002\029\000\000\000\000\t\202\000\000\002\029\002\029\002\029\000\000\002\029\002\029\002\029\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n2\n:\002\029\000\000\000\000\000\000\000\000\002\029\000\000\nB\002\029\000\000\000\000\000\000\000\000\002\029\002\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\t\210\n\018\nJ\nR\nb\002\029\002\029\000\000\000\000\002\029\000\000\002\029\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\nr\000\000\002\029\002\029\014\022\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\n\146\002\029\n\154\nZ\002\029\002\029\000\000\000\000\002\029\nz\002\029\000\000\000\000\000\000\000\000\002\029\002\029\n\130\n\138\002\025\002\025\000\000\000\000\000\000\002\025\000\000\000\000\002\025\000\000\000\000\002\025\000\000\002\025\000\000\000\000\t\202\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n2\n:\002\025\000\000\000\000\000\000\000\000\002\025\000\000\nB\002\025\000\000\000\000\000\000\000\000\002\025\002\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\t\210\n\018\nJ\nR\nb\002\025\002\025\000\000\000\000\002\025\000\000\002\025\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\nr\000\000\002\025\002\025\002\025\002\025\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\n\146\002\025\n\154\nZ\002\025\002\025\000\000\000\000\002\025\nz\002\025\000\000\000\000\000\000\000\000\002\025\002\025\n\130\n\138\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\t\202\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\n\002\n\026\n\"\n\n\n*\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n2\n:\002\173\000\000\000\000\000\000\000\000\002\173\000\000\nB\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\t\210\n\018\nJ\nR\nb\002\173\002\173\000\000\000\000\002\173\000\000\002\173\nj\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\nr\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\n\146\002\173\n\154\nZ\002\173\002\173\000\000\000\000\002\173\nz\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n\130\n\138\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\002\r\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\002\r\r\254\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\017\002\017\000\000\000\000\000\000\002\017\000\000\000\000\002\017\000\000\000\000\002\017\000\000\002\017\000\000\000\000\002\017\000\000\002\017\002\017\002\017\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\000\000\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\003\253\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\238\002\017\002\017\002\017\000\000\002\017\002\017\002\017\002\017\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\002\017\r\254\000\000\000\000\003\253\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\006\229\000\000\002\186\002\190\006*\002\234\002\130\005\234\b\242\000\000\000\000\002\246\001\n\000\000\0066\000\000\002\142\000\000\006B\006\229\000\000\001\210\003\206\006\229\002\190\0036\001\018\bn\br\001\030\001\"\003\170\000\000\000\000\003F\000\000\002\254\007\226\025\030\000\000\b\150\b\154\001\210\003\222\0032\003\234\b\158\006\214\000\000\001:\000\000\002\178\007\r\000\000\003:\000\000\000\000\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\003\202\001>\001B\001F\001J\001N\007\r\002\178\b\178\001R\007\r\007\001\000\000\001V\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\006\229\000\000\001^\002\225\007\001\000\000\000\000\018\130\007\001\006\234\000\000\000\000\001\154\011\018\000\000\011\030\005\138\b2\004\026\001\158\000\000\014F\004r\t>\001\006\001\166\000\006\001\170\001\174\000\000\002\186\002\190\000\n\002\234\002\130\011\"\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\bj\000\000\000\238\000\000\002\225\001\210\000\000\000\000\007\r\0036\001\018\bn\br\001\030\001\"\000\000\002\225\002\225\003F\000\000\002\254\000\000\bv\n\206\b\150\b\154\n\218\003\222\0032\003\234\b\158\006\214\000\238\001:\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\b\026\b\030\b*\b>\006*\005v\000\000\005\234\001>\001B\001F\001J\001N\000\000\0066\b\178\001R\000\000\006B\000\000\001V\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\000\000\006*\001^\000\000\005\234\011&\000\000\000\000\000\000\000\000\000\000\0066\001\154\006\022\000\000\006B\005\138\b2\012\181\001\158\000\000\014F\004r\t>\004m\001\166\000\006\001\170\001\174\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\012\181\002\246\000\000\002\030\003\178\000\000\002\"\000\000\004m\000\000\003\182\001\210\000\000\017\026\000\000\002\250\000\000\003>\003B\002.\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\000\000\017\018\002\178\000\000\000\000\003:\017*\002:\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\b\178\000\000\t\r\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\000\004m\004m\000\000\000\000\000\000\006f\024\234\000\000\t\r\000\000\000\000\002>\012\181\012\161\000\000\000\000\017\174\021\154\005\138\b2\025\n\000\173\000\000\bJ\004r\t>\000\173\000\000\002\190\000\173\000\000\002\130\012\181\tf\000\000\002\030\002\246\000\000\002\"\000\173\000\000\000\173\000\000\000\173\000\000\000\173\001\210\000\238\tn\000\000\002\250\002.\000\000\000\000\0026\012\161\tv\000\173\000\000\000\000\000\000\002\254\000\000\000\173\000\000\000\000\000\000\000\173\000\000\0032\001\190\015\130\000\173\000\000\002\130\000\173\002\178\000\000\002:\003:\000\173\000\173\000\173\b\026\b\030\b*\000\000\012f\005v\000\173\000\173\006*\021B\000\000\005\234\024\238\000\173\000\000\000\000\t\r\000\173\0066\000\000\000\000\000\000\006B\000\000\000\000\005\130\005\134\000\173\000\173\015\134\000\000\000\173\000\173\000\000\000\000\000\000\000\000\000\000\000\000\002>\000\000\000\173\000\000\015\146\000\000\021f\000\000\000\173\000\173\005\138\b2\000\000\000\000\000\197\bJ\004r\000\000\000\173\000\197\000\173\002\190\000\197\000\000\002\130\000\000\tf\000\000\000\000\002\246\005\134\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\210\021r\tn\000\000\002\250\000\000\000\000\000\000\000\000\b\210\tv\000\197\000\000\000\000\000\000\002\254\000\000\000\197\021\006\000\000\000\000\000\197\000\000\0032\001\190\000\000\000\197\000\000\000\000\000\197\002\178\000\000\000\000\003:\000\197\000\197\000\197\b\026\b\030\b*\000\000\012f\005v\000\197\000\197\000\000\000\000\000\000\000\000\r\234\000\197\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\197\000\197\000\000\000\238\000\197\000\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\197\005\138\b2\000\000\000\000\000\000\bJ\004r\000\000\000\197\000\000\000\197\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\006*\000\000\000>\005\234\000\000\000\000\000B\000\000\000\000\000\000\0066\000\000\000\000\000F\006B\000\000\000\000\000\000\000\000\000J\000\000\000N\000R\000V\000Z\000^\000b\000f\000\000\000\000\000\000\000j\000n\000\000\000r\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000z\000\000\000\000\000~\000\130\000\000\000\000\000\000\000\000\000\000\000\134\000\138\000\142\000\000\000\000\000\000\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\000\000\000\000\000\174\000\178\000\182\000\000\000\000\000\000\000\186\000\006\000\190\000\194\000\246\002\186\002\190\002\194\002\234\002\130\000\198\000\000\000\202\000\000\002\246\000\000\000\000\004\141\000\206\000\210\000\000\000\214\000\000\003\182\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\000\000\017\018\002\178\000\000\000\000\003:\017*\000\000\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\b\178\000\000\027\250\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\006\028\027\014\218\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\028J\000\000\021\154\005\138\b2\014Z\003\182\001\210\bJ\004r\t>\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\174\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\016n\017\018\002\178\000\000\000\000\003:\017*\002\006\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\002\n\000\000\000\000\000\000\000\000\0172\000\000\b\178\001\210\027\250\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\017F\017r\000\000\000\000\004\149\000\000\003\154\000\000\000\000\000\000\001\006\000\000\007\002\001\222\000\000\000\000\003V\002\190\t\018\002\178\002\130\021\154\005\138\b2\000\000\002\246\001\n\bJ\004r\t>\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\007\006\000\000\000\000\002\225\000\000\003z\002\225\001.\011\014\000\000\000\000\003r\001\190\0016\002\225\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\n\005v\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005z\000\000\002\225\001V\000\000\000\000\000\000\002\225\005\130\005\134\000\000\005\202\001Z\002\225\002\225\002\225\002\225\000\000\001^\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\001\154\011\018\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\002\225\001\170\001\174\003V\002\190\n\178\002\225\002\130\015\130\000\000\000\000\002\130\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\011\014\000\000\000\000\003r\001\190\0016\007\173\015\134\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\015\146\005v\021F\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\007\173\001V\n\181\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\005\134\000\000\000\000\007\173\000\000\001^\007\173\b\166\000\000\000\000\021R\000\000\000\000\007\173\000\000\001\154\011\018\007\173\000\000\005\138\000\000\n\181\001\158\000\000\001\162\004r\001\006\021\006\001\166\000\000\001\170\001\174\003V\002\190\r\170\n\181\002\130\000\000\n\181\011\134\000\000\002\246\001\n\000\000\000\000\n\181\002\142\000\000\000\000\n\181\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\011\014\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\011\018\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\000\000\b\249\001\166\000\006\001\170\001\174\000\000\002\186\002\190\000\000\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\000\000\000\000\b\249\000\000\b\249\b\249\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\000\000\b\001\003F\000\000\002\254\000\000\b\001\000\000\003\214\003\218\n\222\003\222\0032\003\234\003\242\006\214\001\202\001\206\011>\002\178\000\000\000\000\003:\000\000\000\000\b\001\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\001\210\002\170\001\230\000\000\000\000\000\000\b\178\000\000\000\000\000\000\001\242\000\000\b\001\b\190\b\214\t*\005\130\005\134\000\000\000\000\b\001\000\000\000\000\001\246\002\146\b\001\b\001\000\238\002\158\000\000\002\178\004\030\004*\000\000\b\001\b\001\000\000\0046\000\000\000\000\005\138\b2\b\249\004\253\004\253\bJ\004r\t>\004\253\000\000\004\253\004\253\000\000\004\253\004:\004\253\004\253\b\001\000\000\004\253\b\001\004\253\004\253\004\253\004\253\004\253\004\253\004\253\004\253\b\001\004\253\016~\004\253\000\000\000\000\000\000\000\000\000\000\002\006\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\002\n\004\253\004\253\004\253\004\253\000\000\004\253\000\000\001\210\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\003\154\000\000\000\000\000\000\000\000\004\253\007\002\001\222\000\000\004\253\004\253\000\000\004\253\002\178\004\253\000\000\000\000\000\000\000\000\004\253\004\253\004\253\000\000\004\253\004\253\004\253\004\253\000\000\004\253\004\253\000\000\000\000\000\000\004\253\000\000\004\253\004\253\000\000\000\000\002\150\004\253\007\006\000\000\000\000\020\026\004\253\000\000\n\205\000\000\004\253\n\205\004\253\004\253\n\205\n\205\000\000\004\253\n\205\000\000\n\205\000\000\000\000\n\205\000\000\001*\000\000\n\205\n\205\000\000\n\205\n\205\002\225\n\205\000\000\n\205\000\000\000\000\000\000\002\225\n\205\000\000\000\000\n\205\000\000\000\000\000\000\000\000\000\000\000\000\002\225\n\205\000\000\n\205\000\000\000\000\n\205\n\205\000\n\000\000\000\000\000\000\000\000\n\205\000\000\000\000\n\205\000\000\000\000\n\205\n\205\000\000\n\205\002\225\n\205\n\205\000\000\000\000\000\000\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\n\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\205\n\205\000\000\000\000\n\205\000\000\n\205\000\000\000\000\000\000\000\000\005\166\000\000\002\225\000\000\000\000\001\202\001\206\n\205\n\205\000\000\n\205\n\205\000\000\n\205\000\000\n\205\000\000\n\205\000\000\n\205\000\000\n\205\b\229\b\229\001\210\001\214\001\230\b\229\000\000\001\206\b\229\000\000\000\000\000\000\001\242\003\190\000\000\018\174\b\229\000\000\b\229\b\229\b\229\000\000\b\229\b\229\b\229\001\246\020\022\000\000\0196\000\000\002\158\000\000\002\178\004\030\004*\000\000\b\229\000\000\000\000\020&\000\000\000\000\b\229\b\229\000\000\000\000\b\229\000\000\000\000\002\154\000\000\b\229\000\000\000\000\b\229\000\000\004:\000\000\000\000\b\229\b\229\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\000\000\000\000\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004\154\000\000\000\000\b\229\000\000\000\000\000\000\000\000\000\000\000\000\b\229\b\229\b\229\000\000\b\229\b\229\000\000\004Y\000\000\000\000\000\000\000\000\004Y\000\000\b\229\004Y\b\229\b\229\000\000\000\000\000\000\b\229\000\000\000\000\000\000\004Y\b\229\000\000\000\000\004Y\b\229\004Y\b\229\b\229\012u\012u\000\000\000\000\004Y\012u\000\000\001\206\012u\004Y\000\000\000\000\000\000\000\000\000\000\004Y\004\186\000\000\012u\012u\012u\004B\012u\012u\012u\000\000\000\000\004Y\004Y\000\000\000\000\000\000\004Y\002\226\000\000\000\000\012u\000\000\000\000\000\000\000\000\000\000\012u\012u\000\000\000\000\012u\000\000\004Y\002\154\004Y\012u\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\012u\012u\004Y\004Y\002\226\000\238\004Y\004Y\012u\012u\000\000\000\000\004R\004Y\000\000\012u\000\000\000\000\000\000\004\154\000\000\000\000\012u\004Y\000\000\000\000\000\000\000\000\021\026\012u\012u\012u\000\000\012u\012u\000\000\004Y\000\000\004Y\000\000\000\000\004Y\000\000\012u\004Y\012u\012u\004Y\000\000\000\000\012u\000\000\000\000\000\000\004Y\012u\000\000\000\000\004Y\012u\004Y\012u\012u\b\233\b\233\000\000\000\000\000\000\b\233\000\000\001\206\b\233\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b\233\000\000\b\233\b\233\b\233\000\000\b\233\b\233\b\233\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\226\000\000\000\000\b\233\000\000\000\000\000\000\000\000\000\000\b\233\b\233\000\000\000\000\b\233\000\000\004Y\002\154\000\000\b\233\000\000\000\000\b\233\000\000\000\000\000\000\000\000\b\233\b\233\b\233\004Y\004Y\000\000\000\000\004Y\004Y\b\233\b\233\000\000\000\000\007n\000\000\000\000\b\233\000\000\000\000\000\000\004\154\000\000\000\000\b\233\004Y\000\000\000\000\000\000\000\000\000\000\b\233\b\233\b\233\002\225\b\233\b\233\000\000\000\000\002\225\002\225\002\225\000\000\000\000\002\225\b\233\002\225\b\233\b\233\002\225\002\225\002\225\b\233\002\225\002\225\002\225\002\225\b\233\002\225\002\225\000\000\b\233\002\225\b\233\b\233\000\000\002\225\000\n\000\000\002\225\002\225\002\225\000\000\002\225\000\000\002\225\002\225\000\n\000\000\002\225\002\225\000\n\002\225\002\225\002\225\000\000\000\000\000\000\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\002\225\000\000\000\000\002\225\000\000\000\000\000\000\000\000\002\225\002\225\002\225\002\225\000\000\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\006\141\000\000\0009\002\225\002\225\000\000\0009\0009\000\000\0009\0009\002\225\000\000\000\000\000\000\0009\000\000\002\225\000\000\000\000\006\141\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\006\222\0009\0009\000\000\000\000\000\000\000\000\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\000\000\0009\0009\0009\0009\0009\000\000\000\000\000\000\0009\000\000\000\000\0009\000\000\000\000\000\000\0009\0009\0009\0009\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\012\181\012\161\000\000\0009\0009\0009\0009\0009\000\000\006\137\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\012\181\000\000\000\000\002\030\0005\000\000\002\"\000\000\000\000\006\137\0009\0009\000\000\002*\0005\0009\0009\0009\0005\002.\0005\0005\0026\012\161\000\000\000\000\000\000\0005\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\0005\0005\0005\000\000\000\000\000\000\0005\000\000\002:\0005\000\000\000\000\000\000\0005\0005\0005\0005\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\0005\0005\0005\0005\0005\000\000\006\153\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\002>\000\000\000\000\000\000\012=\000\000\000\000\000\000\000\000\006\153\0005\0005\000\000\000\000\012=\0005\0005\0005\012=\000\000\012=\012=\000\000\000\000\000\000\000\000\000\000\012=\000\000\012=\000\000\000\000\000\000\012=\012=\000\000\012=\012=\012=\012=\012=\000\000\000\000\000\000\012=\000\000\000\000\012=\000\000\000\000\000\000\012=\012=\012=\012=\000\000\012=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012=\000\000\000\000\000\000\012\181\012\161\000\000\012=\012=\012=\012=\012=\000\000\006\149\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\012\181\000\000\000\000\002\030\0129\000\000\002\"\000\000\000\000\006\149\012=\012=\000\000\002\206\0129\012=\012=\012=\0129\002.\0129\0129\0026\012\161\000\000\000\000\000\000\0129\000\000\0129\000\000\000\000\000\000\0129\0129\000\000\0129\0129\0129\0129\0129\000\000\001\202\001\206\0129\000\000\002:\0129\000\000\000\000\000\000\0129\0129\0129\0129\000\000\0129\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\0129\000\000\000\000\000\000\000\000\001\242\000\000\0129\0129\0129\0129\0129\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\000\000\002\158\002>\002\178\004\030\004*\012y\012y\000\000\000\000\0046\012y\0129\0129\012y\000\000\000\000\0129\0129\0129\000\000\000\000\004\138\000\000\012y\012y\012y\004:\012y\012y\012y\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012y\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\012y\000\000\000\000\000\000\001\021\012y\000\000\000\000\012y\000\000\000\000\000\000\000\000\012y\012y\012y\000\000\000\000\000\000\000\000\000\000\000\000\012y\012y\000\000\000\000\001\021\000\000\018\182\012y\000\000\000\000\000\000\012y\001\021\000\000\012y\000\000\000\000\001\021\000\000\000\000\000\000\012y\012y\012y\000\000\012y\012y\001\021\000\000\000\000\000\000\000\000\000\000\000\000\007\253\012y\000\006\012y\012y\007\253\002\186\002\190\012y\002\234\002\130\000\000\000\000\012y\000\000\002\246\000\000\012y\001\021\012y\012y\000\000\003\254\000\000\007\253\001\210\000\000\001\021\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\000\000\000\000\003F\000\000\002\254\000\000\000\000\000\000\003\214\003\218\007\253\003\222\0032\003\234\003\242\006\214\000\000\000\000\007\253\002\178\000\000\000\000\003:\007\253\007\253\000\238\b\026\b\030\b*\b>\000\000\005v\007\253\007\253\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\178\000\000\000\000\000\000\000\000\000\000\000\000\b\190\b\214\t*\005\130\005\134\000\000\000\000\007\253\000\000\000\000\007\253\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\007\253\002\186\002\190\000\000\002\234\002\130\000\000\000\000\005\138\b2\002\246\000\000\000\000\bJ\004r\t>\000\000\014n\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\001\197\000\000\003F\000\000\002\254\001\197\000\000\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\006\214\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\001\197\000\000\b\026\b\030\b*\b>\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005-\012\245\b\178\000\000\000\000\0051\012\245\001\197\000\000\b\190\b\214\t*\005\130\005\134\000\000\001\197\000\000\000\000\000\000\005-\001\197\001\197\000\238\005-\0051\000\000\003\029\003\029\0051\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005\138\b2\000\000\000\000\000\000\bJ\004r\t>\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\003\029\000\000\001\197\000\000\000\000\000\000\003\029\004\130\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\012\245\012\245\003\029\000\000\000\000\012\245\012\245\003\029\003\029\003\029\000\000\000\000\000\000\005-\000\000\000\000\003\029\003\029\0051\012\245\000\000\012\245\000\000\003\029\012\245\000\000\012\245\003\029\005-\000\000\003\029\005-\000\000\0051\000\000\000\000\0051\003\029\003\029\003\029\004}\003\029\003\029\000\000\000\000\018\198\000\000\000\000\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\003\182\n\217\000\000\003\029\n\217\003\029\003\029\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\n\217\n\217\018\242\n\217\n\217\000\000\001\210\000\000\006\198\000\000\017\018\000\000\000\000\003Z\000\000\017*\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\217\019.\003f\000\000\000\000\003r\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\217\003\250\000\000\004\002\005j\n\190\005v\000\000\004}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\146\005z\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\n\217\000\000\n\217\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\217\000\000\000\000\n\217\n\217\000\000\005\138\000\000\n\217\000\000\n\217\000\000\004r\n\213\n\217\000\000\n\213\001\246\002\162\003V\002\190\000\000\002\158\002\130\002\178\004\030\004*\000\000\002\246\000\000\000\000\0046\n\213\n\213\000\000\n\213\n\213\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\026\022\000\000\000\000\000\000\000\000\n\213\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\000\000\000\000\026\002\002\178\000\000\000\000\003\246\000\000\000\000\n\213\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\012Y\000\000\000\000\012Y\000\000\000\000\005\130\005\134\000\000\005\202\n\213\000\000\n\213\012Y\000\000\000\000\000\000\000\000\000\000\012Y\000\000\001\221\001\221\000\000\n\213\000\000\001\221\n\213\n\213\001\221\005\138\012Y\n\213\000\000\n\213\000\000\004r\012Y\n\213\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012Y\000\000\000\000\012Y\000\000\000\000\000\000\000\000\012Y\000\000\000\000\001\221\000\000\000\000\000\000\000\000\000\000\001\221\001\221\000\000\000\000\001\221\000\000\000\000\012Y\000\000\001\221\000\000\012Y\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012Y\012Y\000\000\000\000\012Y\001\221\001\221\000\000\000\000\000\000\027\242\000\000\001\221\001\r\000\000\000\000\001\221\000\000\001\r\001\221\000\000\012Y\000\000\000\000\000\000\000\000\001\221\001\221\001\221\0256\001\221\001\221\000\000\000\000\000\000\000\000\002\006\001\r\000\000\000\000\001\221\000\000\001\221\001\221\003V\002\190\002\n\001\221\002\130\000\000\006\166\000\000\001\221\002\246\001\210\000\000\004\254\000\000\001\221\001\r\000\000\003R\000\000\001\210\000\000\006\198\000\000\001\r\000\000\000\000\003Z\003\154\001\r\b\226\000\000\000\000\000\000\007\002\001\222\000\000\000\000\001\r\001\r\003f\002\178\000\000\n\174\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\177\003\250\000\000\004\002\000\000\n\190\005v\000\000\001\r\000\000\003V\002\190\000\000\007\006\002\130\000\000\006\166\001\r\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\n\198\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\n\177\n\206\000\000\n\177\011:\003f\005\138\000\000\n\174\001\190\n\177\000\000\004r\000\000\n\177\002\178\000\000\000\000\003\246\000\000\000\000\n\177\003\250\000\000\004\002\000\000\n\190\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\000\000\n\198\005}\005}\000\000\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\n\177\000\000\000\000\n\177\n\177\005}\005\138\005}\000\000\005}\n\177\005}\004r\000\000\n\177\000\000\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005}\002\194\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\000\000\028J\005}\000\000\000\000\005}\000\000\003\182\005}\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\174\000\000\000\000\000\000\005}\005}\000\000\000\000\005}\024Z\000\000\001\006\017\018\000\000\000\000\000\000\000\000\017*\005}\005}\005}\000\000\005}\005}\000\000\000\000\000\000\001\n\007n\000\000\000\000\002\142\000\000\0172\000\000\005}\000\000\027\250\005}\005}\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017F\017r\000\000\005}\004\149\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\004a\000\000\001:\000\000\000\000\000\246\021\154\000\000\002\018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017\178\001>\001B\001F\001J\001N\003\182\005q\005q\001R\000\000\000\000\005q\001V\000\000\005q\000\000\000\000\017\182\000\000\000\000\000\000\001Z\000\000\017\222\005q\000\000\005q\001^\005q\000\000\005q\000\000\000\000\000\000\000\000\017\018\000\000\001\154\027.\000\000\017*\000\000\005q\000\000\001\158\000\000\001\162\000\000\005q\005q\001\166\000\000\001\170\001\174\007\222\000\000\018Z\005q\000\000\000\000\005q\000\000\000\000\000\000\000\000\005q\005q\000\238\000\000\000\000\017F\018n\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\005q\005q\000\000\000\000\005q\000\000\b\245\000\000\000\000\000\000\018~\000\000\000\000\000\000\005q\005q\005q\000\000\005q\005q\000\000\000\000\t\202\000\000\000\000\012:\b\245\000\000\b\245\b\245\000\000\005q\000\000\000\000\005q\005q\n\002\n\026\n\"\n\n\n*\000\000\000\000\001\202\002~\000\000\005q\002\130\000\000\000\000\n2\n:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nB\000\000\000\000\001\210\001\214\001\230\002\134\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\t\210\n\018\nJ\nR\nb\000\000\000\000\000\000\000\000\002\138\002\146\000\000\nj\001\n\002\158\000\000\002\178\004\030\004*\000\000\000\000\nr\000\000\020\242\000\000\020\246\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n\146\000\000\n\154\nZ\001&\004:\001.\0012\b\245\nz\000\000\000\000\0016\000\000\005\134\001:\000\000\n\130\n\138\000\000\000\000\000\000\000\000\000\000\021\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\003]\003]\001R\021\006\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\003]\000\000\003]\001^\003]\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027J\000\000\000\000\000\000\003]\000\000\001\158\000\000\001\162\000\000\003]\003]\001\166\000\000\001\170\001\174\005\005\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003]\000\000\001\202\001\206\003]\bq\bq\000\000\000\000\000\000\bq\000\000\000\000\bq\003]\003]\003]\000\000\003]\003]\000\000\001\210\001\214\bq\005\005\bq\000\000\bq\000\000\bq\000\000\003]\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\000\000\bq\000\000\000\000\001\246\002\154\003]\bq\bq\002\158\000\000\002\178\004\030\004*\000\000\000\000\bq\000\000\0046\bq\015\158\000\000\000\000\000\000\bq\bq\bq\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\bq\000\000\000\000\000\000\bq\rA\rA\000\000\000\000\000\000\rA\000\000\000\000\rA\bq\bq\bq\000\000\bq\bq\000\000\000\000\000\000\rA\000\000\rA\000\000\rA\bq\rA\000\000\bq\000\000\000\000\000\000\bq\000\000\000\000\000\000\000\000\000\000\rA\000\000\000\000\004\254\000\000\bq\rA\rA\rE\rE\000\000\000\000\004B\rE\000\000\rA\rE\000\000\rA\000\000\000\000\000\000\000\000\rA\rA\rA\rE\000\000\rE\000\000\rE\000\000\rE\000\000\000\000\000\000\000\000\000\000\000\000\rA\000\000\000\000\000\000\rA\rE\000\000\000\000\000\000\000\000\000\000\rE\rE\000\000\rA\rA\rA\004B\rA\rA\rE\000\000\000\000\rE\004R\000\000\000\000\000\000\rE\rE\rE\rA\000\000\000\000\000\000\rA\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rE\000\000\rA\000\000\rE\003]\003]\000\000\000\000\000\000\003]\000\000\000\000\003]\rE\rE\rE\000\000\rE\rE\000\000\000\000\000\000\003]\004R\003]\000\000\003]\000\000\003]\000\000\rE\001\202\001\206\000\000\rE\000\000\000\000\000\000\000\000\000\000\003]\000\000\000\000\000\000\000\000\rE\003]\003]\000\000\000\000\001\210\001\214\005\t\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\246\002\162\000\000\000\000\000\000\002\158\003]\002\178\004\030\004*\003]\001\205\000\000\000\000\0046\000\000\001\205\000\000\001\206\001\205\003]\003]\003]\000\000\003]\003]\000\000\b\209\000\000\001\205\005\t\004:\000\000\001\205\004\205\001\205\000\000\003]\000\000\000\000\000\000\003]\000\000\004Y\000\000\000\000\000\000\001\205\004Y\000\000\026\002\000\000\003]\001\205\001\205\000\000\000\000\000\000\000\000\000\000\002\154\000\000\001\205\000\000\000\000\001\205\000\000\004Y\000\000\000\000\001\205\001\205\001\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\205\001\205\000\000\004Y\004\154\003A\000\000\000\000\000\000\000\000\003A\004Y\001\206\003A\001\205\001\205\004Y\002\226\001\205\001\205\000\000\b\205\000\000\003A\000\000\004Y\004Y\003A\001\205\003A\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\003A\000\000\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\004Y\000\000\000\000\002\154\000\181\003A\000\000\000\181\003A\004Y\000\000\000\000\000\000\003A\003A\003A\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\000\000\000\000\000\000\000\003A\003A\000\000\000\000\004\154\000\000\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\000\003A\003A\000\181\000\000\003A\003A\000\000\000\181\000\000\000\000\000\181\000\000\000\000\000\000\003A\000\181\000\181\000\238\000\000\000\000\000\000\003A\000\000\000\000\000\181\000\181\003A\000\000\000\000\000\000\000\000\000\181\003A\000\000\000\249\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\181\000\181\000\000\000\000\000\181\000\181\000\000\000\249\000\000\000\249\000\000\000\249\000\000\000\249\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\181\000\249\000\181\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\189\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\249\000\249\000\000\000\000\000\249\000\249\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\189\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\249\000\189\000\249\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\185\000\189\000\000\000\000\006\221\000\185\000\000\000\000\000\185\006\221\000\000\000\189\000\189\000\000\000\000\000\189\000\189\000\000\000\185\000\000\000\185\000\000\000\185\000\000\000\185\000\189\000\000\000\000\006\221\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\185\000\000\000\000\000\000\000\000\000\189\000\185\000\189\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\000\000\000\000\185\000\000\000\000\000\000\006\221\000\185\000\185\000\238\000\000\006\221\006\221\000\238\000\000\000\000\000\185\000\185\000\000\000\000\006\221\006\221\000\000\000\185\000\000\000\000\001\169\000\185\000\000\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\185\000\185\000\000\000\000\000\185\000\185\000\000\001\169\000\000\006\221\000\000\001\169\r\001\001\169\000\185\000\000\000\000\r\001\006\221\000\000\000\185\000\185\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\185\001\169\000\185\000\000\023\186\000\000\r\001\005\005\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\000\000\000\001\169\001\169\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r\001\000\000\000\000\000\000\000\000\000\000\001\169\000\000\r\001\000\000\001\169\r=\r=\r\001\r\001\000\238\r=\000\000\000\000\r=\001\169\001\169\r\001\r\001\001\169\001\169\000\000\000\000\000\000\r=\005\005\r=\000\000\r=\001\169\r=\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\r=\r\001\000\000\000\000\000\000\001\169\r=\r=\000\000\000\000\r\001\000\000\000\000\000\000\000\000\r=\000\000\000\000\r=\000\000\000\000\000\000\000\000\r=\r=\r=\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r=\000\000\000\000\000\000\r=\r9\r9\000\000\000\000\000\000\r9\000\000\000\000\r9\r=\r=\r=\000\000\r=\r=\000\000\000\000\000\000\r9\000\000\r9\000\000\r9\000\000\r9\000\000\r=\000\000\000\000\000\000\r=\000\000\000\000\000\000\000\000\000\000\r9\000\000\000\000\004\254\000\000\r=\r9\r9\000\000\000\000\000\000\000\000\000\000\000\000\004a\r9\000\000\000\000\r9\000\246\000\000\000\000\002\018\r9\r9\r9\000\000\000\000\000\000\000\000\000\000\000\000\017\178\000\000\000\000\000\000\004a\000\000\003\182\r9\000\000\bu\bu\r9\000\000\000\000\bu\000\000\000\000\bu\017\182\000\000\000\000\r9\r9\r9\017\222\r9\r9\bu\000\000\bu\000\000\bu\000\000\bu\000\000\007J\017\018\000\000\r9\000\000\000\000\017*\r9\000\000\000\000\bu\000\000\000\000\000\000\000\000\000\000\bu\bu\r9\000\000\000\000\000\000\018Z\000\000\000\000\bu\000\000\000\000\bu\000\000\000\000\000\000\000\000\bu\bu\000\238\017F\018n\000\000\000\000\004a\004a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\bu\000\000\000\000\000\000\bu\000\000\006\241\000\000\018~\000\000\000\000\000\000\000\000\000\000\bu\bu\bu\000\000\bu\bu\000\000\000\000\t\202\000\000\000\000\006\241\000\000\000\000\bu\006\241\000\000\bu\000\000\000\000\000\000\bu\n\002\n\026\n\"\n\n\n*\000\000\000\000\000\000\000\000\000\000\bu\001\201\000\000\000\000\n2\n:\001\201\000\000\001\206\001\201\000\000\000\000\000\000\nB\000\000\000\000\000\000\b\205\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\000\000\000\000\001\201\000\000\000\000\000\000\006\241\nj\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002\154\nr\001\201\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\001\201\001\201\000\000\000\000\n\146\000\000\n\154\nZ\000\000\000\000\000\000\000\000\000\000\nz\000\000\001\201\001\201\000\000\000\000\004\154\000\000\n\130\n\138\000\000\000\000\000\000\016b\000\000\000\000\001\201\001\201\000\000\000\000\001\201\001\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\202\001\201\000\000\000\000\016f\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\n\002\n\026\n\"\n\n\n*\001\201\000\000\000\000\000\000\000\000\000\000\n\210\000\000\000\000\n2\n:\000\246\001\202\001\206\002\018\000\000\000\000\000\000\nB\000\000\000\000\000\000\000\000\000\000\017\178\000\000\000\238\000\000\004a\000\000\003\182\001\210\001\214\001\230\000\000\t\210\n\018\nJ\nR\nb\000\000\001\242\017\182\000\000\000\000\000\000\000\000\nj\017\222\000\000\000\000\000\000\000\000\000\000\001\246\002\146\nr\000\000\000\000\002\158\017\018\002\178\004\030\004*\000\000\017*\000\000\000\000\0046\000\000\n\146\016j\n\154\nZ\016z\000\000\000\000\000\000\000\000\nz\000\000\018Z\000\000\000\000\000\000\004:\000\000\n\130\n\138\005\169\005\169\000\000\000\000\000\000\005\169\017F\018n\005\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\169\000\000\005\169\000\000\005\169\000\000\005\169\000\000\000\000\018~\000\000\000\000\000\000\000\000\004n\000\000\004r\000\000\005\169\000\000\000\000\000\000\000\000\000\000\005\169\005\169\000\000\000\000\000\000\000\000\007\222\000\000\000\000\005\169\000\000\000\000\005\169\000\000\006I\000\000\000\000\005\169\005\169\000\238\000\000\002\190\000\000\000\000\002\130\000\000\000\000\000\000\000\000\002\246\000\000\002\225\002\225\005\169\006I\002\225\000\000\005\169\000\000\001\210\002\225\000\000\000\000\002\250\000\000\000\000\002\225\005\169\005\169\005\169\002\225\005\169\005\169\000\000\002\254\000\000\000\000\002\225\000\n\000\000\000\000\006\218\0032\001\190\005\169\000\000\000\000\015:\005\169\002\178\002\225\000\000\003:\002\225\002\225\000\000\b\026\b\030\b*\005\169\002\225\005v\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\005\165\007\030\000\000\005\130\005\134\005\165\002\225\000\000\005\165\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015v\005\165\000\000\005\165\000\000\005\165\000\000\005\165\000\000\000\000\005\138\b2\000\000\000\000\000\000\bJ\004r\000\000\000\000\005\165\000\000\002\225\000\000\000\000\000\000\005\165\007\138\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\000\000\005\165\000\000\000\000\004\133\000\000\005\165\005\165\000\238\021\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\165\000\000\005\193\005\193\005\165\000\000\003\182\005\193\000\000\000\000\005\193\000\000\000\000\000\000\005\165\005\165\005\165\000\000\005\165\005\165\005\193\000\000\005\193\000\000\005\193\000\000\005\193\000\000\0222\000\000\000\000\005\165\000\000\000\000\000\000\005\165\017\018\000\000\005\193\000\000\000\000\017*\000\000\000\000\005\193\005\193\005\165\000\000\000\000\000\000\022\214\022\230\000\000\005\193\000\000\000\000\005\193\000\000\000\000\000\000\000\000\005\193\005\193\005\193\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\133\005\193\000\000\005\189\007\030\005\193\000\000\000\000\005\189\023\218\000\000\005\189\000\000\000\000\000\000\005\193\005\193\005\193\000\000\005\193\005\193\005\189\000\000\005\189\000\000\005\189\000\000\005\189\000\000\000\000\000\000\000\000\005\193\000\000\000\000\000\000\005\193\000\000\000\000\005\189\000\000\000\000\000\000\000\000\000\000\005\189\007\138\007\130\000\000\000\000\000\000\000\000\000\000\000\000\005\189\000\000\000\000\005\189\000\000\000\000\000\000\000\000\005\189\005\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\189\003V\002\190\000\000\005\189\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\005\189\005\189\005\189\000\000\005\189\005\189\001\210\000\000\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\005\189\000\000\000\000\000\000\005\189\000\000\000\000\000\000\000\000\003f\000\000\000\000\n\174\001\190\000\000\005\189\012\186\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\n\190\005v\t\202\000\000\000\000\012:\000\000\000\000\000\000\b\245\000\000\000\000\000\000\005z\000\000\000\000\n\002\n\026\n\"\n\n\n*\005\130\005\134\000\000\000\000\n\198\000\000\000\000\000\000\000\000\n2\n:\000\000\000\000\000\000\000\000\000\000\000\000\000\000\nB\n\206\000\000\000\000\n\218\000\000\005\138\000\000\000\238\000\000\000\000\000\000\004r\000\000\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\000\000\003=\000\000\000\000\000\000\000\000\003=\nj\001\206\003=\000\000\000\000\000\000\000\000\000\000\000\000\nr\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\n\146\000\000\n\154\nZ\000\000\000\000\000\000\003=\000\000\nz\000\000\000\000\000\000\003=\000\000\000\000\001M\n\130\n\138\000\000\002\154\001M\003=\000\000\001M\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\001M\000\000\001M\000\000\001M\000\000\001M\000\000\000\000\000\000\000\000\000\000\003=\003=\000\000\000\000\004\154\000\000\001M\000\000\000\000\000\000\000\000\000\000\001M\000\000\003=\003=\001M\000\000\003=\003=\000\000\001M\000\000\000\000\001M\000\000\000\000\000\000\003=\001M\001M\000\238\000\000\001I\000\000\003=\000\000\000\000\001I\001M\003=\001I\000\000\000\000\000\000\001M\003=\000\000\000\000\001M\000\000\001I\000\000\001I\000\000\001I\000\000\001I\000\000\001M\001M\001M\000\000\001M\001M\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001M\000\000\001I\000\000\000\000\000\000\001I\001M\000\000\000\000\000\000\001I\000\000\000\000\001I\000\000\000\000\000\000\001M\001I\001I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001I\001\133\000\000\000\000\000\000\000\000\001\133\000\000\012\153\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\153\000\000\001\133\000\000\001\133\000\000\001\133\001I\001\133\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001I\001\133\012\153\000\000\000\000\000\000\000\000\000\000\012\153\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001\133\001\133\001\133\000\000\000\000\0019\000\000\000\000\000\000\000\000\0019\000\000\000\157\0019\000\000\000\000\001\133\000\000\000\000\000\000\012\153\000\157\000\000\0019\000\000\0019\000\000\0019\000\000\0019\001\133\001\133\001\133\000\000\001\133\001\133\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\0019\000\157\000\000\000\000\001\133\000\000\000\000\000\157\000\000\000\000\000\000\000\000\0019\000\000\000\000\001\133\000\000\0019\0019\0019\000\000\001\213\000\000\000\000\000\000\000\000\001\213\000\000\015\130\001\213\000\000\002\130\000\000\0019\000\000\000\000\000\000\000\157\000\000\001\213\000\000\000\000\000\000\001\213\000\000\001\213\000\000\0019\0019\0019\000\000\0019\0019\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\0019\015\134\000\000\000\000\001\213\000\000\000\000\001\213\000\000\000\000\000\000\0019\001\213\001\213\000\000\015\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\000\000\005\134\001\213\001\213\000\000\000Y\001\213\001\213\000Y\000\000\000\000\000\000\000Y\000Y\000\000\b\145\001\213\000\000\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000\000\001\213\000Y\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000Y\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000Y\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\000Y\002\246\000\000\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000Y\006\198\000\000\000Y\000\000\000\000\003Z\000\000\b\145\b\226\000\000\000\000\000Y\004Y\007\030\000Y\000\000\t&\004Y\003f\000\000\004Y\r\166\001\190\000\000\000\000\000\000\000\000\000Y\002\178\000\000\004Y\003\246\000\000\000\000\004Y\003\250\004Y\004\002\000\000\n\190\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\005z\000\000\004Y\007\138\000\000\000\000\004Y\000\000\005\130\005\134\000\000\004Y\000\000\000\000\004Y\000\000\000\000\000\000\000\000\004Y\002\226\000\238\000\000\000\000\000\000\000\000\000\000\000\000\004Y\004Y\r\182\000\000\005\138\000\000\000\000\004Y\004Y\000\000\004r\004Y\000\000\012\022\000\000\000\000\000\000\000\000\012\022\000\000\000\000\004Y\004Y\000\000\000\000\004Y\004Y\000\000\000\000\t\202\000\000\000\000\000\000\000\000\t\202\004Y\012\026\000\000\000\000\000\000\000\000\012\242\004Y\n\002\n\026\n\"\n\n\n*\n\002\n\026\n\"\n\n\n*\004Y\000\000\000\000\000\000\n2\n:\000\000\000\000\000\000\n2\n:\000\000\000\000\nB\000\000\000\000\000\000\000\000\nB\000\000\000\000\000\238\000\000\000\000\000\000\000\000\000\238\000\000\000\000\000\000\t\210\n\018\nJ\nR\nb\t\210\n\018\nJ\nR\nb\000\000\000\000\nj\000\000\000\000\000\000\000\000\nj\000\000\000\000\000\000\nr\000\000\0035\000\000\000\000\nr\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\n\146\000\000\n\154\nZ\000\000\n\146\0035\n\154\nZ\nz\0035\000\000\0035\000\000\nz\000\000\000\000\n\130\n\138\000\000\000\000\000\000\n\130\n\138\0035\015\154\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\001\210\000\000\006\198\000\000\000\000\000\000\000\000\003Z\0035\0035\b\226\000\000\0035\0035\000\000\000\000\000\000\000\000\023B\000\000\003f\000\000\0035\003r\001\190\000\000\000\000\000\000\015\250\0035\002\178\000\000\000\000\003\246\0035\000\000\000\000\003\250\000\000\004\002\0035\n\190\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\021\178\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024\014\003f\005\138\000\000\n\174\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\n\190\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\166\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\n\198\006\198\000\000\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022J\003f\005\138\000\000\n\174\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005\194\n\190\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\000\000\000\000\005z\002\246\000\000\000\000\000\000\000\000\005\198\000\000\005\130\005\134\000\000\001\210\n\198\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\170\003f\005\138\000\000\003r\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\t\017\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\t\017\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\006\022\000\000\000\000\005\138\002\225\002\225\000\000\003f\002\225\004r\003r\001\190\000\000\002\225\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\000\005v\002\225\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\002\225\000\000\000\000\002\225\002\225\000\000\005\130\005\134\000\000\005\202\002\225\000\000\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\000\000\t\017\000\000\002\225\000\000\004r\004A\004A\000\000\000\000\004A\002\225\002\225\000\000\002\225\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\000\000\004A\000\000\000\000\000\000\000\000\000\000\000\000\004A\022\250\000\000\002\225\023\018\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004A\000\000\000\000\004A\004A\000\000\000\000\000\000\000\000\000\000\004A\000\000\000\000\004A\000\000\000\000\000\238\004A\000\000\004A\004A\000\000\004A\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004A\0035\000\000\000\000\000\000\000\000\000\000\0035\004A\004A\000\000\0035\000\000\0035\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\015\154\000\000\000\000\0035\015\154\0035\004A\000\000\000\000\0035\000\000\000\000\004A\000\000\0035\000\000\000\000\0035\0035\000\000\000\000\0035\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\025\134\000\000\0035\0035\025\182\000\000\0035\0035\012\145\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\015\250\0035\000\000\000\000\015\250\0035\0035\000\000\012\145\000\000\0035\000\000\012\145\000\000\012\145\000\000\000\000\000\000\000\000\000\000\004\253\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\003V\002\190\012\145\012\145\002\130\000\000\006\166\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\001\210\000\000\006\198\012\145\000\000\000\000\000\000\003Z\000\000\000\000\b\226\000\000\000\000\012\145\012\145\002z\000\000\012\145\012\145\000\000\003f\000\000\000\000\t\014\001\190\000\000\000\000\012\145\000\000\000\000\002\178\026v\000\000\003\246\012\145\000\000\000\000\003\250\000\000\004\002\000\000\n\190\005v\005U\000\000\012\145\000\000\000\000\005U\000\000\000\000\005U\000\000\000\000\005z\000\000\000\000\000\000\000\000\000\000\000\000\005U\005\130\005\134\000\000\005U\000\000\005U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005U\000\000\000\000\000\000\000\000\000\000\005U\005\138\000\000\000\000\000\000\000\000\007\222\004r\000\000\005U\000\000\000\000\005U\000\000\000\000\000\000\000\000\005U\005U\000\238\000\000\005Y\000\000\000\000\000\000\000\000\005Y\000\000\000\000\005Y\000\000\000\000\000\000\005U\005U\000\000\000\000\005U\000\000\005Y\000\000\000\000\000\000\005Y\000\000\005Y\000\000\005U\005U\000\000\000\000\005U\005U\000\000\000\000\000\000\000\000\005Y\000\000\000\000\000\000\000\000\000\000\005Y\000\000\0035\000\000\000\000\005U\007\222\0035\000\000\005Y\0035\000\000\005Y\000\000\000\000\000\000\005U\005Y\005Y\000\238\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\005Y\005Y\000\000\000\000\005Y\0035\015\154\000\000\000\000\000\000\000\000\0035\000\000\000\000\005Y\005Y\000\000\000\000\005Y\005Y\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\001\000\000\000\000\000\000\005Y\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\0035\000\000\005Y\000\000\0035\006\001\000\000\000\000\000\000\006\001\000\000\006\001\000\000\000\000\0035\0035\017\130\000\000\0035\0035\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\000\000\006\001\000\000\000\000\000\000\000\000\015\250\0035\000\000\000\000\006\001\000\000\000\000\006\001\000\000\000\000\000\000\000\000\006\001\006\001\000\238\000\000\000\000\000\000\000\000\000\000\025^\000\000\000\000\000\000\000\000\000\000\003V\002\190\006\001\000\000\002\130\000\000\006\001\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\006\001\006\001\021>\001\210\006\001\006\001\000\000\000\000\000\000\000\000\003Z\001\202\001\206\000\000\006\001\000\000\000\000\000\000\000\000\000\000\000\000\006\001\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\001\210\001\214\006\001\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\005\238\000\000\000\000\000\000\001\246\002\162\003V\002\190\005z\002\158\002\130\002\178\004\030\004*\000\000\002\246\005\130\005\134\0046\005\202\000\000\000\000\003\254\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\004\209\000\000\005\138\000\000\006\146\000\000\b\202\003f\004r\000\000\003r\001\190\000\000\000\000\000\000\000\000\026\002\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\006.\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\006R\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\006:\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\007\129\000\000\000\000\007\129\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\007\129\007\129\003\246\007\129\007\129\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006M\000\000\000\000\005z\007\129\004r\003V\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006M\000\000\007\129\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\005\138\011\166\000\000\000\000\000\000\000\000\004r\003V\002\190\000\000\003f\002\130\000\000\003r\001\190\000\000\002\246\007\129\000\000\007\129\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\005\226\005v\003Z\007\129\007\129\000\000\000\000\000\000\007\129\000\000\007\129\000\000\000\000\005z\007\129\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\011\178\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\005z\002\130\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\011\190\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006q\000\000\000\000\005z\000\000\004r\000\000\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006q\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\000\000\000\000\000\000\000\000\005\138\000\000\000\000\000\000\000\000\002\254\004r\000\000\000\000\000\000\000\000\000\000\000\000\0032\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\b\026\b\030\b*\000\000\000\000\005v\000\000\000\000\000\000\006\249\007\030\000\000\000\000\000\000\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\006\249\000\000\000\000\000\000\006\249\000\000\006\249\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\006\249\000\000\000\000\000\000\005\138\b2\006\249\007\138\001\181\bJ\004r\000\000\001\181\000\000\001\181\006\249\000\000\000\000\006\249\000\000\000\000\000\000\000\000\006\249\006\249\000\238\001\181\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\000\000\000\000\000\000\006\249\000\000\001\181\000\000\006\249\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\006\249\006\249\000\000\000\000\006\249\006\249\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\217\001\181\000\000\000\000\000\000\001\217\006\249\000\000\001\217\000\000\000\000\001\181\001\181\000\000\000\000\001\181\001\181\000\000\001\217\000\000\000\000\017\142\001\217\000\000\001\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\001\217\001\181\000\000\000\000\000\000\000\000\001\217\000\000\000\000\006\005\000\000\000\000\000\000\000\000\006\005\001\217\000\000\006\005\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\005\000\000\000\000\000\000\006\005\000\000\006\005\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\005\000\000\000\000\000\000\000\000\000\000\006\005\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\005\000\000\000\000\006\005\000\000\000\000\000\000\001\217\006\005\006\005\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\021\026\000\000\000\000\000\000\000\000\006\005\001\217\012\145\000\000\006\005\000\000\000\000\012\145\000\000\000\000\012\145\000\000\000\000\000\000\006\005\006\005\000\000\000\000\006\005\006\005\012\145\000\000\000\000\000\000\012\145\000\000\012\145\000\000\006\005\000\000\000\000\000\000\004\253\000\000\000\000\006\005\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\000\000\006\005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\002\190\012I\000\000\028\002\000\000\012\145\000\000\000\000\028\006\000\000\000\000\012I\000\000\000\000\000\000\000\000\000\000\012I\000\000\012\145\012\145\002z\000\000\012\145\012\145\000\000\000\000\000\000\000\000\012I\000\000\000\000\000\000\012\145\000\000\012I\000\000\026\174\000\000\000\000\012\145\001\002\001\190\000\000\012I\000\000\000\000\012I\000\000\000\000\000\000\012\145\012I\004Y\000\000\000\000\000\000\000\000\004Y\000\000\028\n\004Y\000\000\000\000\000\000\000\000\000\000\000\000\012I\000\000\000\000\004Y\012I\000\000\000\000\004Y\000\000\004Y\000\000\000\000\000\000\028\014\012I\012I\000\000\000\000\012I\000\000\000\000\004Y\000\000\000\000\000\000\000\000\000\000\004Y\b1\b1\000\000\000\000\b1\007\222\000\000\012I\004Y\b1\000\000\004Y\000\000\000\000\000\000\016*\004Y\002\226\000\238\b1\000\000\000\000\000\000\000\000\000\000\000\000\b1\000\000\000\000\000\000\000\000\000\000\004Y\000\000\000\000\000\000\004Y\000\000\000\000\b1\000\000\000\000\b1\b1\000\000\000\000\004Y\004Y\000\000\b1\004Y\004Y\b1\000\000\000\000\000\000\b1\000\000\b1\b1\007J\b1\000\000\000\000\000\000\000\000\001q\004Y\000\000\000\000\000\000\001q\025~\b1\001q\000\000\000\000\000\000\004Y\000\000\000\000\b1\b1\000\000\001q\000\000\001q\000\000\001q\000\000\001q\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\237\000\000\001q\000\000\000\000\b1\000\000\000\000\001q\000\000\000\237\b1\000\000\000\000\000\237\000\000\000\237\000\000\000\000\000\000\001q\000\000\000\000\000\000\000\000\001q\001q\000\238\000\237\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\237\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\237\000\238\000\000\001q\001q\001q\000\000\001q\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\241\000\237\000\000\000\000\000\000\000\241\001q\000\000\000\241\000\000\000\000\000\237\000\237\000\000\000\000\000\237\000\237\001q\000\241\000\000\000\000\000\000\000\241\000\000\000\241\000\000\006\245\000\000\000\000\000\000\000\000\006\245\000\237\000\000\006\245\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\006\245\000\000\000\000\000\000\006\245\000\000\006\245\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\006\245\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\006\245\000\000\000\241\006\245\000\000\000\000\000\000\000\000\006\245\006\245\000\000\000\000\000\241\000\241\000\000\000\000\000\241\000\241\000\000\000\000\000\000\000\000\000\000\000\000\006\245\000\000\000\000\000\000\006\245\000\000\000\000\000\000\000\000\000\241\000\000\006\201\006\201\000\000\006\245\006\245\016\194\000\000\006\245\006\245\000\241\005\249\000\000\000\000\000\000\000\000\005\249\000\000\000\000\005\249\006\201\006\201\006\201\000\000\000\000\006\245\017b\000\000\000\000\005\249\006\201\000\000\000\000\005\249\000\000\005\249\000\000\005a\007\030\000\000\000\000\000\000\005a\006\201\006\201\005a\000\000\005\249\006\201\000\000\006\201\006\201\006\201\005\249\000\000\005a\000\000\006\201\000\000\005a\000\000\005a\005\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005\249\005\249\000\000\005a\006\201\000\000\000\000\000\000\000\000\005a\007\138\000\000\000\000\000\000\000\000\000\000\005\249\000\000\000\000\000\000\005\249\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005\249\005\249\000\000\000\000\005\249\005\249\000\000\000\000\000\000\000\000\011\249\000\000\005a\000\000\000\000\011\249\000\000\004\230\011\249\000\000\000\000\005\249\000\000\000\000\000\000\000\000\005a\005a\011\249\000\000\005a\005a\011\249\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\005a\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002~\011\249\000\000\002\130\011\249\000\000\000\000\000\000\000\000\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\011\249\t\190\000\000\001\242\011\249\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\249\011\249\002\138\002\146\011\249\011\249\000\000\002\158\000\000\002\178\004\030\004*\0041\000\000\000\000\000\000\020\242\0041\026Z\004)\0041\011\249\000\000\000\000\004)\000\000\000\000\004)\000\000\000\000\0041\000\000\n\162\004:\0041\000\000\0041\004)\000\000\000\000\000\000\004)\005\134\004)\000\000\000\000\000\000\000\000\0041\000\000\000\000\000\000\026f\000\000\0041\004)\000\000\000\000\000\000\000\000\000\000\004)\000\000\0041\000\000\000\000\0041\000\000\000\000\021\006\004)\0041\000\000\004)\000\000\000\000\000\000\000\000\004)\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0041\000\000\000\000\000\000\0041\004I\000\000\004)\000\000\000\000\004I\004)\004\025\004I\0041\0041\000\000\004\025\0041\0041\004\025\004)\004)\004I\000\000\004)\004)\004I\000\000\004I\004\025\000\000\000\000\000\000\004\025\0041\004\025\000\000\000\000\000\000\000\000\004I\004)\000\000\000\000\000\000\016\234\004I\004\025\000\000\000\000\000\000\000\000\019\214\004\025\000\000\004I\000\000\000\000\004I\000\000\000\000\000\000\004\025\004I\000\000\004\025\000\000\000\000\000\000\000\000\004\025\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004I\000\000\000\000\n\222\004I\000\000\000\000\004\025\000\000\001\202\001\206\004\025\000\000\000\000\004I\004I\000\000\000\000\004I\004I\000\000\004\025\004\025\002\142\000\000\004\025\004\025\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004I\000\000\000\000\001\242\000\000\000\000\000\000\004\025\000\000\000\000\001\250\020\182\006\205\006\205\000\000\000\000\001\246\002\146\024.\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\004.\000\000\0046\006\205\006\205\006\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\205\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\000\000\006\205\006\205\000\000\000\000\000\000\006\205\000\000\006\205\006\205\006\205\000\000\0049\000\000\000\000\006\205\000\000\0049\000\000\004!\0049\000\000\000\000\015\138\004!\000\000\000\000\004!\000\000\000\000\0049\000\000\006\205\000\000\0049\000\000\0049\004!\000\000\000\000\000\000\004!\000\000\004!\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\0049\004!\000\000\004Q\000\000\000\000\000\000\004!\004Q\000\000\000\000\004Q\0049\000\000\004\"\000\000\006\205\0049\000\000\004!\000\000\004Q\000\000\000\000\004!\004Q\000\000\004Q\000\000\000\000\000\000\000\000\000\000\0049\000\000\000\000\000\000\000\000\000\000\004Q\004!\000\000\000\000\000\000\000\000\004Q\000\000\0049\0049\000\000\000\000\0049\0049\000\000\004!\004!\000\000\004Q\004!\004!\000\000\000\000\004Q\011*\000\000\000\000\000\000\000\000\0049\001\202\001\206\000\000\000\000\000\000\000\000\004!\000\000\000\000\004Q\018\018\000\000\000\000\000\000\000\000\000\000\003\254\020b\000\000\001\210\001\214\001\230\000\000\004Q\004Q\000\000\000\000\004Q\004Q\001\242\004m\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\001\246\002\146\004Q\000\000\000\000\002\158\003\178\002\178\004\030\004*\004m\000\000\003\182\020\222\0046\007\149\000\000\000\000\007\149\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\174\004:\000\000\000\000\007\149\007\149\000\000\007\149\007\149\024Z\000\000\000\000\017\018\000\000\000\000\000\000\000\000\017*\000\000\000\000\000\000\007m\000\000\000\000\007m\000\000\000\000\000\000\007\149\000\000\000\000\000\000\000\000\0172\000\000\000\000\000\000\004n\000\000\004r\007m\007m\000\000\007m\007m\000\000\000\238\017F\017r\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007m\000\000\007\153\000\000\021\154\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007\149\000\000\007\149\000\000\000\000\000\000\007m\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007\149\000\000\000\000\005\234\007\149\000\000\000\000\000\000\007\149\007\137\007\149\000\000\007\137\000\000\007\149\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007\137\007\137\000\000\007\137\007\137\000\000\000\000\000\000\007m\000\238\000\000\005\234\007m\000\000\000\000\000\000\007m\000\000\007m\000\000\000\000\000\000\007m\000\000\007\137\000\000\rI\rI\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\153\000\000\007\153\000\238\000\000\000\000\rI\rI\rI\0072\000\000\000\000\000\000\000\000\007\153\000\000\rI\005\234\007\153\000\000\000\000\000\000\007\153\000\000\007\153\001\202\001\206\022N\007\153\rI\rI\000\000\000\000\007\137\rI\007\137\rI\rI\rI\000\000\000\000\000\000\000\000\rI\001\210\002\170\001\230\006*\000\000\000\000\005\234\007\137\000\000\000\000\001\242\007\137\000\000\007\137\000\000\000\000\rI\007\137\000\000\001\202\001\206\022\174\000\000\001\246\002\146\000\000\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\000\000\000\000\000\246\000\000\004:\002\194\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\004\141\002\158\000\000\002\178\004\030\004*\003\182\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\174\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\024Z\000\000\000\000\017\018\000\000\000\000\000\000\000\000\017*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017F\017r\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\154"))
+ ((16, "C\170R\004Ff\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021HFf\000\000\000\000\020XFfC\170\020\182\000-\000[\\\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\238\004\184\000F\000\000\001v\t|\000\000\005R\002d\nt\000\000\000\244\002\204\011l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\220\000\000\000\000\000\000\002BU2\000\000\000\000\000\000\001\148\000\000\000\000\000\000\002\238\004\026\000\000\000\000U2J\014\020X\021\178]`\020Xf\166R\004\020XN`\000\000\005\144\000\000Dp\b\160\000\000C\146\000\000\027\158\000\000\000\000\003\224\000\000\001\148\000\000\000\000\000\000\006B\000\000C\146\000\000\0046w@_ e\002\000\000\132\182\134f\000\000Mr`\202\000\000Y~\026\206p\158\001\148q&FfC\170\000\000\000\000R\004\020XSNDp\005.w@\000\000\128\252FfC\170R\004\020X\000\000\000\000\016x\023\022\001N\006&\000\000\005&\007\030\000\000\000\000\000\000\000\000\000\000\020X\000\000A\206i\228C\170\000\000\000\000Q\240\020XG\030X\234\000\000\004\002\000\000\000\000\004\250\000\000\000\000I\182\004\002\024\138\003\130\0020\000\000\000\000\003\014\000\000\021\178\006\030\006P\020X\028\254\020XC\170C\170\000\000R\012Q\182\020X\028\254A\248\020X\000\000\000\000\000\000R\004\020X\000\000\000\248\000\000X\234z\006z\148\000\000\006&\000\000\006\228\000\000\000\000C,U2\134\178\000\000h\206\134\178\000\000h\206h\206\000b\002\236\0008\000\000\020\190\000\000\b\004\000\000\000\000\bZ\000\000\000\000\000\000h\206\001\148\000\000\000\000X\000U2U\166`\202\000\000\000\000OL\000b\000\000\000\000`\202\b\004U2\000\000PB`\202Q8\000\000\000\000\000\000\004Z\000\000h\206\000\000\001\000\137J\000\000U2\005\216U2\000\000\022\\\t$\001\148\000\000\000\000\023\224\000\000\006\208\000\000Z\162\b\006\000\000\b\244h\206\n\198\000\000\011\190\000\000\007\200\000\000\000\000\007\160\000\000\000\000\000\000\021 4X\234Q\240\020XX\234\000\000\000b\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000N\\\027v\000\000\000\000\000\000\001\244&\174t\134\000\000\000\000Q\240\020XX\234\000\000\000\000rvX\234{\178z\148\000\000\136x\000\000X\234\000\000\000\000Y\214I\182\001\154\001\154\000\000\n\156X\234\000\000\000\000\000\000\004\250\011*\000\000A\012\000\000\000\000{ \000\000\136\192h\206\000\000\004b\000\000\000\000{h\000\000\137\026\t\002\000\000\000\000\000\000\000\000\011\128\000\000\022\168\000\000\000\000{ \000\000\005\242\000\000\000\000DHu\018\000\000\000\000Bn\023|\019\252\023\174\000\000\000\000\000\000\000\000\001F\000\000\000\000[l\b\164\011h\000\017U2\002\204\011\196\000\000\000\000\b\200\011h\b\156\000\000i\250R,Q\182\020X\028\254\000-\000\018\0020\000\000\012.\021\178\021\178\000-\000\018\000\018\021\178\000\000j\140\t\012Dp\006&\006d\137\164\000\000U2e\162U2`\000fBU2\006`U2f\220\000\000\t\238\b\252\tL\021\178k&\000\000\005B\t\190]\130\000\000\000\000\000\000\000\000\021\178k\192\021\178lZ\020d\0008`\160\007\030\0008`\248\000\000l\244\t\012\000\000\000\000\000\000\001B\000\000\000\000\003\144\000\000\004\172\028\254\000\000^@A\248\000\000\031\138\000\000\000\000\021\178\002\152\000\000\000\000\000\000\000\000\\$\000\000\003\184\000\000Vr\001\130\006\026\000\000\0226W\204R\004\020XH<R\004\020X\016x\016x\000\000\000\000\000\000\000\000\001\240\024&B\188\000\000R\184SlRZ\020X\028\254\007h\021\178\000\000\004*\000\000T T\212|\000G\nU2\006p\000\000R\004\020X\000\000uZ\020Xz\006X\234E\186\000\000R\004\020Xw\166\005v\000\000X\234DHU2\003x\b\156\012\242\000\000\000\000\000\000J\162\001\154\r\022q\168\000\000Q\240\020XX\234\025R\000\000R\004\020X\016x\0226\016x\002\232\023\240\000\000\000\000\016x\r\218\000\000\r\248\000\000\016x\003\224\0142\000\000'\166\000\000\nX\000\000\000\000\026\022\000\000\017p\023.\000\000\000\000\000\000\000\000\t\190\000\000\000\000\027\014\000\000\028\006\000\000\028\254\000\000\018h\024&\000\000\000\000\000\000Ff\000\000\000\000\000\000\000\000\029\246\000\000\030\238\000\000\031\230\000\000 \222\000\000!\214\000\000\"\206\000\000#\198\000\000$\190\000\000%\182\000\000&\174\000\000'\166\000\000(\158\000\000)\150\000\000*\142\000\000+\134\000\000,~\000\000-v\000\000.n\000\000/f\000\0000^\020XX\234GPK\142\001\154\014\138m\128X\234\000\000\000\000\000\000\134f\000\000\028\018\135\250\000\000\026\"U2\029\220\014\190\000\000\000\000\000\000\000\000m\128\000\000\000\000\131z\001\154\015\"U2\007\170\000\000\000\000\t\180\001\148\000\000U2\t\154\000\000\000\000\015L\000\000\000\000\000\000G\"U2\n@\000\000\000\000\030*\000\000\000\000|H\000\000\031\"|\212\000\000 \026}\028\000\000!\018\t\250\000\000\000\000\000\000\000\000\"\nX\234#\002\000\000q\246q\246\000\000\000\000\000\0001V\000\000\006\212\000\000\000\000\000\000\012\018\000\000\000\000\011,\023\248\000\000\n\210\000\000\000\000^\226H<\000\000\000\000\n\180\000\000\000\000\000\000\012\180\000\000\000\000\000\000\016x\004\216\024\232\000\000\011\026\000\000\005\208\000\0002N\000\000\011\216\000\000\006\200\000\0003F\000\000\r\n\000\000\007\192\000\0004>(\158\000\000\012H\b\184\000\00056\000\000\012\160\t\176\000\0006.\000\000\r\172\n\168\000\0007&\012$\025\016\000\000\r@\011\160\000\0008\030\000\000\r\152\012\152\000\0009\022\000\000\014\002\r\144\000\000:\014\014\136\000\000;\006\015\128\019`\000\000\000\000\000\000\r\186\000\000\000\000\r\156\000\000\000\000\014`\000\000\b\026\000\000\000\000\000\000\015^\000\000\015\130\000\000\000\000Lz\001\154\016Dq\168`\202\000b\000\000\000\000q\168\000\000\000\000\000\000q\168\000\000\016&\000\000\000\000\000\000\000\000\000\000\000\000;\254X\234\000\000\000\000\016j\000\000<\246\000\000=\238\000\000#\250\000\000\000\000\011\210\000\000\000\000X\234\000\000\000\000}\180\014\018\000\000\000\000H\240\000\000\b\240\000\000\000\000W6\000\000\r\178\000\000\000\000\001\130\n\244\000\000\000\000\0226\022\028\006&\000\000A\214\000\000!,\023\176\021\220\000\000\000\000\014|\000\000\000\000\001\238\025\030W\214\000\000\025\030\000\000\rD\000\000\000\000\014\164\000\000\000\000g~\005\212\004H\000\000\000\000\012\186\000\000\000\000\014\144\000\000\000\000\000\000\020X\028\254\004\176\000\000\000\000\023&\003\130\0020\b`\028\254x.\021\178\001B\028\254x\172\015\242\000\000\000\000\b`\000\000I\248\019\248\021\204\000\000\n@\016l\000\000\016v\000V`\202\003\130\000\000\016J\015\214p\158\012\156U2\030\128\020F\t\142\004\248\000\000\031x\016\148\000\000\tT\000\000\000\000\016\170`\202a\152\000\000g\208`\202\016\138`\202n\024b8\001N\016R\000\000\000\000\000\000\020X\129F\000\000X\234q\246\000\000\000\000\016\210\000\000\000\000\000\000>\230\017\030z\006?\222h|\000\000\000\000F\138\000\000\006\026\000\000IZ\000\000\020X\000\000\021\178\006x\000\000\128\252\000\000\020X\028\254\128\252\000\000\025D\023\022\001N\001\148\130\218\021\178~Bq\246\000\000\007b\n\160\0020\b`q\246\133*\003\130\0020\b`q\246\133*\000\000\000\000\b`q\246\000\000FfC\170X\234\027B\000\000\000\000FfC\170Q\182\020X\028\254\128\252\000\000\020\182\000-\000[\016HU2\rt\017\006\131\154\000\000q\246\000\000I\248\019\248\021\204y\004\023\228\012\030~v\bj\016d\020Xq\246\000\000\020Xq\246\000\000h\206f\166\019\134\002\222\001N\0008P\012\000\000\001N\0008P\012\000\000\0274\023\022\001N\001\148Q\002\021\178q\246\000\000\007b\011\152\0212\014~\000\000P\012\000\000\0020\016h\021\178q\246\135(\003\130\0020\016n\021\178q\246\135(\000\000\000\000\tX\000\000\128\208\000\000\021\178\131\206P\012\000\000\tX\000\000J\014\020X\021\178q\246\000\000I\248\019\248\021\204r\144B\138\026\222\019\170\002\142\000\000\014^C\146\000\017\000\000\017\002\016\176\024\196\020XU\218U2\tH\000\000X\184\001N\007\188\r\230\000\000\r\212\000\000\017\018\016\156U2PJ\000\000\0032\002:\014\192\000\000\014\204\000\000\017\022\016\162p\158\014 U2MzPJ\000\000Vr\020X\024\196\017D\007~\001N\000\000\014b\024\196U2\n\224\000b\000\000U2\004\018\005\n\000\000\000\000nr\000\000\000\000\014\192\024\196n\240PJ\000\000\020XU2\014 U2W~PJ\000\000\0154\000\000\000\000PJ\000\000\000\000X\184\000\000q\246\1338\019\170\002\142\014^\0178\016\238\024\196q\246\1338\000\000\000\000\019\170\002\142\014^\017F\016\224O\030Mh`\202\017fO\030h\206\020\184\017hO\030`\202\017lO\030o\144p\016\000\000\129\214\000\000\000\000q\246\1356\019\170\002\142\014^\017l\016\250O\030q\246\1356\000\000\000\000\000\000f\166\000\000\000\000\000\000\000\000\000\000\000\000\000\000P\012\000\000\133\202\020XDp\017vw@\000\000\128\252\133\202\000\000\000\000\135\130\020XDp\017~\017\012_ \135\250\003\130\017\196\000\000\000\000p\142r\144\020X\000\000\127\018\021\204\000\000\000\000\128\252\135\130\000\000\000\000\000\000y\128D\228F\134\003\130\017\220\000\000\000\000\000\000r\144\020X\000\000\003\130\017\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015XB\138\019\170\002\142\014^\017\180s\000\023\204\020XG\030[:\020(\001N\003\130\017\182\nt\000\000\000\000\017d\000\000\000\000e0\000\000\n\254\014\222\000\000\015*\000\000\017\186\017NU2dn\017\210\n\158\000\000\000\000\017\132\000\000\000\000\020F\0032\015\020\000\000\017\222s\130\138\022\001\154\017\150U2\015\024\000\000\000\000\017\168\000\000\000\000\000\000e0\000\000\0070\015j\000\000\015\214\000\000\018\n\017\148p\158\000\000\018\014t\004\138,\001\154\017\174U2\015j\000\000\000\000\017\196\000\000\000\000\000\000\020X\000\000e0\000\000\020z\020X\023\204\023\204u\242Ff\020X\129FX\234\021\162\000\000\012\020\001N\000\000\015\004\023\204U2\012~\006&\000\000\020XX\234s\000\023\204\015\142\023\204\000\000D\142Et\000\000b\146\000\000\000\000c.\000\000\000\000c\202\000\000\015\184\023\204df\129FX\234\021\162\000\000\000\"\000\000\000\000O\030\015\242\000\000\000\000a\198\018\"\000\000e0\000\000\023\204a\198e0\000\000\020XU2e0\000\000\015\136\000\000\000\000e0\000\000\000\000[:\000\000\130\nO\030\017\212\023\204\130\166s\000\000\000q\246\133\216\019\170\002\142\014^\0180s\000q\246\133\216\000\000\000\000\000\000\136BQ\240\000\000\000\000\000\000\000\000\000\000\000\000\132`q\246\000\000\133\202\000\000\000\000\000\000\000\000q\246\136B\000\000\018p\000\000\000\000\132`\018t\000\000q\246\136B\000\000\000\000\016,\000\000\000\000it\0032\000\000\000\000B\158\000\000U2\rz\000\000[:\016\198\000\000\000\000\000\000\015\184\000\000\000\000\000\000RZ\020X\028\254\007\170\000\000N\150\000\000\007p\000\000\000*\000\000\000\000\018\138\000\000\018\178z\006\000\000@\214\018\138\000\000\000\000\018~\026R\028B\021\204vz\023\228\020X\000\000q\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000v\130\023\228\020X\000\000\n<w@\000\000\128\252\000\000\018\138\026R\028Bq\246\000\000\018\160\000\000\000\238\015\132\020Xz<\000\000\000\000\028\190\138n\000\000\000\000\018,\000\000\018\130U2\000\000\014\226\011\174\000b\000\000\000\000U2\004R\007:\000\000U2\012\018\003\130\018\172\000\000\000\000\127l\000\000\000\000_ \000\000\128\252\000\000\018\174\026R\029:P\012\000\000\000\000\000\000\000\000\016\182\128\006_ \000\000\128\252\000\000\018\198\026R\029:P\012\000\000\016\214\000\000\000\000\bh\000\000q\246\000\000\018\220\000\000\000\000\018B\000\000\018H\000\000\018X\000\000\000\000f\166\018Z\000\000\000\000%\182\\\200\018\248\000\000\000\000\000\000\014\140\012<_h\019\004\000\000\000\000\000\000\000\000\000\000\000\000\018x\000\000\023\228\000\000\018~\000\000U2\000\000\005h\000\000\000\000\018\154\000\000\000\000\0008\000\000\011\158\000\000\000\000\000\000\016X\000\000\b\252\000\000\018\156\000\000X\234\022\168\000\000\000\000\r$\018\170\000\000\000\000\018\160\r4H<\001\148\128\132\000\000\000\000\000\000\000\000\000\000Zn\000\000\000\000\019D\000\000\138\178\000\000\016\184\019H\000\000\019N\000\000H\240H\240\\^\\^\000\000\000\000q\246\\^\000\000\000\000\000\000q\246\\^\018\194\000\000\018\200\000\000"), (16, "\t=\t=\000\006\001\002\001\190\t=\002\186\002\190\t=\002\234\002\130\t=\003\145\t=\018\230\002\246\t=\023\234\t=\t=\t=\025\146\t=\t=\t=\001\210\004M\004M\004F\002\250\t=\003>\003B\nJ\t=\001\206\t=\023\238\003F\000\238\002\254\025\150\t=\t=\003\214\003\218\t=\003\222\0032\003\234\003\242\007\030\007Z\t=\t=\002\178\001\206\007:\003:\t=\t=\t=\bz\b~\b\138\b\158\001*\005v\t=\t=\t=\t=\t=\t=\t=\t=\t=\t\018\000\238\t=\015\198\t=\t=\003\145\t\030\t6\t\130\005\130\005\134\t=\t=\t=\r\234\t=\t=\t=\t=\002j\002\154\014\026\t=\006\250\t=\t=\0035\t=\t=\t=\t=\t=\t=\005\138\b\146\t=\t=\t=\b\170\004r\t\150\0035\t=\t=\t=\t=\r\r\r\r\023\242\011&\004\154\r\r\0112\r\r\r\r\001j\r\r\r\r\r\r\r\r\004M\r\r\r\r\001f\r\r\r\r\r\r\003i\r\r\r\r\r\r\r\r\004M\r\r\016&\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\b\030\007f\006\226\r\r\004\226\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\004M\r\r\003\238\r\r\r\r\r\r\000\238\b\"\r\r\r\r\r\r\r\r\r\r\r\r\r\r\000\238\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\007\226\r\r\r\r\001r\004M\001\218\004M\r\r\r\r\r\r\r\r\r\r\004M\r\r\r\r\r\r\r\r\r\r\000\238\r\r\r\r\006\001\r\r\r\r\000\238\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\r\b\130\004M\r\r\r\r\r\r\r\r\001\181\001\181\001\181\001\222\015\134\001\181\006\018\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\0152\001\181\006\230\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\003\134\003\138\001\181\019B\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\007>\001\181\001\181\001\181\006\001\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\019J\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\130\001\181\001\181\018\214\bZ\007f\b1\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\014\246\b\194\001\181\005\186\001\181\001\181\b^\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\181\001\182\001\181\001\181\001\181\001\181\001\181\nu\nu\002\225\007\226\r1\nu\003\149\nu\nu\001\146\nu\nu\nu\nu\001\186\nu\nu\r1\nu\nu\nu\000\238\nu\nu\nu\nu\001\198\nu\000\n\nu\nu\nu\nu\nu\nu\nu\nu\025*\007f\003\146\nu\004M\nu\nu\nu\nu\nu\000\238\nu\nu\004B\nu\001\234\nu\nu\nu\002\225\025.\nu\nu\nu\nu\nu\nu\nu\004M\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\003\149\nu\nu\007\226\nu\nu\004M\004M\007f\004M\nu\nu\nu\nu\nu\004\t\nu\nu\nu\nu\t\174\000\238\t\222\nu\004^\nu\nu\b*\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\nu\015\206\nu\nu\nu\nu\nu\003\173\003\173\005\225\007\226\003\150\003\173\002N\003\173\003\173\000\238\003\173\003\173\003\173\003\173\000\238\003\173\003\173\006\153\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\002R\003\173\b>\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006\153\007f\004\t\003\173\000\238\003\173\003\173\003\173\003\173\003\173\b\213\003\173\003\173\001\206\003\173\t\025\003\173\003\173\003\173\bv\b\242\003\173\003\173\003\173\003\173\003\173\003\173\003\173\006^\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\b\233\t\166\t\214\007\226\003\173\003\173\004\210\003^\006b\000\238\003\173\003\173\003\173\003\173\003\173\002v\003\173\003\173\003\173\003\173\t\174\000\238\t\222\003\173\b\130\003\173\003\173\003b\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\003\173\000\238\003\173\003\173\003\173\003\173\003\173\003\161\003\161\000\238\001f\003i\003\161\b\213\003\161\003\161\t\025\003\161\003\161\003\161\003\161\001\238\003\161\003\161\006\165\003\161\003\161\003\161\b2\003\161\003\161\003\161\003\161\007:\003\161\b>\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\006\165\b\233\004M\003\161\000\238\003\161\003\161\003\161\003\161\003\161\b\209\003\161\003\161\001\206\003\161\004\214\003\161\003\161\003\161\015^\004M\003\161\003\161\003\161\003\161\003\161\003\161\003\161\004M\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\000\238\t\166\t\214\001f\003\161\003\161\003i\003j\tF\000\238\003\161\003\161\003\161\003\161\003\161\002\214\003\161\003\161\003\161\003\161\t\174\012\209\t\222\003\161\004B\003\161\003\161\003n\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\003\161\012\209\003\161\003\161\003\161\003\161\003\161\t\229\t\229\t\021\tJ\tf\t\229\b\209\t\229\t\229\000\238\t\229\t\229\t\229\t\229\003\018\t\229\t\229\006\166\t\229\t\229\t\229\015*\t\229\t\229\t\229\t\229\004M\t\229\007\194\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\006\253\007f\006\170\t\229\027\215\t\229\t\229\t\229\t\229\t\229\003\158\t\229\t\229\002\190\t\229\012\178\t\229\t\229\t\229\006\253\016\162\t\229\t\229\t\229\t\229\t\229\t\229\t\229\000\238\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\002f\t\229\t\229\007\226\t\229\t\229\t\021\002&\007f\004M\t\229\t\229\t\229\t\229\t\229\003\n\t\229\t\229\t\229\t\229\t\229\000\238\t\229\t\229\003\162\t\229\t\229\016\190\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\t\229\006\253\004M\t\229\t\229\t\229\t\229\t\245\t\245\004\242\007\226\b\134\t\245\0126\t\245\t\245\000\238\t\245\t\245\t\245\t\245\004\014\t\245\t\245\000\238\t\245\t\245\t\245\000\238\t\245\t\245\t\245\t\245\t\005\t\245\012:\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\004\018\002j\007\154\t\245\007v\t\245\t\245\t\245\t\245\t\245\t\014\t\245\t\245\003\022\t\245\012\202\t\245\t\245\t\245\022\206\007~\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\238\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\026\154\t\245\t\245\022\214\t\245\t\245\004M\004M\007f\t\005\t\245\t\245\t\245\t\245\t\245\003\026\t\245\t\245\t\245\t\245\t\245\004M\t\245\t\245\b)\t\245\t\245\025\138\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\t\245\000\238\t\005\t\245\t\245\t\245\t\245\t\237\t\237\019\022\007\226\b>\t\237\005R\t\237\t\237\025z\t\237\t\237\t\237\t\237\000\238\t\237\t\237\000\238\t\237\t\237\t\237\000\238\t\237\t\237\t\237\t\237\005F\t\237\000\238\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\b>\026\158\019\030\t\237\004V\t\237\t\237\t\237\t\237\t\237\005\233\t\237\t\237\000\238\t\237\012\226\t\237\t\237\t\237\r\178\005&\t\237\t\237\t\237\t\237\t\237\t\237\t\237\b\230\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\004\174\t\237\t\237\011z\t\237\t\237\019\134\004V\007f\005J\t\237\t\237\t\237\t\237\t\237\003\022\t\237\t\237\t\237\t\237\t\237\025~\t\237\t\237\004r\t\237\t\237\027.\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\t\237\012\213\004\214\t\237\t\237\t\237\t\237\t\217\t\217\004b\007\226\007:\t\217\007\021\t\217\t\217\017\190\t\217\t\217\t\217\t\217\012\213\t\217\t\217\r\182\t\217\t\217\t\217\000\238\t\217\t\217\t\217\t\217\t\001\t\217\014\142\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006v\006\242\007\n\t\217\002\006\t\217\t\217\t\217\t\217\t\217\015v\t\217\t\217\007j\t\217\012\250\t\217\t\217\t\217\007\018\016r\t\217\t\217\t\217\t\217\t\217\t\217\t\217\015~\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\007\026\t\217\t\217\005\002\t\217\t\217\001\222\007\166\001\002\001\190\t\217\t\217\t\217\t\217\t\217\019\006\t\217\t\217\t\217\t\217\t\217\006e\t\217\t\217\003\137\t\217\t\217\0022\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\t\217\006e\015\206\t\217\t\217\t\217\t\217\t\225\t\225\015\242\005\225\007:\t\225\003}\t\225\t\225\000\238\t\225\t\225\t\225\t\225\007\198\t\225\t\225\014\146\t\225\t\225\t\225\005.\t\225\t\225\t\225\t\225\001v\t\225\011\134\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\011\246\002\190\007\170\t\225\007\178\t\225\t\225\t\225\t\225\t\225\018~\t\225\t\225\000\238\t\225\r\014\t\225\t\225\t\225\001\222\007\218\t\225\t\225\t\225\t\225\t\225\t\225\t\225\018\138\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\001\206\t\225\t\225\011\150\t\225\t\225\n\022\t\234\001\002\001\190\t\225\t\225\t\225\t\225\t\225\002\142\t\225\t\225\t\225\t\225\t\225\006m\t\225\t\225\011\142\t\225\t\225\t\238\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\t\225\006m\026\018\t\225\t\225\t\225\t\225\t\221\t\221\003\134\003\138\n\250\t\221\012z\t\221\t\221\000\238\t\221\t\221\t\221\t\221\006\030\t\221\t\221\017\006\t\221\t\221\t\221\012^\t\221\t\221\t\221\t\221\001\134\t\221\012~\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\0056\014\178\011\186\t\221\012b\t\221\t\221\t\221\t\221\t\221\022B\t\221\t\221\019\158\t\221\r\"\t\221\t\221\t\221\015\182\012\170\t\221\t\221\t\221\t\221\t\221\t\221\t\221\022\"\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\012\174\t\221\t\221\011&\t\221\t\221\0112\022J\0066\022j\t\221\t\221\t\221\t\221\t\221\005\225\t\221\t\221\t\221\t\221\t\221\006u\t\221\t\221\011&\t\221\t\221\0112\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\t\221\006u\014\182\t\221\t\221\t\221\t\221\t\233\t\233\003\134\0182\006\138\t\233\004\214\t\233\t\233\019\166\t\233\t\233\t\233\t\233\001\206\t\233\t\233\018F\t\233\t\233\t\233\006\246\t\233\t\233\t\233\t\233\001\150\t\233\012\194\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\005>\007\006\012R\t\233\003\018\t\233\t\233\t\233\t\233\t\233\004B\t\233\t\233\012\198\t\233\r>\t\233\t\233\t\233\002\154\012F\t\233\t\233\t\233\t\233\t\233\t\233\t\233\004M\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\b\237\t\233\t\233\012J\t\233\t\233\002\142\t\234\007\198\026\130\t\233\t\233\t\233\t\233\t\233\027\247\t\233\t\233\t\233\t\233\t\233\004R\t\233\t\233\014^\t\233\t\233\012\246\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\t\233\000\238\000\238\t\233\t\233\t\233\t\233\t\249\t\249\027\146\001\222\0126\t\249\004\214\t\249\t\249\023z\t\249\t\249\t\249\t\249\012\138\t\249\t\249\015:\t\249\t\249\t\249\014f\t\249\t\249\t\249\t\249\r\n\t\249\011\134\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\012\142\b\237\r.\t\249\003\018\t\249\t\249\t\249\t\249\t\249\0062\t\249\t\249\023b\t\249\rR\t\249\t\249\t\249\007F\012\218\t\249\t\249\t\249\t\249\t\249\t\249\t\249\tb\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\002\190\t\249\t\249\012\222\t\249\t\249\tz\012^\003\022\015\014\t\249\t\249\t\249\t\249\t\249\019\166\t\249\t\249\t\249\t\249\t\249\015>\t\249\t\249\015\226\t\249\t\249\r:\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\t\249\001\002\001\190\t\249\t\249\t\249\t\249\t\241\t\241\001\002\001\190\012z\t\241\012\194\t\241\t\241\025B\t\241\t\241\t\241\t\241\012F\t\241\t\241\014\162\t\241\t\241\t\241\012\170\t\241\t\241\t\241\t\241\rN\t\241\r\158\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\r\030\019\"\014\166\t\241\r\146\t\241\t\241\t\241\t\241\t\241\000\238\t\241\t\241\000\238\t\241\rf\t\241\t\241\t\241\015\018\012\138\t\241\t\241\t\241\t\241\t\241\t\241\t\241\014z\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\017\138\t\241\t\241\rb\t\241\t\241\005\237\019\026\014~\t\194\t\241\t\241\t\241\t\241\t\241\005\241\t\241\t\241\t\241\t\241\t\241\011\134\t\241\t\241\t\202\t\241\t\241\012\218\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\t\241\014\234\018:\t\241\t\241\t\241\t\241\na\na\001\206\r\170\015F\na\t\218\na\na\000\238\na\na\na\na\015\026\na\na\014\238\na\na\na\011\018\na\na\na\na\015J\na\002\253\na\na\na\na\na\na\na\na\015\030\019N\019\230\na\018\222\na\na\na\na\na\019b\na\na\004B\na\rr\na\na\na\019F\019\146\na\na\na\na\na\na\na\026~\na\na\na\na\na\na\na\na\na\na\na\b9\na\na\007\246\na\na\b5\022F\022N\019\250\na\na\na\na\na\r9\na\na\na\na\na\022\138\na\na\027\142\na\na\019\202\na\na\na\na\na\na\na\na\na\na\na\na\na\011J\b)\na\na\na\na\003\157\003\157\b\005\007\246\024:\003\157\005\229\003\157\003\157\000\238\003\157\003\157\003\157\003\157\023n\003\157\003\157\022\210\003\157\003\157\003\157\026F\003\157\003\157\003\157\003\157\026\142\003\157\025^\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\007\246\rE\022\170\003\157\000\238\003\157\003\157\003\157\003\157\003\157\022\218\003\157\003\157\000\238\003\157\011r\003\157\003\157\003\157\019\254\023\250\003\157\003\157\003\157\003\157\003\157\003\157\003\157\011\162\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\023\254\t\166\t\214\023\n\003\157\003\157\023\150\004\225\r\194\025\026\003\157\003\157\003\157\003\157\003\157\b-\003\157\003\157\003\157\003\157\t\174\024>\t\222\003\157\r\202\003\157\003\157\023\206\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\003\157\r\222\003\157\003\157\003\157\003\157\003\157\001\237\001\237\014\014\007\246\n\250\001\237\014:\002\190\001\237\015\146\002\130\001\237\t\190\001\237\015\186\002\246\001\237\025b\001\237\001\237\001\237\003\254\001\237\001\237\001\237\001\210\015\214\t\198\015\218\002\250\001\237\001\237\001\237\001\237\001\237\t\206\001\237\016\002\001\206\025N\002\254\016\022\001\237\001\237\001\237\001\237\001\237\027\"\0032\001\190\004e\001\237\016.\001\237\001\237\002\178\025\030\016B\003:\001\237\001\237\001\237\bz\b~\b\138\016n\012\150\005v\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\001\237\028\007\t\166\t\214\026\246\001\237\001\237\007\246\016\130\017\130\017\142\005\130\005\134\001\237\001\237\001\237\002\226\001\237\001\237\001\237\001\237\012\158\006\134\012\234\001\237\018N\001\237\001\237\018f\001\237\001\237\001\237\001\237\001\237\001\237\005\138\b\146\001\237\001\237\001\237\b\170\004r\018\238\018\242\001\237\001\237\001\237\001\237\nI\nI\019*\019.\019V\nI\019Z\002\190\nI\025R\002\130\nI\nI\nI\019\130\002\246\nI\027&\nI\nI\nI\020.\nI\nI\nI\001\210\0202\nI\020V\002\250\nI\nI\nI\nI\nI\nI\nI\020Z\020j\020z\002\254\020\134\nI\nI\nI\nI\nI\020\186\0032\001\190\020\190\nI\021\014\nI\nI\002\178\0216\021:\003:\nI\nI\nI\bz\b~\b\138\021J\nI\005v\nI\nI\nI\nI\nI\nI\nI\nI\nI\021\154\nI\nI\021\186\nI\nI\021\250\022\030\022.\022V\005\130\005\134\nI\nI\nI\022Z\nI\nI\nI\nI\nI\022f\nI\nI\022v\nI\nI\022\146\nI\nI\nI\nI\nI\nI\005\138\b\146\nI\nI\nI\b\170\004r\022\162\022\182\nI\nI\nI\nI\nE\nE\022\226\022\230\022\242\nE\023\002\002\190\nE\023\022\002\130\nE\nE\nE\024\n\002\246\nE\024b\nE\nE\nE\024\138\nE\nE\nE\001\210\024\242\nE\025\002\002\250\nE\nE\nE\nE\nE\nE\nE\025\158\025\166\025\182\002\254\025\194\nE\nE\nE\nE\nE\026&\0032\001\190\026:\nE\026j\nE\nE\002\178\026r\026\174\003:\nE\nE\nE\bz\b~\b\138\026\214\nE\005v\nE\nE\nE\nE\nE\nE\nE\nE\nE\027\014\nE\nE\027>\nE\nE\027J\027R\027[\027k\005\130\005\134\nE\nE\nE\027~\nE\nE\nE\nE\nE\027\154\nE\nE\027\183\nE\nE\027\199\nE\nE\nE\nE\nE\nE\005\138\b\146\nE\nE\nE\b\170\004r\027\227\028\023\nE\nE\nE\nE\0029\0029\0283\028>\028s\0029\028\135\002\190\0029\028\143\002\130\0029\t\190\0029\028\203\002\246\0029\028\211\0029\0029\0029\000\000\0029\0029\0029\001\210\002\225\t\198\000\000\002\250\0029\0029\0029\0029\0029\t\206\0029\000\000\000\000\000\000\002\254\004M\0029\0029\0029\0029\0029\000\000\0032\001\190\000\000\0029\000\n\0029\0029\002\178\000\000\000\000\003:\0029\0029\0029\bz\b~\b\138\000\000\012\150\005v\0029\0029\0029\0029\0029\0029\0029\0029\0029\000\000\004\185\0029\002\225\0029\0029\004M\006\202\002\190\004M\005\130\005\134\0029\0029\0029\000\000\0029\0029\0029\0029\000\000\000\238\004M\0029\004\185\0029\0029\004M\0029\0029\0029\0029\0029\0029\005\138\b\146\0029\0029\0029\b\170\004r\000\000\004M\0029\0029\0029\0029\004M\007f\004M\003\n\004M\004M\004M\004M\004M\004M\004M\017\230\004M\000\238\004M\004M\000\000\004M\004M\004M\016\178\004M\004M\004M\004M\004M\004M\004M\004M\004M\000\000\004M\004M\000\000\000\000\004M\004M\000\238\004M\004M\004M\004M\004M\007\226\004M\004M\004M\004M\004M\004M\004M\004M\000\238\004M\004M\004M\004M\004M\004M\004M\004M\000\238\004M\004M\004M\004M\004M\004M\004M\004M\b\209\004N\004M\000\000\000\000\004M\004M\004M\000\238\004M\000\n\000\000\004M\004M\004M\004M\004M\004M\004M\004M\004M\000\000\022\018\004M\004M\002\225\002\225\007\238\004M\004B\006\249\000\000\004M\004M\000\000\007\246\016\182\022\130\002\225\000\238\004M\004M\004M\007\250\000\000\004M\004M\004M\004M\006\249\000\161\004M\000\161\006\249\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\161\0236\000\161\000\161\000\000\000\161\000\161\000\000\000\000\000\161\000\161\000\000\000\161\000\161\000\161\000\161\000\000\000\161\004R\000\161\000\161\b\209\000\000\000\161\000\161\005\153\000\161\000\161\000\161\000\238\000\161\t\005\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\b\234\000\161\000\161\000\000\000\000\000\161\000\161\002\006\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\002\n\006\249\000\161\015\174\t1\000\161\002\130\000\161\001\210\000\161\005\153\002\190\000\000\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\161\000\000\000\000\000\000\000\161\003\154\0186\t1\005\153\000\222\000\000\007J\001\222\000\161\000\000\002\226\000\000\014\194\002\178\000\161\000\161\000\161\000\161\000\000\015\178\000\161\000\161\000\161\000\161\002)\002)\004e\000\000\003\n\002)\000\000\002\190\002)\015\190\002\130\002)\001b\002)\000\000\002\246\002)\007N\002)\002)\002)\000\000\002)\002)\002)\001\210\001z\000\000\001\138\002\250\002)\002)\002)\002)\002)\005\134\002)\000\000\000\000\000\000\002\254\b\189\002)\002)\002)\002)\002)\004e\0032\b\142\000\000\002)\000\000\002)\002)\002\178\000\000\006\146\003:\002)\002)\002)\bz\b~\b\138\t\166\t\214\005v\002)\002)\002)\002)\002)\002)\002)\002)\002)\006\150\t\166\t\214\b\189\002)\002)\000\000\t\174\000\000\t\222\005\130\005\134\002)\002)\002)\000\000\002)\002)\002)\002)\t\174\000\000\t\222\002)\b\189\002)\002)\000\000\002)\002)\002)\002)\002)\002)\005\138\b\146\002)\002)\002)\b\170\004r\000\238\002\225\002)\002)\002)\002)\002E\002E\002\225\002\225\000\000\002E\000\000\000\000\002E\000\000\b\189\002E\000\000\002E\004\254\000\000\002E\b\189\002E\002E\002E\000\n\002E\002E\002E\000\000\028#\000\000\000\000\000\n\002E\002E\002E\002E\002E\000\000\002E\002\225\006F\004\181\000\000\005\234\002E\002E\002E\002E\002E\000\000\006f\002\225\000\000\002E\006r\002E\002E\000\000\000\000\002\225\006\198\002E\002E\002E\004\181\000\000\006\229\t-\000\000\000\000\002E\002E\002E\002E\002E\002E\002E\002E\002E\000\000\t\166\t\214\000\000\002E\002E\006\206\014\218\000\000\002\190\006\229\t-\002E\002E\002E\000\000\002E\002E\002E\002E\t\174\002\190\t\222\002E\002\130\002E\002E\001\210\002E\002E\002E\002E\002E\002E\b\185\000\000\002E\002E\002E\000\000\022\002\000\000\000\000\002E\002E\002E\002E\002A\002A\000\000\023>\003\n\002A\023B\003\022\002A\000\000\002\178\002A\000\000\002A\000\000\017\178\002A\023r\002A\002A\002A\t\178\002A\002A\002A\012V\b\185\000\000\000\000\015\190\002A\002A\002A\002A\002A\r\150\002A\r\162\000\000\012r\023\130\012\130\002A\002A\002A\002A\002A\b\185\b\198\001\190\001*\002A\000\000\002A\002A\005\134\002\225\002\225\014\130\002A\002A\002A\014\150\014\170\014\186\000\000\000\000\000\000\002A\002A\002A\002A\002A\002A\002A\002A\002A\000\000\t\166\t\214\b\185\002A\002A\000\n\004\254\000\000\001\206\b\185\000\000\002A\002A\002A\000\000\002A\002A\002A\002A\t\174\000\000\t\222\002A\000\000\002A\002A\001\210\002A\002A\002A\002A\002A\002A\002\225\000\000\002A\002A\002A\000\000\018\246\000\000\000\000\002A\002A\002A\002A\002-\002-\000\000\000\000\002\154\002-\019~\003\022\002-\000\000\002\178\002-\000\000\002-\000\000\000\000\002-\019\150\002-\002-\002-\012\162\002-\002-\002-\002\225\002\225\016\222\000\000\000\000\002-\002-\002-\002-\002-\012\186\002-\012\210\000\000\000\000\002\225\r2\002-\002-\002-\002-\002-\000\000\b\198\014\250\000\000\002-\000\n\002-\002-\rF\000\000\rZ\014\130\002-\002-\002-\014\150\014\170\014\186\000\000\000\000\000\000\002-\002-\002-\002-\002-\002-\002-\002-\002-\000\000\t\166\t\214\002\225\002-\002-\000\000\000\000\000\000\000\000\000\238\000\000\002-\002-\002-\000\000\002-\002-\002-\002-\t\174\000\000\t\222\002-\000\000\002-\002-\000\000\002-\002-\002-\002-\002-\002-\000\000\000\000\002-\002-\002-\000\000\t\146\000\000\000\000\002-\002-\002-\002-\002=\002=\000\000\000\000\000\000\002=\012\149\006F\002=\000\000\005\234\002=\000\000\002=\000\000\000\000\002=\006f\002=\002=\002=\006r\002=\002=\002=\012\149\012\149\000\000\000\000\012\149\002=\002=\002=\002=\002=\000\000\002=\b)\000\000\000\000\b)\000\000\002=\002=\002=\002=\002=\000\000\000\000\000\000\000\000\002=\000\000\002=\002=\000\000\000\000\000\000\022\138\002=\002=\002=\000\000\000\000\000\000\000\000\000\000\000\238\002=\002=\002=\002=\002=\002=\002=\002=\002=\000\000\b)\002=\000\000\002=\002=\000\000\000\000\000\000\000\000\000\000\000\000\002=\002=\002=\b)\002=\002=\002=\002=\012\149\000\000\005\t\002=\000\000\002=\002=\002\225\t\246\002=\002=\002=\002=\002=\005\t\011>\002=\002=\002=\000\000\000\000\b)\000\000\002=\002=\002=\002=\t9\t9\000\000\000\000\000\000\t9\000\000\000\000\t9\000\n\000\000\t9\000\000\t9\000\000\000\000\n\"\005\t\t9\nF\t9\b)\t9\t9\t9\002\225\002\225\018\014\000\000\017N\nZ\nr\nz\nb\n\130\000\000\t9\002\225\002\225\000\000\002\225\000\000\t9\t9\n\138\n\146\t9\005\t\b\t\000\000\005\t\t9\000\n\n\154\t9\000\000\000\000\000\000\000\000\t9\t9\000\238\000\000\000\000\000\000\000\000\000\000\002\246\t9\t9\n*\nj\n\162\n\170\n\186\t9\t9\002\166\012\217\t9\002\225\t9\n\194\000\000\003Z\000\000\000\000\000\238\000\000\t9\t9\n\202\000\000\t9\t9\t9\t9\003f\012\217\000\000\t9\000\000\t9\t9\002B\n\234\t9\n\242\n\178\t9\t9\000\000\000\000\t9\n\210\t9\000\000\002F\000\000\005v\t9\t9\n\218\n\226\002q\002q\000\000\000\000\000\000\002q\012\157\006F\002q\000\000\005\234\002q\000\000\002q\000\000\005\130\002q\006f\002q\002q\002q\006r\002q\002q\002q\012\157\012\157\000\000\000\000\012\157\002q\002q\002q\002q\002q\000\000\002q\015\174\000\000\005\138\002\130\000\000\002q\002q\002q\002q\002q\000\000\000\000\000\000\000\000\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\002q\002q\002q\000\000\000\000\000\000\000\000\000\000\000\238\002q\002q\n*\002q\002q\002q\002q\002q\002q\000\000\015\178\002q\000\000\002q\002q\000\000\000\000\000\000\000\000\000\000\000\000\002q\002q\002q\015\190\002q\002q\002q\002q\012\157\000\000\001\206\002q\000\000\002q\002q\000\000\002q\002q\002q\002q\002q\002q\026Z\000\000\002q\002q\002q\000\000\000\000\005\134\000\000\002q\002q\002q\002q\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002\190\002Y\000\000\000\000\002Y\000\000\002Y\003\170\000\000\002Y\002\154\002Y\002Y\002Y\025\202\002Y\002Y\002Y\001\210\000\000\000\000\000\000\000\000\002Y\002Y\002Y\002Y\002Y\000\000\002Y\015\174\000\000\000\000\002\130\000\000\002Y\002Y\002Y\002Y\002Y\004\154\003\202\000\000\004\229\002Y\000\000\002Y\002Y\002\178\000\000\000\000\000\000\002Y\002Y\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002Y\n*\002Y\002Y\002Y\002Y\002Y\002Y\000\000\015\178\002Y\000\000\002Y\002Y\0072\000\000\000\000\000\000\000\000\000\000\002Y\002Y\002Y\015\190\002Y\002Y\002Y\002Y\000\000\000\000\000\000\002Y\000\000\002Y\002Y\000\000\002Y\002Y\002Y\002Y\002Y\002Y\012\153\000\000\002Y\002Y\002Y\000\000\000\000\005\134\000\000\002Y\002Y\002Y\002Y\002e\002e\000\000\000\000\000\000\002e\012\153\012\153\002e\000\000\012\153\002e\000\000\002e\000\000\000\000\n\"\000\000\002e\002e\002e\021f\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\nb\002e\000\000\002e\000\000\000\000\000\000\000\000\000\000\002e\002e\002e\002e\002e\000\000\000\238\000\000\000\000\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\002e\002e\002e\000\000\000\000\000\000\000\000\000\000\000\000\002e\002e\n*\nj\002e\002e\002e\002e\002e\000\000\012\153\002e\000\000\002e\002e\000\000\000\000\000\000\000\000\000\238\b\029\002e\002e\002e\b\029\002e\002e\002e\002e\000\000\000\000\000\000\002e\000\000\002e\002e\000\000\002e\002e\002e\002e\002e\002e\000\000\000\000\002e\002e\002e\000\000\011\198\000\000\000\000\002e\002e\002e\002e\002u\002u\000\000\000\000\000\000\002u\b\029\011\206\002u\000\000\011\218\002u\000\000\002u\000\000\000\000\002u\011\230\002u\002u\002u\011\242\002u\002u\002u\000\000\000\000\b\029\000\000\000\000\002u\002u\002u\002u\002u\000\000\002u\000\000\000\000\000\000\000\000\000\000\002u\002u\002u\002u\002u\000\000\000\000\000\000\000\000\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\002u\002u\002u\000\000\000\000\004\254\000\000\000\000\000\000\002u\002u\n*\002u\002u\002u\002u\002u\002u\000\000\bJ\002u\000\000\002u\002u\000\000\000\000\000\000\000\000\000\238\b\025\002u\002u\002u\b\025\002u\002u\002u\002u\000\000\bN\000\000\002u\000\000\002u\002u\000\000\002u\002u\002u\002u\002u\002u\000\000\000\000\002u\002u\002u\000\000\007\181\000\000\000\000\002u\002u\002u\002u\002U\002U\b>\000\000\000\000\002U\b\025\007\181\002U\000\000\005\234\002U\000\000\002U\000\000\000\238\002U\007\181\002U\002U\002U\007\181\002U\002U\002U\000\000\000\000\b\025\000\000\000\000\002U\002U\002U\002U\002U\000\000\002U\000\000\000\000\007\r\000\000\000\000\002U\002U\002U\002U\002U\000\000\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\007\r\002U\002U\002U\007\r\bR\004\254\000\000\000\000\000\000\002U\002U\n*\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\000\000\002U\002U\000\000\000\000\000\000\000\000\007\209\000\000\002U\002U\002U\000\000\002U\002U\002U\002U\000\000\000\000\000\000\002U\000\000\002U\002U\000\000\002U\002U\002U\002U\002U\002U\000\000\000\000\002U\002U\002U\000\000\007\209\000\000\000\000\002U\002U\002U\002U\002a\002a\000\000\000\000\000\000\002a\005f\007\209\002a\000\000\005\234\002a\000\000\002a\000\000\000\000\n\"\007\209\002a\002a\002a\007\209\002a\002a\002a\000\000\000\000\000\000\000\000\000\000\002a\002a\002a\nb\002a\000\000\002a\000\000\000\000\006\253\000\000\000\000\002a\002a\002a\002a\002a\000\000\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\006\253\002a\002a\002a\006\253\000\000\000\000\000\000\000\000\000\000\002a\002a\n*\nj\002a\002a\002a\002a\002a\000\000\000\000\002a\000\000\002a\002a\000\000\000\000\000\000\000\000\000\238\000\000\002a\002a\002a\000\000\002a\002a\002a\002a\000\000\000\000\000\000\002a\000\000\002a\002a\000\000\002a\002a\002a\002a\002a\002a\000\000\000\000\002a\002a\002a\000\000\007\237\000\000\000\000\002a\002a\002a\002a\002]\002]\000\000\000\000\000\000\002]\b\134\006F\002]\000\000\005\234\002]\000\000\002]\000\000\000\000\n\"\007\237\002]\002]\002]\007\237\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\nb\002]\000\000\002]\000\000\000\000\000\000\000\000\000\000\002]\002]\002]\002]\002]\000\000\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\002]\002]\002]\000\000\000\000\000\000\000\000\000\000\000\000\002]\002]\n*\nj\002]\002]\002]\002]\002]\000\000\000\000\002]\000\000\002]\002]\000\000\000\000\000\000\000\000\007\229\000\000\002]\002]\002]\000\000\002]\002]\002]\002]\000\000\000\000\000\000\002]\000\000\002]\002]\000\000\002]\002]\002]\002]\002]\002]\000\000\000\000\002]\002]\002]\000\000\007\229\000\000\000\000\002]\002]\002]\002]\002\133\002\133\000\000\000\000\000\000\002\133\000\000\012\n\002\133\000\000\007\229\002\133\000\000\002\133\000\000\000\000\n\"\007\229\002\133\002\133\002\133\007\229\002\133\002\133\002\133\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n\138\n\146\002\133\000\000\000\000\000\000\000\000\002\133\000\000\n\154\002\133\000\000\000\000\000\000\000\000\002\133\002\133\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\133\002\133\n*\nj\n\162\n\170\n\186\002\133\002\133\000\000\000\000\002\133\000\000\002\133\n\194\000\000\000\000\000\000\000\000\000\238\000\000\002\133\002\133\n\202\000\000\002\133\002\133\002\133\002\133\000\000\000\000\000\000\002\133\000\000\002\133\002\133\000\000\002\133\002\133\002\133\n\178\002\133\002\133\000\000\000\000\002\133\n\210\002\133\000\000\007\177\000\000\000\000\002\133\002\133\n\218\n\226\002m\002m\000\000\000\000\000\000\002m\000\000\007\177\002m\000\000\005\234\002m\000\000\002m\000\000\000\000\n\"\007\177\002m\002m\002m\007\177\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\nb\002m\000\000\002m\000\000\000\000\000\000\000\000\000\000\002m\002m\002m\002m\002m\000\000\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\002m\002m\002m\000\000\000\000\000\000\000\000\000\000\000\000\002m\002m\n*\nj\002m\002m\002m\002m\002m\000\000\000\000\002m\000\000\002m\002m\000\000\000\000\000\000\000\000\000\238\000\000\002m\002m\002m\000\000\002m\002m\002m\002m\000\000\000\000\000\000\002m\000\000\002m\002m\000\000\002m\002m\002m\002m\002m\002m\000\000\000\000\002m\002m\002m\000\000\014R\000\000\000\000\002m\002m\002m\002m\002i\002i\000\000\000\000\000\000\002i\000\000\011\206\002i\000\000\011\218\002i\000\000\002i\000\000\000\000\n\"\011\230\002i\002i\002i\011\242\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\nb\002i\000\000\002i\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002i\000\000\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\n*\nj\002i\002i\002i\002i\002i\000\000\000\000\002i\000\000\002i\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002i\002i\000\000\002i\002i\002i\002i\000\000\000\000\000\000\002i\000\000\002i\002i\000\000\002i\002i\002i\002i\002i\002i\000\000\000\000\002i\002i\002i\000\000\000\000\000\000\000\000\002i\002i\002i\002i\002}\002}\000\000\000\000\000\000\002}\000\000\002\006\002}\000\000\002\130\002}\000\000\002}\000\000\000\000\n\"\000\000\002}\002}\002}\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002}\000\000\002}\000\000\000\000\000\000\000\000\000\000\002}\002}\n\138\n\146\002}\000\000\027v\001\222\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\002}\002}\000\238\015\190\000\000\000\000\000\000\000\000\000\000\002}\002}\n*\nj\n\162\n\170\002}\002}\002}\000\000\000\000\002}\000\000\002}\002}\000\000\000\000\000\000\000\000\000\000\005\134\002}\002}\002}\000\000\002}\002}\002}\002}\000\000\000\000\000\000\002}\000\000\002}\002}\000\000\002}\002}\002}\n\178\002}\002}\000\000\000\000\002}\002}\002}\000\000\000\000\000\000\000\000\002}\002}\002}\002}\002Q\002Q\000\000\000\000\000\000\002Q\000\000\003\022\002Q\000\000\000\000\002Q\000\000\002Q\000\000\000\000\n\"\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\nb\002Q\000\000\002Q\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002Q\000\000\005\190\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\003\246\002Q\002Q\002Q\006\154\000\000\004\002\000\000\000\000\000\000\002Q\002Q\n*\nj\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\000\000\002Q\002Q\000\000\000\000\000\000\000\000\000\000\000\000\002Q\002Q\002Q\000\000\002Q\002Q\002Q\002Q\000\000\000\000\000\000\002Q\000\000\002Q\002Q\000\000\002Q\002Q\002Q\002Q\002Q\002Q\000\000\000\000\002Q\002Q\002Q\000\000\000\000\000\000\000\000\002Q\002Q\002Q\002Q\002M\002M\000\000\000\000\000\000\002M\000\000\002\190\002M\000\000\000\000\002M\000\000\002M\000\000\000\000\n\"\000\000\002M\002M\002M\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002M\000\000\002M\000\000\000\000\000\000\000\000\000\000\002M\002M\n\138\n\146\002M\000\000\t\226\003\n\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\002M\002M\000\238\012.\000\000\012>\000\000\000\000\000\000\002M\002M\n*\nj\n\162\n\170\002M\002M\002M\000\000\000\000\002M\000\000\002M\002M\000\000\000\000\000\000\000\000\000\000\000\000\002M\002M\002M\000\000\002M\002M\002M\002M\000\000\000\000\000\000\002M\000\000\002M\002M\000\000\002M\002M\002M\n\178\002M\002M\000\000\000\000\002M\002M\002M\000\000\000\000\000\000\000\000\002M\002M\002M\002M\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\190\002\169\000\000\000\000\002\169\000\000\002\169\000\000\000\000\n\"\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\169\000\000\002\169\000\000\000\000\000\000\000\000\000\000\002\169\002\169\n\138\n\146\002\169\000\000\012\238\003\n\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\r\002\000\000\r\022\000\000\000\000\000\000\002\169\002\169\n*\nj\n\162\002\169\002\169\002\169\002\169\000\000\000\000\002\169\000\000\002\169\002\169\000\000\000\000\000\000\000\000\000\000\000\000\002\169\002\169\002\169\000\000\002\169\002\169\002\169\002\169\000\000\000\000\000\000\002\169\000\000\002\169\002\169\000\000\002\169\002\169\002\169\n\178\002\169\002\169\000\000\000\000\002\169\002\169\002\169\000\000\000\000\000\000\000\000\002\169\002\169\002\169\002\169\002I\002I\000\000\000\000\000\000\002I\000\000\000\000\002I\000\000\000\000\002I\000\000\002I\000\000\000\000\n\"\000\000\002I\002I\002I\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002I\000\000\002I\000\000\000\000\000\000\000\000\000\000\002I\002I\n\138\n\146\002I\000\000\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\002I\002I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\n*\nj\n\162\n\170\002I\002I\002I\000\000\000\000\002I\000\000\002I\002I\000\000\000\000\000\000\000\000\000\000\000\000\002I\002I\002I\000\000\002I\002I\002I\002I\000\000\000\000\000\000\002I\000\000\002I\002I\000\000\002I\002I\002I\n\178\002I\002I\000\000\000\000\002I\002I\002I\000\000\000\000\000\000\000\000\002I\002I\002I\002I\002\129\002\129\000\000\000\000\000\000\002\129\000\000\000\000\002\129\000\000\000\000\002\129\000\000\002\129\000\000\000\000\n\"\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\129\000\000\002\129\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n\138\n\146\002\129\000\000\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\n*\nj\n\162\n\170\002\129\002\129\002\129\000\000\000\000\002\129\000\000\002\129\002\129\000\000\000\000\000\000\000\000\000\000\000\000\002\129\002\129\002\129\000\000\002\129\002\129\002\129\002\129\000\000\000\000\000\000\002\129\000\000\002\129\002\129\000\000\002\129\002\129\002\129\n\178\002\129\002\129\000\000\000\000\002\129\002\129\002\129\000\000\000\000\000\000\000\000\002\129\002\129\002\129\002\129\002y\002y\000\000\000\000\000\000\002y\000\000\000\000\002y\000\000\000\000\002y\000\000\002y\000\000\000\000\n\"\000\000\002y\002y\002y\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002y\000\000\002y\000\000\000\000\000\000\000\000\000\000\002y\002y\n\138\n\146\002y\000\000\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\002y\002y\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\n*\nj\n\162\n\170\002y\002y\002y\000\000\000\000\002y\000\000\002y\002y\000\000\000\000\000\000\000\000\000\000\000\000\002y\002y\002y\000\000\002y\002y\002y\002y\000\000\000\000\000\000\002y\000\000\002y\002y\000\000\002y\002y\002y\n\178\002y\002y\000\000\000\000\002y\002y\002y\000\000\000\000\000\000\000\000\002y\002y\002y\002y\002\137\002\137\000\000\000\000\000\000\002\137\000\000\000\000\002\137\000\000\000\000\002\137\000\000\002\137\000\000\000\000\n\"\000\000\002\137\002\137\002\137\000\000\002\137\002\137\002\137\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\137\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\138\n\146\002\137\000\000\000\000\000\000\000\000\002\137\000\000\n\154\002\137\000\000\000\000\000\000\000\000\002\137\002\137\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n*\nj\n\162\n\170\n\186\002\137\002\137\000\000\000\000\002\137\000\000\002\137\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\137\002\137\n\202\000\000\002\137\002\137\002\137\002\137\000\000\000\000\000\000\002\137\000\000\002\137\002\137\000\000\002\137\002\137\002\137\n\178\002\137\002\137\000\000\000\000\002\137\n\210\002\137\000\000\000\000\000\000\000\000\002\137\002\137\n\218\n\226\002\141\002\141\000\000\000\000\000\000\002\141\000\000\000\000\002\141\000\000\000\000\002\141\000\000\002\141\000\000\000\000\n\"\000\000\002\141\002\141\002\141\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\141\000\000\002\141\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\138\n\146\002\141\000\000\000\000\000\000\000\000\002\141\000\000\n\154\002\141\000\000\000\000\000\000\000\000\002\141\002\141\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n*\nj\n\162\n\170\n\186\002\141\002\141\000\000\000\000\002\141\000\000\002\141\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\141\002\141\n\202\000\000\002\141\002\141\002\141\002\141\000\000\000\000\000\000\002\141\000\000\002\141\002\141\000\000\002\141\002\141\002\141\n\178\002\141\002\141\000\000\000\000\002\141\002\141\002\141\000\000\000\000\000\000\000\000\002\141\002\141\n\218\n\226\002\145\002\145\000\000\000\000\000\000\002\145\000\000\000\000\002\145\000\000\000\000\002\145\000\000\002\145\000\000\000\000\n\"\000\000\002\145\002\145\002\145\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\002\145\000\000\002\145\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\138\n\146\002\145\000\000\000\000\000\000\000\000\002\145\000\000\n\154\002\145\000\000\000\000\000\000\000\000\002\145\002\145\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n*\nj\n\162\n\170\n\186\002\145\002\145\000\000\000\000\002\145\000\000\002\145\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\145\002\145\n\202\000\000\002\145\002\145\002\145\002\145\000\000\000\000\000\000\002\145\000\000\002\145\002\145\000\000\002\145\002\145\002\145\n\178\002\145\002\145\000\000\000\000\002\145\002\145\002\145\000\000\000\000\000\000\000\000\002\145\002\145\n\218\n\226\b\245\b\245\000\000\000\000\000\000\b\245\000\000\000\000\b\245\000\000\000\000\b\245\000\000\b\245\000\000\000\000\n\"\000\000\b\245\b\245\b\245\000\000\b\245\b\245\b\245\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\b\245\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n\138\n\146\b\245\000\000\000\000\000\000\000\000\b\245\000\000\n\154\b\245\000\000\000\000\000\000\000\000\b\245\b\245\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n*\nj\n\162\n\170\n\186\b\245\b\245\000\000\000\000\b\245\000\000\b\245\n\194\000\000\000\000\000\000\000\000\000\000\000\000\b\245\b\245\n\202\000\000\b\245\b\245\b\245\b\245\000\000\000\000\000\000\b\245\000\000\b\245\b\245\000\000\b\245\b\245\b\245\n\178\b\245\b\245\000\000\000\000\b\245\n\210\b\245\000\000\000\000\000\000\000\000\b\245\b\245\n\218\n\226\002\149\002\149\000\000\000\000\000\000\002\149\000\000\000\000\002\149\000\000\000\000\002\149\000\000\002\149\000\000\000\000\n\"\000\000\002\149\002\149\002\149\000\000\002\149\002\149\002\149\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\149\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\138\n\146\002\149\000\000\000\000\000\000\000\000\002\149\000\000\n\154\002\149\000\000\000\000\000\000\000\000\002\149\002\149\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n*\nj\n\162\n\170\n\186\002\149\002\149\000\000\000\000\002\149\000\000\002\149\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\149\002\149\n\202\000\000\002\149\002\149\002\149\002\149\000\000\000\000\000\000\002\149\000\000\002\149\002\149\000\000\n\234\002\149\n\242\n\178\002\149\002\149\000\000\000\000\002\149\n\210\002\149\000\000\000\000\000\000\000\000\002\149\002\149\n\218\n\226\b\241\b\241\000\000\000\000\000\000\b\241\000\000\000\000\b\241\000\000\000\000\b\241\000\000\b\241\000\000\000\000\n\"\000\000\b\241\b\241\b\241\000\000\b\241\b\241\b\241\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\b\241\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n\138\n\146\b\241\000\000\000\000\000\000\000\000\b\241\000\000\n\154\b\241\000\000\000\000\000\000\000\000\b\241\b\241\000\238\000\000\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n*\nj\n\162\n\170\n\186\b\241\b\241\000\000\000\000\b\241\000\000\b\241\n\194\000\000\000\000\000\000\000\000\000\000\000\000\b\241\b\241\n\202\000\000\b\241\b\241\b\241\b\241\000\000\000\000\000\000\b\241\000\000\b\241\b\241\000\000\b\241\b\241\b\241\n\178\b\241\b\241\000\000\000\000\b\241\n\210\b\241\000\000\000\000\000\000\000\000\b\241\b\241\n\218\n\226\002\193\002\193\000\000\000\000\000\000\002\193\000\000\000\000\002\193\000\000\000\000\002\193\000\000\002\193\000\000\000\000\n\"\000\000\002\193\002\193\002\193\000\000\002\193\002\193\002\193\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\193\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\138\n\146\002\193\000\000\000\000\000\000\000\000\002\193\000\000\n\154\002\193\000\000\000\000\000\000\000\000\002\193\002\193\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n*\nj\n\162\n\170\n\186\002\193\002\193\000\000\000\000\002\193\000\000\002\193\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\193\002\193\n\202\000\000\002\193\002\193\002\193\002\193\000\000\000\000\000\000\002\193\000\000\002\193\002\193\000\000\n\234\002\193\n\242\n\178\002\193\002\193\000\000\000\000\002\193\n\210\002\193\000\000\000\000\000\000\000\000\002\193\002\193\n\218\n\226\002\209\002\209\000\000\000\000\000\000\002\209\000\000\000\000\002\209\000\000\000\000\002\209\000\000\002\209\000\000\000\000\n\"\000\000\002\209\002\209\002\209\000\000\002\209\002\209\002\209\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\209\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\138\n\146\002\209\000\000\000\000\000\000\000\000\002\209\000\000\n\154\002\209\000\000\000\000\000\000\000\000\002\209\002\209\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n*\nj\n\162\n\170\n\186\002\209\002\209\000\000\000\000\002\209\000\000\002\209\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\209\002\209\n\202\000\000\002\209\002\209\002\209\002\209\000\000\000\000\000\000\002\209\000\000\002\209\002\209\000\000\n\234\002\209\n\242\n\178\002\209\002\209\000\000\000\000\002\209\n\210\002\209\000\000\000\000\000\000\000\000\002\209\002\209\n\218\n\226\002\201\002\201\000\000\000\000\000\000\002\201\000\000\000\000\002\201\000\000\000\000\002\201\000\000\002\201\000\000\000\000\n\"\000\000\002\201\002\201\002\201\000\000\002\201\002\201\002\201\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\201\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\138\n\146\002\201\000\000\000\000\000\000\000\000\002\201\000\000\n\154\002\201\000\000\000\000\000\000\000\000\002\201\002\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n*\nj\n\162\n\170\n\186\002\201\002\201\000\000\000\000\002\201\000\000\002\201\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\201\002\201\n\202\000\000\002\201\002\201\002\201\002\201\000\000\000\000\000\000\002\201\000\000\002\201\002\201\000\000\n\234\002\201\n\242\n\178\002\201\002\201\000\000\000\000\002\201\n\210\002\201\000\000\000\000\000\000\000\000\002\201\002\201\n\218\n\226\002\181\002\181\000\000\000\000\000\000\002\181\000\000\000\000\002\181\000\000\000\000\002\181\000\000\002\181\000\000\000\000\n\"\000\000\002\181\002\181\002\181\000\000\002\181\002\181\002\181\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\181\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\138\n\146\002\181\000\000\000\000\000\000\000\000\002\181\000\000\n\154\002\181\000\000\000\000\000\000\000\000\002\181\002\181\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n*\nj\n\162\n\170\n\186\002\181\002\181\000\000\000\000\002\181\000\000\002\181\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\181\002\181\n\202\000\000\002\181\002\181\002\181\002\181\000\000\000\000\000\000\002\181\000\000\002\181\002\181\000\000\n\234\002\181\n\242\n\178\002\181\002\181\000\000\000\000\002\181\n\210\002\181\000\000\000\000\000\000\000\000\002\181\002\181\n\218\n\226\002\189\002\189\000\000\000\000\000\000\002\189\000\000\000\000\002\189\000\000\000\000\002\189\000\000\002\189\000\000\000\000\n\"\000\000\002\189\002\189\002\189\000\000\002\189\002\189\002\189\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\189\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\138\n\146\002\189\000\000\000\000\000\000\000\000\002\189\000\000\n\154\002\189\000\000\000\000\000\000\000\000\002\189\002\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n*\nj\n\162\n\170\n\186\002\189\002\189\000\000\000\000\002\189\000\000\002\189\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\189\002\189\n\202\000\000\002\189\002\189\002\189\002\189\000\000\000\000\000\000\002\189\000\000\002\189\002\189\000\000\n\234\002\189\n\242\n\178\002\189\002\189\000\000\000\000\002\189\n\210\002\189\000\000\000\000\000\000\000\000\002\189\002\189\n\218\n\226\002\185\002\185\000\000\000\000\000\000\002\185\000\000\000\000\002\185\000\000\000\000\002\185\000\000\002\185\000\000\000\000\n\"\000\000\002\185\002\185\002\185\000\000\002\185\002\185\002\185\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\185\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\138\n\146\002\185\000\000\000\000\000\000\000\000\002\185\000\000\n\154\002\185\000\000\000\000\000\000\000\000\002\185\002\185\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n*\nj\n\162\n\170\n\186\002\185\002\185\000\000\000\000\002\185\000\000\002\185\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\185\002\185\n\202\000\000\002\185\002\185\002\185\002\185\000\000\000\000\000\000\002\185\000\000\002\185\002\185\000\000\n\234\002\185\n\242\n\178\002\185\002\185\000\000\000\000\002\185\n\210\002\185\000\000\000\000\000\000\000\000\002\185\002\185\n\218\n\226\002\197\002\197\000\000\000\000\000\000\002\197\000\000\000\000\002\197\000\000\000\000\002\197\000\000\002\197\000\000\000\000\n\"\000\000\002\197\002\197\002\197\000\000\002\197\002\197\002\197\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\197\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\138\n\146\002\197\000\000\000\000\000\000\000\000\002\197\000\000\n\154\002\197\000\000\000\000\000\000\000\000\002\197\002\197\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n*\nj\n\162\n\170\n\186\002\197\002\197\000\000\000\000\002\197\000\000\002\197\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\197\002\197\n\202\000\000\002\197\002\197\002\197\002\197\000\000\000\000\000\000\002\197\000\000\002\197\002\197\000\000\n\234\002\197\n\242\n\178\002\197\002\197\000\000\000\000\002\197\n\210\002\197\000\000\000\000\000\000\000\000\002\197\002\197\n\218\n\226\002\213\002\213\000\000\000\000\000\000\002\213\000\000\000\000\002\213\000\000\000\000\002\213\000\000\002\213\000\000\000\000\n\"\000\000\002\213\002\213\002\213\000\000\002\213\002\213\002\213\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\213\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\138\n\146\002\213\000\000\000\000\000\000\000\000\002\213\000\000\n\154\002\213\000\000\000\000\000\000\000\000\002\213\002\213\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n*\nj\n\162\n\170\n\186\002\213\002\213\000\000\000\000\002\213\000\000\002\213\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\213\n\202\000\000\002\213\002\213\002\213\002\213\000\000\000\000\000\000\002\213\000\000\002\213\002\213\000\000\n\234\002\213\n\242\n\178\002\213\002\213\000\000\000\000\002\213\n\210\002\213\000\000\000\000\000\000\000\000\002\213\002\213\n\218\n\226\002\205\002\205\000\000\000\000\000\000\002\205\000\000\000\000\002\205\000\000\000\000\002\205\000\000\002\205\000\000\000\000\n\"\000\000\002\205\002\205\002\205\000\000\002\205\002\205\002\205\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\205\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\138\n\146\002\205\000\000\000\000\000\000\000\000\002\205\000\000\n\154\002\205\000\000\000\000\000\000\000\000\002\205\002\205\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n*\nj\n\162\n\170\n\186\002\205\002\205\000\000\000\000\002\205\000\000\002\205\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\205\002\205\n\202\000\000\002\205\002\205\002\205\002\205\000\000\000\000\000\000\002\205\000\000\002\205\002\205\000\000\n\234\002\205\n\242\n\178\002\205\002\205\000\000\000\000\002\205\n\210\002\205\000\000\000\000\000\000\000\000\002\205\002\205\n\218\n\226\002\177\002\177\000\000\000\000\000\000\002\177\000\000\000\000\002\177\000\000\000\000\002\177\000\000\002\177\000\000\000\000\n\"\000\000\002\177\002\177\002\177\000\000\002\177\002\177\002\177\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\177\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\138\n\146\002\177\000\000\000\000\000\000\000\000\002\177\000\000\n\154\002\177\000\000\000\000\000\000\000\000\002\177\002\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n*\nj\n\162\n\170\n\186\002\177\002\177\000\000\000\000\002\177\000\000\002\177\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\177\002\177\n\202\000\000\002\177\002\177\002\177\002\177\000\000\000\000\000\000\002\177\000\000\002\177\002\177\000\000\n\234\002\177\n\242\n\178\002\177\002\177\000\000\000\000\002\177\n\210\002\177\000\000\000\000\000\000\000\000\002\177\002\177\n\218\n\226\002\001\002\001\000\000\000\000\000\000\002\001\000\000\000\000\002\001\000\000\000\000\002\001\000\000\002\001\000\000\000\000\002\001\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\002\001\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\000\000\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\000\000\002\001\002\001\000\000\000\000\000\000\000\000\000\000\000\000\002\001\002\001\002\001\000\000\002\001\002\001\002\001\002\001\000\000\000\000\000\000\002\001\000\000\002\001\002\001\000\000\002\001\002\001\002\001\002\001\002\001\002\001\000\000\000\000\002\001\002\001\014*\000\000\000\000\000\000\000\000\002\001\002\001\002\001\002\001\002\029\002\029\000\000\000\000\000\000\002\029\000\000\000\000\002\029\000\000\000\000\002\029\000\000\002\029\000\000\000\000\n\"\000\000\002\029\002\029\002\029\000\000\002\029\002\029\002\029\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\029\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\138\n\146\002\029\000\000\000\000\000\000\000\000\002\029\000\000\n\154\002\029\000\000\000\000\000\000\000\000\002\029\002\029\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n*\nj\n\162\n\170\n\186\002\029\002\029\000\000\000\000\002\029\000\000\002\029\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\029\002\029\n\202\000\000\002\029\002\029\014B\002\029\000\000\000\000\000\000\002\029\000\000\002\029\002\029\000\000\n\234\002\029\n\242\n\178\002\029\002\029\000\000\000\000\002\029\n\210\002\029\000\000\000\000\000\000\000\000\002\029\002\029\n\218\n\226\002\025\002\025\000\000\000\000\000\000\002\025\000\000\000\000\002\025\000\000\000\000\002\025\000\000\002\025\000\000\000\000\n\"\000\000\002\025\002\025\002\025\000\000\002\025\002\025\002\025\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\025\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\138\n\146\002\025\000\000\000\000\000\000\000\000\002\025\000\000\n\154\002\025\000\000\000\000\000\000\000\000\002\025\002\025\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n*\nj\n\162\n\170\n\186\002\025\002\025\000\000\000\000\002\025\000\000\002\025\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\025\002\025\n\202\000\000\002\025\002\025\002\025\002\025\000\000\000\000\000\000\002\025\000\000\002\025\002\025\000\000\n\234\002\025\n\242\n\178\002\025\002\025\000\000\000\000\002\025\n\210\002\025\000\000\000\000\000\000\000\000\002\025\002\025\n\218\n\226\002\173\002\173\000\000\000\000\000\000\002\173\000\000\000\000\002\173\000\000\000\000\002\173\000\000\002\173\000\000\000\000\n\"\000\000\002\173\002\173\002\173\000\000\002\173\002\173\002\173\000\000\000\000\000\000\000\000\000\000\nZ\nr\nz\nb\n\130\000\000\002\173\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\138\n\146\002\173\000\000\000\000\000\000\000\000\002\173\000\000\n\154\002\173\000\000\000\000\000\000\000\000\002\173\002\173\000\238\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n*\nj\n\162\n\170\n\186\002\173\002\173\000\000\000\000\002\173\000\000\002\173\n\194\000\000\000\000\000\000\000\000\000\000\000\000\002\173\002\173\n\202\000\000\002\173\002\173\002\173\002\173\000\000\000\000\000\000\002\173\000\000\002\173\002\173\000\000\n\234\002\173\n\242\n\178\002\173\002\173\000\000\000\000\002\173\n\210\002\173\000\000\000\000\000\000\000\000\002\173\002\173\n\218\n\226\002\r\002\r\000\000\000\000\000\000\002\r\000\000\000\000\002\r\000\000\000\000\002\r\000\000\002\r\000\000\000\000\002\r\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\002\r\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\000\000\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\000\000\002\r\002\r\000\000\000\000\000\000\000\000\000\000\000\000\002\r\002\r\002\r\000\000\002\r\002\r\002\r\002\r\000\000\000\000\000\000\002\r\000\000\002\r\002\r\000\000\002\r\002\r\002\r\002\r\002\r\002\r\000\000\000\000\002\r\002\r\014*\000\000\000\000\000\000\000\000\002\r\002\r\002\r\002\r\002\017\002\017\000\000\000\000\000\000\002\017\000\000\000\000\002\017\000\000\000\000\002\017\000\000\002\017\000\000\000\000\002\017\000\000\002\017\002\017\002\017\000\000\002\017\002\017\002\017\000\000\000\000\006>\000\000\000\000\002\017\002\017\002\017\002\017\002\017\000\000\002\017\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\006B\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\002\017\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\000\000\002\017\002\017\000\000\000\000\000\000\000\000\000\000\000\238\002\017\002\017\002\017\000\000\002\017\002\017\002\017\002\017\000\000\000\000\000\000\002\017\000\000\002\017\002\017\000\000\002\017\002\017\002\017\002\017\002\017\002\017\000\000\000\000\002\017\002\017\014*\000\000\000\000\000\000\000\000\002\017\002\017\002\017\002\017\001\006\000\000\000\006\000\000\007\029\000\000\002\186\002\190\006F\002\234\002\130\005\234\006R\000\000\000\000\002\246\001\n\000\000\006f\000\000\002\142\000\000\006r\007\029\000\000\001\210\003\206\007\029\002\190\0036\001\018\b\206\b\210\001\030\001\"\003\170\000\000\000\000\003F\000\000\002\254\bB\025j\000\000\b\246\b\250\001\210\003\222\0032\003\234\b\254\007\030\000\000\001:\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\003\202\001>\001B\001F\001J\001N\000\000\002\178\t\018\001R\000\000\007\017\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\001Z\000\000\000\000\000\000\007\029\000\000\001^\002\225\007\017\000\000\000\000\018\202\007\017\0072\000\000\000\000\001\154\0062\000\000\011&\005\138\b\146\0112\001\158\000\000\014r\004r\t\150\001\006\001\166\000\006\001\170\001\174\0256\002\186\002\190\000\n\002\234\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\b\202\000\000\000\238\000\000\002\225\001\210\000\000\000\000\000\000\0036\001\018\b\206\b\210\001\030\001\"\000\000\002\225\002\225\003F\000\000\002\254\000\000\b\214\000\000\b\246\b\250\000\238\003\222\0032\003\234\b\254\007\030\000\000\001:\000\000\002\178\006\245\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\b\158\006F\005v\000\000\005\234\001>\001B\001F\001J\001N\006\245\006f\t\018\001R\006\245\006r\000\000\001V\000\000\t\030\t6\t\130\005\130\005\134\000\000\006F\001Z\000\000\005\234\025:\000\000\000\000\001^\000\000\000\000\006f\000\000\000\000\000\000\006r\000\000\000\000\001\154\006\134\000\000\000\000\005\138\b\146\012\205\001\158\000\000\014r\004r\t\150\004y\001\166\000\006\001\170\001\174\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\012\205\002\246\000\000\002\030\003\178\000\000\002\"\000\000\004y\000\000\003\182\001\210\000\000\017F\006\245\002\250\000\000\003>\003B\002.\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\004\026\003\222\0032\003\234\003\242\007\030\000\000\000\000\017>\002\178\000\000\000\000\003:\017V\002:\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\t\018\000\000\t!\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\000\004y\004y\000\000\000\000\000\000\006\178\004\005\000\000\t!\000\000\000\000\002>\012\205\012\185\000\000\000\000\017\218\021\230\005\138\b\146\025V\000\173\000\000\b\170\004r\t\150\000\173\000\000\002\190\000\173\000\000\002\130\012\205\t\190\000\000\002\030\002\246\000\000\002\"\000\173\000\000\000\173\000\000\000\173\000\000\000\173\001\210\000\238\t\198\000\000\002\250\002.\000\000\000\000\0026\012\185\t\206\000\173\000\000\000\000\000\000\002\254\000\000\000\173\000\000\000\000\000\000\000\173\000\000\0032\001\190\015\174\000\173\000\000\002\130\000\173\002\178\004\005\002:\003:\000\173\000\173\000\173\bz\b~\b\138\000\000\012\150\005v\000\173\000\173\006F\021\142\000\000\005\234\tR\000\173\000\000\000\000\t!\000\173\006f\000\000\000\000\000\000\006r\000\000\000\000\005\130\005\134\000\173\000\173\015\178\000\000\000\173\000\173\000\000\000\000\000\000\000\000\000\000\000\000\002>\000\000\000\173\000\000\015\190\000\000\021\178\000\000\000\173\000\173\005\138\b\146\000\000\000\000\000\197\b\170\004r\000\000\000\173\000\197\000\173\002\190\000\197\000\000\002\130\000\000\t\190\000\000\000\000\002\246\005\134\000\000\000\197\000\000\000\197\000\000\000\197\000\000\000\197\001\210\021\190\t\198\000\000\002\250\000\000\000\000\000\000\000\000\000\000\t\206\000\197\000\000\t2\000\000\002\254\000\000\000\197\021R\000\000\000\000\000\197\000\000\0032\001\190\000\000\000\197\000\000\000\000\000\197\002\178\000\000\000\000\003:\000\197\000\197\000\197\bz\b~\b\138\000\000\012\150\005v\000\197\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\014\022\000\197\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\197\000\197\000\000\000\000\000\197\000\197\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\197\000\000\000\000\000\000\000\000\000\000\000\197\000\197\005\138\b\146\000\000\000\000\000\000\b\170\004r\000\000\000\197\000\000\000\197\000\014\000\018\000\022\000\026\000\030\000\000\000\"\000&\000*\000.\0002\000\000\0006\000:\000\000\000\000\000>\016\154\006F\000\000\000B\005\234\015\174\000\000\002\006\002\130\000\000\000F\006f\000\000\000\000\000\000\006r\000J\002\n\000N\000R\000V\000Z\000^\000b\000f\001\210\000\000\000\000\000j\000n\000\000\000r\000\000\000v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\154\000\000\000\000\000\000\015\178\000z\007J\001\222\000~\000\130\000\000\000\000\000\000\002\178\000\000\000\134\000\138\000\142\015\190\000\000\021\146\000\000\000\000\000\146\000\150\000\154\000\158\000\000\000\162\000\166\000\170\000\000\001\r\000\000\000\174\000\178\000\182\001\r\000\000\000\000\000\186\007N\000\190\000\194\005\134\000\000\000\000\000\000\000\000\000\000\000\198\000\000\000\202\000\000\021\158\000\000\001\r\003\213\000\206\000\210\000\000\000\214\003\213\003V\002\190\003\213\000\000\002\130\000\000\006\238\000\000\021R\002\246\000\000\000\000\003\213\000\000\000\000\001\r\003\213\003R\003\213\001\210\007\189\007\014\000\000\001\r\000\000\000\000\003Z\000\000\001\r\tB\003\213\000\000\n\205\000\000\000\000\000\000\003\213\001\r\001\r\003f\000\000\000\000\011\006\001\190\000\000\003\213\000\000\000\000\003\213\002\178\007\189\000\000\003\246\003\213\003\213\n\201\003\250\000\000\004\002\000\000\011\022\005v\n\205\001\r\007\189\000\000\000\000\007\189\t\006\003\213\003\213\000\000\001\r\005z\007\189\000\000\n\205\000\000\007\189\n\205\011\178\005\130\005\134\003\213\003\213\011\030\n\205\003\213\003\213\000\000\n\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\201\011&\000\000\n\201\011f\003\213\005\138\000\000\000\000\000\000\n\201\000\000\004r\t\r\n\201\000\006\003\213\000\000\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\004\153\000\000\t\r\000\000\t\r\t\r\003\182\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\000\000\017>\002\178\000\000\000\000\003:\017V\000\000\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\t\018\000\000\028F\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\006\028g\015\006\000\246\002\186\002\190\002\194\002\234\002\130\000\000\000\000\000\000\000\000\002\246\000\000\000\000\028\150\000\000\021\230\005\138\b\146\t\r\003\182\001\210\b\170\004r\t\150\002\250\000\000\003>\003B\000\000\000\000\000\000\003\186\000\000\003F\000\000\002\254\000\000\016\218\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\016\170\017>\002\178\000\000\000\000\003:\017V\002\006\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\002\n\000\000\000\000\000\000\000\000\017^\000\000\t\018\001\210\028F\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\017r\017\158\000\000\000\000\004\161\000\000\003\154\000\000\000\000\000\000\001\006\000\000\007J\001\222\000\000\000\000\003V\002\190\006\014\002\178\002\130\021\230\005\138\b\146\014\134\002\246\001\n\b\170\004r\t\150\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\007N\000\000\000\000\002\225\000\000\003z\002\225\001.\006.\000\000\000\000\003r\001\190\0016\002\225\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\n\005v\000\000\002\225\001>\001B\001F\001J\001N\000\000\000\000\000\n\001R\005z\000\000\002\225\001V\000\000\000\000\000\000\002\225\005\130\005\134\000\000\005\202\001Z\002\225\002\225\002\225\002\225\000\000\001^\000\000\002\225\000\000\000\000\000\000\000\000\000\000\002\225\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\002\225\001\170\001\174\003V\002\190\tr\002\225\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003V\002\190\011\n\000\000\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\001\006\000\000\001\166\000\000\001\170\001\174\003V\002\190\r\214\000\000\002\130\000\000\000\000\000\000\000\000\002\246\001\n\000\000\000\000\000\000\002\142\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\001\014\001\018\001\022\003v\001\030\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003z\000\000\001.\006.\000\000\000\000\003r\001\190\0016\000\000\000\000\001:\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\001>\001B\001F\001J\001N\000\000\000\000\000\000\001R\005z\000\000\000\000\001V\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\001Z\000\000\000\000\000\000\000\000\000\000\001^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\154\0062\000\000\000\000\005\138\000\000\000\000\001\158\000\000\001\162\004r\000\000\005\t\001\166\000\000\001\170\001\174\005\t\005\t\005\t\005\t\b\021\005\t\000\000\005\t\005\t\b\021\000\000\005\t\000\000\005\t\000\000\005\t\005\t\005\t\005\t\005\t\005\t\000\000\005\t\005\t\005\t\000\000\000\000\000\000\b\021\000\000\000\000\005\t\000\000\000\000\000\000\000\000\005\t\005\t\005\t\000\000\000\000\000\000\005\t\005\t\005\t\000\000\005\t\000\000\000\000\005\t\b\021\005\t\000\000\000\000\005\t\005\t\005\t\000\000\b\021\005\t\005\t\005\t\000\000\b\021\b\021\000\238\000\000\000\000\005\t\005\t\005\t\000\000\b\021\b\021\005\t\005\t\000\000\000\000\000\000\005\t\000\000\000\000\005\t\000\000\005\t\005\t\005\t\000\000\005\t\005\t\005\t\005\t\000\000\005\t\005\t\b\021\000\000\000\000\b\021\000\000\000\000\000\000\000\000\005\t\020b\005\t\005\t\b\021\000\000\002\150\005\t\000\000\000\000\000\000\000\000\005\t\005\t\n\229\000\000\005\t\n\229\005\t\005\t\n\229\n\229\012\205\012\185\n\229\000\000\n\229\000\000\000\000\n\229\000\000\000\000\000\000\n\229\n\229\000\000\n\229\n\229\000\000\n\229\000\000\n\229\012\205\025\130\000\000\002\030\n\229\000\000\002\"\n\229\002\006\000\000\000\000\000\000\000\000\002*\000\000\n\229\000\000\n\229\002\n\002.\n\229\n\229\0026\012\185\000\000\000\000\001\210\n\229\000\000\000\000\n\229\000\000\000\000\n\229\n\229\000\000\n\229\000\000\n\229\n\229\000\000\000\000\000\000\003\154\000\000\000\000\002:\000\000\000\000\007J\001\222\n\229\000\000\000\000\000\000\000\000\002\178\000\000\000\000\n\229\n\229\000\000\000\000\n\229\000\000\n\229\000\000\000\000\000\000\000\000\005\166\000\000\000\000\000\000\000\000\001\202\001\206\n\229\n\229\000\000\n\229\n\229\000\000\n\229\007N\n\229\000\000\n\229\000\000\n\229\002>\n\229\b\249\b\249\001\210\001\214\001\230\b\249\000\000\001\206\b\249\000\000\000\000\000\000\001\242\000\000\000\000\018\246\b\249\000\000\b\249\b\249\b\249\000\000\b\249\b\249\b\249\001\246\020^\000\000\019~\000\000\002\158\000\000\002\178\004\030\004*\000\000\b\249\000\000\000\000\020n\000\000\000\000\b\249\b\249\000\000\000\000\b\249\000\000\000\000\002\154\000\000\b\249\000\000\000\000\b\249\000\000\004:\000\000\000\000\b\249\b\249\b\249\000\000\000\000\000\000\000\000\000\000\000\000\b\249\b\249\000\000\000\000\000\000\000\000\000\000\b\249\000\000\000\000\000\000\004\154\000\000\000\000\b\249\000\000\000\000\000\000\000\000\000\000\000\000\b\249\b\249\b\249\000\000\b\249\b\249\000\000\004e\000\000\000\000\000\000\000\000\004e\000\000\b\249\004e\b\249\b\249\000\000\000\000\000\000\b\249\000\000\000\000\000\000\004e\b\249\000\000\000\000\004e\b\249\004e\b\249\b\249\012\141\012\141\000\000\000\000\004e\012\141\000\000\001\206\012\141\004e\000\000\000\000\000\000\000\000\000\000\004e\004\186\000\000\012\141\012\141\012\141\004B\012\141\012\141\012\141\000\000\000\000\004e\004e\000\000\000\000\000\000\004e\002\226\000\000\000\000\012\141\000\000\000\000\000\000\000\000\000\000\012\141\012\141\000\000\000\000\012\141\000\000\004e\002\154\004e\012\141\000\000\000\000\012\141\000\000\000\000\000\000\004e\012\141\012\141\012\141\004e\004e\002\226\000\238\004e\004e\012\141\012\141\000\000\000\000\004R\004e\000\000\012\141\000\000\000\000\000\000\004\154\000\000\000\000\012\141\004e\000\000\000\000\000\000\000\000\021f\012\141\012\141\012\141\000\000\012\141\012\141\000\000\007\005\000\000\004e\000\000\000\000\007\005\000\000\012\141\007\005\012\141\012\141\004e\000\000\000\000\012\141\000\000\000\000\000\000\007\005\012\141\000\000\000\000\007\005\012\141\007\005\012\141\012\141\b\253\b\253\000\000\000\000\000\000\b\253\000\000\001\206\b\253\007\005\000\000\000\000\000\000\000\000\000\000\007\005\b\253\000\000\b\253\b\253\b\253\000\000\b\253\b\253\b\253\000\000\000\000\007\005\000\000\000\000\000\000\000\000\007\005\007\005\000\000\000\000\b\253\000\000\000\000\000\000\000\000\000\000\b\253\b\253\000\000\000\000\b\253\000\000\007\005\002\154\000\000\b\253\000\000\000\000\b\253\000\000\000\000\000\000\000\000\b\253\b\253\b\253\007\005\007\005\016\238\000\000\007\005\007\005\b\253\b\253\002\225\000\000\000\000\000\000\000\000\b\253\000\000\002\225\000\000\004\154\018\030\000\000\b\253\007\005\000\000\000\000\000\000\000\000\002\225\b\253\b\253\b\253\002\225\b\253\b\253\000\000\000\n\002\225\002\225\002\225\000\000\000\000\002\225\b\253\002\225\b\253\b\253\002\225\002\225\002\225\b\253\002\225\002\225\002\225\002\225\b\253\002\225\002\225\002\225\b\253\002\225\b\253\b\253\000\000\002\225\000\n\000\000\002\225\002\225\002\225\000\000\002\225\000\000\002\225\002\225\000\n\002\225\002\225\002\225\000\n\002\225\002\225\002\225\000\000\000\000\001*\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\000\n\002\225\002\225\000\000\002\225\002\225\002\225\000\000\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\000\000\000\000\002\225\000\n\002\225\002\225\002\225\002\225\002\225\000\000\000\000\002\225\002\225\002\225\002\225\002\225\000\000\006\157\002\225\0009\002\225\002\225\000\000\0009\0009\002\225\0009\0009\002\225\000\000\002\225\002\225\0009\000\000\002\225\000\000\000\000\006\157\002\225\002\225\000\000\000\000\0009\002\225\002\225\002\225\0009\003\190\0009\0009\000\000\000\000\000\000\002\225\000\000\0009\000\000\0009\000\000\000\000\000\000\0009\0009\007&\0009\0009\0009\0009\0009\000\000\000\000\000\000\0009\000\000\000\000\0009\000\000\000\000\000\000\0009\0009\0009\0009\000\000\0009\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0009\000\000\000\000\000\000\012\205\012\185\000\000\0009\0009\0009\0009\0009\000\000\006\153\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\012\205\000\000\000\000\002\030\0005\000\000\002\"\000\000\000\000\006\153\0009\0009\000\000\002\206\0005\0009\0009\0009\0005\002.\0005\0005\0026\012\185\000\000\000\000\000\000\0005\000\000\0005\000\000\000\000\000\000\0005\0005\000\000\0005\0005\0005\0005\0005\000\000\000\000\000\000\0005\000\000\002:\0005\000\000\000\000\000\000\0005\0005\0005\0005\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0005\000\000\000\000\000\000\000\000\000\000\000\000\0005\0005\0005\0005\0005\000\000\006\169\000\000\012U\000\000\000\000\000\000\012U\012U\000\000\012U\012U\002>\000\000\000\000\000\000\012U\000\000\000\000\000\000\000\000\006\169\0005\0005\000\000\000\000\012U\0005\0005\0005\012U\000\000\012U\012U\000\000\000\000\000\000\000\000\000\000\012U\000\000\012U\000\000\000\000\000\000\012U\012U\000\000\012U\012U\012U\012U\012U\000\000\000\000\000\000\012U\000\000\000\000\012U\000\000\000\000\000\000\012U\012U\012U\012U\000\000\012U\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012U\000\000\000\000\000\000\000\000\000\000\000\000\012U\012U\012U\012U\012U\000\000\006\165\000\000\012Q\000\000\000\000\000\000\012Q\012Q\000\000\012Q\012Q\000\000\000\000\000\000\000\000\012Q\000\000\000\000\000\000\000\000\006\165\012U\012U\000\000\000\000\012Q\012U\012U\012U\012Q\000\000\012Q\012Q\000\000\000\000\000\000\000\000\000\000\012Q\000\000\012Q\000\000\000\000\000\000\012Q\012Q\000\000\012Q\012Q\012Q\012Q\012Q\000\000\001\202\001\206\012Q\000\000\000\000\012Q\000\000\000\000\000\000\012Q\012Q\012Q\012Q\000\000\012Q\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\012Q\000\000\000\000\000\000\000\000\001\242\000\000\012Q\012Q\012Q\012Q\012Q\001\250\000\000\000\000\000\000\000\000\000\000\001\246\002\146\000\000\000\000\000\000\002\158\000\000\002\178\004\030\004*\012\145\012\145\000\000\000\000\0046\012\145\012Q\012Q\012\145\000\000\000\000\012Q\012Q\012Q\000\000\000\000\004\138\000\000\012\145\012\145\012\145\004:\012\145\012\145\012\145\000\000\001\021\000\000\000\000\000\000\000\000\001\021\000\000\000\000\000\000\000\000\012\145\000\000\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\012\145\000\000\000\000\000\000\001\021\012\145\000\000\000\000\012\145\000\000\000\000\000\000\000\000\012\145\012\145\012\145\000\000\000\000\000\000\000\000\000\000\000\000\012\145\012\145\000\000\000\000\001\021\000\000\018\254\012\145\000\000\000\000\000\000\012\145\001\021\000\000\012\145\000\000\000\000\001\021\000\000\000\000\000\000\012\145\012\145\012\145\000\000\012\145\012\145\001\021\000\000\000\000\000\000\000\000\000\000\000\000\b\017\012\145\000\006\012\145\012\145\b\017\002\186\002\190\012\145\002\234\002\130\000\000\000\000\012\145\000\000\002\246\000\000\012\145\001\021\012\145\012\145\000\000\003\254\000\000\b\017\001\210\000\000\001\021\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\000\000\000\000\003F\000\000\002\254\000\000\000\000\000\000\003\214\003\218\b\017\003\222\0032\003\234\003\242\007\030\000\000\000\000\b\017\002\178\000\000\000\000\003:\b\017\b\017\000\238\bz\b~\b\138\b\158\000\000\005v\b\017\b\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\018\000\000\000\000\000\000\000\000\000\000\000\000\t\030\t6\t\130\005\130\005\134\000\000\000\000\b\017\000\000\000\000\b\017\000\000\000\000\000\000\000\000\000\000\000\006\000\000\000\000\b\017\002\186\002\190\000\000\002\234\002\130\000\000\000\000\005\138\b\146\002\246\000\000\000\000\b\170\004r\t\150\000\000\014\154\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\003>\003B\000\000\000\000\000\000\001\197\000\000\003F\000\000\002\254\001\197\000\000\000\000\003\214\003\218\000\000\003\222\0032\003\234\003\242\007\030\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\001\197\000\000\bz\b~\b\138\b\158\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0059\r\r\t\018\000\000\000\000\005=\r\r\001\197\000\000\t\030\t6\t\130\005\130\005\134\000\000\001\197\000\000\000\000\000\000\0059\001\197\001\197\000\238\0059\005=\000\000\003\029\003\029\005=\001\197\001\197\003\029\000\000\000\000\003\029\000\000\005\138\b\146\000\000\000\000\000\000\b\170\004r\t\150\003\029\003\029\003\029\000\000\003\029\003\029\003\029\000\000\000\000\000\000\000\000\001\197\000\000\000\000\000\000\000\000\000\000\000\000\003\029\000\000\001\197\000\000\000\000\000\000\003\029\004\130\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\r\r\r\r\003\029\000\000\000\000\r\r\r\r\003\029\003\029\003\029\000\000\000\000\000\000\0059\000\000\000\000\003\029\003\029\005=\r\r\000\000\r\r\000\000\003\029\r\r\000\000\r\r\003\029\0059\000\000\003\029\0059\000\000\005=\000\000\000\000\005=\003\029\003\029\003\029\004\137\003\029\003\029\000\000\000\000\019\014\000\000\000\000\000\000\000\000\000\000\003\029\000\000\003\029\003\029\000\000\000\000\000\000\003\029\000\000\000\000\000\000\000\000\003\029\003\182\n\241\000\000\003\029\n\241\003\029\003\029\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\n\241\n\241\019:\n\241\n\241\000\000\001\210\000\000\007\014\000\000\017>\000\000\000\000\003Z\000\000\017V\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\241\019v\003f\000\000\000\000\003r\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\241\003\250\000\000\004\002\005j\011\022\005v\000\000\004\137\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\019\218\005z\001\202\001\206\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\005\202\n\241\000\000\n\241\000\000\000\000\000\000\000\000\000\000\001\210\001\214\000\000\000\000\000\000\000\000\n\241\000\000\000\000\n\241\n\241\000\000\005\138\000\000\n\241\000\000\n\241\000\000\004r\n\237\n\241\000\000\n\237\001\246\002\162\003V\002\190\000\000\002\158\002\130\002\178\004\030\004*\000\000\002\246\000\000\000\000\0046\n\237\n\237\000\000\n\237\n\237\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\026b\000\000\000\000\000\000\000\000\n\237\000\000\003f\000\000\000\000\006\n\001\190\000\000\000\000\000\000\000\000\026N\002\178\000\000\000\000\003\246\000\000\000\000\n\237\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\012q\000\000\000\000\012q\000\000\000\000\005\130\005\134\000\000\005\202\n\237\000\000\n\237\012q\000\000\000\000\000\000\000\000\000\000\012q\000\000\001\221\001\221\000\000\n\237\000\000\001\221\n\237\n\237\001\221\005\138\012q\n\237\000\000\n\237\000\000\004r\012q\n\237\001\221\001\221\001\221\000\000\001\221\001\221\001\221\012q\000\000\000\000\012q\000\000\000\000\000\000\000\000\012q\000\000\000\000\001\221\000\000\000\000\000\000\000\000\000\000\001\221\001\221\000\000\000\000\001\221\000\000\000\000\012q\000\000\001\221\000\000\012q\001\221\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\012q\012q\000\000\000\000\012q\001\221\001\221\000\000\000\000\000\000\028>\000\000\001\221\004\145\000\000\000\000\001\221\000\000\022\014\001\221\000\000\012q\000\000\000\000\000\000\000\000\001\221\001\221\001\221\000\000\001\221\001\221\000\000\000\000\000\000\000\000\000\000\003\182\000\000\000\000\001\221\000\000\001\221\001\221\003V\002\190\000\000\001\221\002\130\000\000\006\238\000\000\001\221\002\246\000\000\000\000\004\254\000\000\001\221\022~\000\000\000\000\000\000\001\210\000\000\007\014\000\000\017>\000\000\000\000\003Z\000\000\017V\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\023\"\0232\003f\000\000\000\000\011\006\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\n\201\003\250\000\000\004\002\000\000\011\022\005v\000\000\004\145\000\000\000\000\000\000\000\000\000\000\000\000\004\017\000\000\024&\005z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\000\000\011\030\005\137\005\137\000\000\000\000\000\000\005\137\000\000\000\000\005\137\000\000\000\000\000\000\000\000\n\201\000\000\000\000\n\201\n\201\005\137\005\138\005\137\000\000\005\137\n\201\005\137\004r\000\000\n\201\004\017\000\000\000\000\000\000\000\000\000\000\000\246\000\000\005\137\002\194\000\000\000\000\000\000\000\000\005\137\005\137\000\000\000\000\000\000\028\150\005\137\000\000\000\000\005\137\000\000\003\182\005\137\000\000\000\000\000\000\000\000\005\137\005\137\005\137\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\000\000\000\000\000\000\005\137\005\137\000\000\000\000\005\137\024\166\000\000\001\006\017>\000\000\000\000\000\000\000\000\017V\005\137\005\137\005\137\000\000\005\137\005\137\000\000\000\000\000\000\001\n\007\246\000\000\000\000\002\142\000\000\017^\000\000\005\137\000\000\028F\005\137\005\137\001\014\001\018\001\022\001\026\001\030\001\"\000\000\017r\017\158\000\000\005\137\004\161\000\000\001&\000\000\001.\0012\000\000\000\000\000\000\000\000\0016\000\000\000\000\001:\000\000\000\000\000\000\021\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\003]\003]\001R\000\000\000\000\003]\001V\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\003]\003]\000\000\003]\001^\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\000\000\001\154\027z\000\000\000\000\003]\003]\003]\001\158\003]\001\162\003]\003]\003]\001\166\000\000\001\170\001\174\005\017\000\000\000\000\003]\000\000\003]\003]\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\000\000\000\000\005\021\000\000\000\000\003]\000\000\000\000\003]\000\000\000\000\000\000\003]\003]\003]\003]\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\003]\003]\003]\000\000\003]\000\000\000\000\005\017\000\000\000\000\000\000\000\000\000\000\000\000\003]\003]\003]\000\000\003]\003]\005}\005}\000\000\000\000\005\021\005}\000\000\000\000\005}\003]\000\000\003]\003]\000\000\000\000\003]\000\000\000\000\005}\000\000\005}\000\000\005}\000\000\005}\000\000\003]\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005}\000\000\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\000\000\000\000\b>\000\000\000\000\005}\000\000\000\000\005}\000\000\000\000\000\000\000\000\005}\005}\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005}\005}\000\000\000\000\005}\000\000\t\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005}\005}\005}\000\000\005}\005}\000\000\000\000\n\"\000\000\000\000\012j\t\t\000\000\t\t\t\t\000\000\005}\000\000\000\000\005}\005}\nZ\nr\nz\nb\n\130\000\000\000\000\001\202\002~\000\000\005}\002\130\000\000\000\000\n\138\n\146\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\154\000\000\000\000\001\210\001\214\001\230\002\134\000\000\000\238\000\000\000\000\000\000\000\000\001\242\001\006\000\000\000\000\n*\nj\n\162\n\170\n\186\000\000\000\000\000\000\000\000\002\138\002\146\000\000\n\194\001\n\002\158\000\000\002\178\004\030\004*\000\000\000\000\n\202\000\000\021>\000\000\021B\001\014\001\018\001\022\001\026\001\030\001\"\000\000\000\000\000\000\n\234\000\000\n\242\n\178\001&\004:\001.\0012\t\t\n\210\000\000\000\000\0016\000\000\005\134\001:\000\000\n\218\n\226\000\000\000\000\000\000\000\000\000\000\021N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001B\001F\001J\001N\000\000\b\133\b\133\001R\021R\000\000\b\133\001V\000\000\b\133\000\000\000\000\000\000\000\000\000\000\000\000\001Z\000\000\000\000\b\133\000\000\b\133\001^\b\133\000\000\b\133\000\000\000\000\000\000\000\000\000\000\000\000\001\154\027\150\000\000\000\000\000\000\b\133\000\000\001\158\000\000\001\162\000\000\b\133\b\133\001\166\000\000\001\170\001\174\000\000\000\000\000\000\b\133\000\000\000\000\b\133\000\000\000\000\000\000\000\000\b\133\b\133\b\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\133\000\000\000\000\000\000\b\133\rY\rY\000\000\000\000\000\000\rY\000\000\000\000\rY\b\133\b\133\b\133\000\000\b\133\b\133\000\000\000\000\000\000\rY\000\000\rY\000\000\rY\b\133\rY\000\000\b\133\001\202\001\206\000\000\b\133\000\000\000\000\000\000\000\000\000\000\rY\000\000\000\000\004\254\000\000\b\133\rY\rY\r]\r]\001\210\001\214\004B\r]\000\000\rY\r]\000\000\rY\000\000\000\000\000\000\000\000\rY\rY\rY\r]\000\000\r]\000\000\r]\000\000\r]\001\246\002\154\000\000\000\000\000\000\002\158\rY\002\178\004\030\004*\rY\r]\000\000\000\000\0046\000\000\015\202\r]\r]\000\000\rY\rY\rY\004B\rY\rY\r]\000\000\000\000\r]\004R\004:\000\000\000\000\r]\r]\r]\rY\000\000\000\000\000\000\rY\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\r]\000\000\rY\000\000\r]\001\205\000\000\000\000\000\000\000\000\001\205\000\000\001\206\001\205\r]\r]\r]\000\000\r]\r]\000\000\b\229\000\000\001\205\004R\000\000\000\000\001\205\006\237\001\205\000\000\r]\000\000\006\237\000\000\r]\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\r]\001\205\001\205\000\000\000\000\000\000\006\237\000\000\002\154\000\000\001\205\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\001\205\001\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\237\000\000\000\000\000\000\000\000\000\000\001\205\001\205\006\237\000\000\004\154\003A\000\000\006\237\006\237\000\238\003A\000\000\001\206\003A\001\205\001\205\006\237\006\237\001\205\001\205\000\000\b\225\000\000\003A\000\000\000\000\000\000\003A\001\205\003A\000\000\000\000\000\000\000\000\000\000\001\205\000\000\000\000\000\000\000\000\001\205\003A\006\237\000\000\000\000\000\000\001\205\003A\001\201\000\000\000\181\006\237\000\000\000\000\002\154\000\181\003A\000\000\000\181\003A\000\000\000\000\000\000\000\000\003A\003A\003A\024\006\000\181\000\000\000\181\000\000\000\181\000\000\000\181\000\000\000\000\000\000\000\000\000\000\003A\003A\000\000\000\000\004\154\000\000\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\000\003A\003A\000\181\000\000\003A\003A\000\000\000\181\000\000\000\000\000\181\000\000\000\000\000\000\003A\000\181\000\181\000\238\000\000\000\000\000\000\003A\000\000\000\000\000\181\000\181\003A\000\000\000\000\000\000\000\000\000\181\003A\000\000\000\249\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\181\000\181\000\000\000\000\000\181\000\181\000\000\000\249\000\000\000\249\000\000\000\249\000\000\000\249\000\181\000\000\000\000\000\000\000\000\000\000\000\181\000\181\000\000\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\181\000\249\000\181\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\249\000\000\000\000\000\000\000\000\000\249\000\249\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\000\000\000\000\189\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\249\000\249\000\000\000\000\000\249\000\249\000\000\000\189\000\000\000\189\000\000\000\189\000\000\000\189\000\249\000\000\000\000\000\000\000\000\000\000\000\249\000\249\000\000\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\249\000\189\000\249\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\189\000\000\000\000\000\000\000\000\000\189\000\189\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\000\000\000\000\189\000\000\000\000\000\185\000\189\000\000\000\000\r\025\000\185\000\000\000\000\000\185\r\025\000\000\000\189\000\189\000\000\000\000\000\189\000\189\000\000\000\185\000\000\000\185\000\000\000\185\000\000\000\185\000\189\000\000\000\000\r\025\000\000\000\000\000\189\000\189\000\000\000\000\000\000\000\185\000\000\000\000\000\000\000\000\000\189\000\185\000\189\000\000\000\000\000\185\000\000\000\000\000\000\r\025\000\185\000\000\000\000\000\185\000\000\000\000\000\000\r\025\000\185\000\185\000\238\000\000\r\025\r\025\000\238\000\000\000\000\000\185\000\185\000\000\000\000\r\025\r\025\000\000\000\185\000\000\000\000\001\169\000\185\000\000\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\185\000\185\000\000\000\000\000\185\000\185\000\000\001\169\000\000\r\025\000\000\001\169\004e\001\169\000\185\000\000\000\000\004e\r\025\000\000\000\185\000\185\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\185\001\169\000\185\000\000\000\000\000\000\004e\005\017\000\000\000\000\001\169\000\000\000\000\001\169\000\000\000\000\000\000\000\000\001\169\001\169\001\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004e\000\000\000\000\000\000\000\000\000\000\001\169\000\000\004e\000\000\001\169\rU\rU\004e\002\226\000\000\rU\000\000\000\000\rU\001\169\001\169\004e\004e\001\169\001\169\000\000\000\000\000\000\rU\005\017\rU\000\000\rU\001\169\rU\000\000\000\000\000\000\000\000\001\169\001\169\000\000\000\000\000\000\000\000\001\169\rU\004e\000\000\000\000\000\000\001\169\rU\rU\000\000\000\000\004e\000\000\000\000\000\000\000\000\rU\000\000\000\000\rU\000\000\000\000\000\000\000\000\rU\rU\rU\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\rU\000\000\000\000\000\000\rU\rQ\rQ\000\000\000\000\000\000\rQ\000\000\000\000\rQ\rU\rU\rU\000\000\rU\rU\000\000\000\000\000\000\rQ\000\000\rQ\000\000\rQ\000\000\rQ\000\000\rU\000\000\000\000\000\000\rU\000\000\000\000\000\000\000\000\000\000\rQ\000\000\000\000\004\254\000\000\rU\rQ\rQ\000\000\000\000\000\000\000\000\000\000\000\000\004m\rQ\000\000\000\000\rQ\000\246\000\000\000\000\002\018\rQ\rQ\rQ\000\000\000\000\000\000\000\000\000\000\000\000\017\222\000\000\000\000\000\000\004m\000\000\003\182\rQ\000\000\b\137\b\137\rQ\000\000\000\000\b\137\000\000\000\000\b\137\017\226\000\000\000\000\rQ\rQ\rQ\018\n\rQ\rQ\b\137\000\000\b\137\000\000\b\137\000\000\b\137\000\000\007\146\017>\000\000\rQ\000\000\000\000\017V\rQ\000\000\000\000\b\137\000\000\000\000\000\000\000\000\000\000\b\137\b\137\rQ\000\000\000\000\000\000\018\162\000\000\000\000\b\137\000\000\000\000\b\137\000\000\000\000\000\000\000\000\b\137\b\137\000\238\017r\018\182\000\000\000\000\004m\004m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\b\137\000\000\000\000\000\000\b\137\000\000\007\001\000\000\018\198\000\000\000\000\000\000\000\000\000\000\b\137\b\137\b\137\000\000\b\137\b\137\000\000\000\000\n\"\000\000\000\000\007\001\000\000\000\000\b\137\007\001\000\000\b\137\000\000\000\000\000\000\b\137\nZ\nr\nz\nb\n\130\000\000\000\000\000\000\000\000\000\000\b\137\001\201\000\000\000\000\n\138\n\146\001\201\000\000\001\206\001\201\000\000\000\000\000\000\n\154\000\000\000\000\000\000\b\225\000\000\001\201\000\000\000\238\000\000\001\201\000\000\001\201\000\000\000\000\000\000\000\000\n*\nj\n\162\n\170\n\186\000\000\000\000\001\201\000\000\000\000\000\000\007\001\n\194\001\201\000\000\000\000\000\000\000\000\000\000\000\000\002\154\n\202\001\201\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\001\201\001\201\000\000\000\000\n\234\000\000\n\242\n\178\000\000\000\000\000\000\000\000\000\000\n\210\000\000\001\201\001\201\000\000\000\000\004\154\000\000\n\218\n\226\000\000\000\000\000\000\016\142\000\000\000\000\001\201\001\201\000\000\000\000\001\201\001\201\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\"\001\201\000\000\000\000\016\146\000\000\000\000\000\000\001\201\000\000\000\000\000\000\000\000\001\201\nZ\nr\nz\nb\n\130\001\201\000\000\000\000\000\000\000\000\000\000\006V\000\000\000\000\n\138\n\146\000\246\001\202\001\206\002\018\000\000\000\000\000\000\n\154\000\000\000\000\000\000\000\000\000\000\017\222\000\000\000\238\000\000\004m\000\000\003\182\001\210\001\214\001\230\000\000\n*\nj\n\162\n\170\n\186\000\000\001\242\017\226\000\000\000\000\000\000\000\000\n\194\018\n\000\000\000\000\000\000\000\000\000\000\001\246\002\146\n\202\000\000\000\000\002\158\017>\002\178\004\030\004*\000\000\017V\000\000\000\000\0046\000\000\n\234\016\150\n\242\n\178\016\166\000\000\000\000\000\000\000\000\n\210\000\000\018\162\000\000\000\000\000\000\004:\000\000\n\218\n\226\005\181\005\181\000\000\000\000\000\000\005\181\017r\018\182\005\181\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\181\000\000\005\181\000\000\005\181\000\000\005\181\000\000\000\000\018\198\000\000\000\000\000\000\000\000\004n\000\000\004r\000\000\005\181\000\000\000\000\000\000\000\000\000\000\005\181\005\181\000\000\000\000\000\000\000\000\b>\000\000\000\000\005\181\000\000\000\000\005\181\000\000\006Y\000\000\000\000\005\181\005\181\000\238\000\000\002\190\000\000\000\000\002\130\000\000\000\000\000\000\000\000\002\246\000\000\002\225\002\225\005\181\006Y\002\225\000\000\005\181\000\000\001\210\002\225\000\000\000\000\002\250\000\000\000\000\002\225\005\181\005\181\005\181\002\225\005\181\005\181\000\000\002\254\000\000\000\000\002\225\000\n\000\000\000\000\007\"\0032\001\190\005\181\000\000\000\000\015f\005\181\002\178\002\225\000\000\003:\002\225\002\225\000\000\bz\b~\b\138\005\181\002\225\005v\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\005\177\007f\000\000\005\130\005\134\005\177\002\225\000\000\005\177\000\000\000\000\000\000\000\000\000\000\002\225\002\225\000\000\015\162\005\177\000\000\005\177\000\000\005\177\000\000\005\177\000\000\000\000\005\138\b\146\000\000\000\000\000\000\b\170\004r\000\000\000\000\005\177\000\000\002\225\000\000\000\000\000\000\005\177\007\226\002\225\000\000\000\000\000\000\000\000\000\000\000\000\005\177\000\000\000\000\005\177\000\000\000\000\000\000\000\000\005\177\005\177\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\177\000\000\ra\ra\005\177\000\000\000\000\ra\000\000\000\000\ra\000\000\000\000\000\000\005\177\005\177\005\177\000\000\005\177\005\177\ra\000\000\ra\000\000\ra\000\000\ra\000\000\000\000\000\000\000\000\005\177\000\000\000\000\000\000\005\177\000\000\000\000\ra\000\000\000\000\000\000\000\000\000\000\ra\ra\005\177\000\000\000\000\000\000\000\000\000\000\000\000\ra\000\000\000\000\ra\000\000\000\000\000\000\000\000\ra\ra\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\ra\000\000\re\re\ra\000\000\000\000\re\000\000\000\000\re\000\000\000\000\000\000\ra\ra\ra\000\000\ra\ra\re\000\000\re\000\000\re\000\000\re\000\000\000\000\000\000\000\000\ra\000\000\000\000\000\000\ra\000\000\000\000\re\000\000\000\000\000\000\000\000\000\000\re\007\226\ra\000\000\000\000\000\000\000\000\000\000\000\000\re\000\000\000\000\re\000\000\000\000\000\000\000\000\re\re\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\re\000\000\005\201\007f\re\000\000\000\000\005\201\000\000\000\000\005\201\000\000\000\000\000\000\re\re\re\000\000\re\re\005\201\000\000\005\201\000\000\005\201\000\000\005\201\000\000\000\000\000\000\000\000\re\000\000\000\000\000\000\re\000\000\000\000\005\201\000\000\000\000\000\000\000\000\000\000\005\201\007\226\re\000\000\000\000\000\000\000\000\000\000\000\000\005\201\000\000\000\000\005\201\000\000\000\000\000\000\000\000\005\201\005\201\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\201\000\000\005\205\005\205\005\201\000\000\000\000\005\205\000\000\000\000\005\205\000\000\000\000\000\000\005\201\005\201\005\201\000\000\005\201\005\201\005\205\000\000\005\205\000\000\005\205\000\000\005\205\000\000\000\000\000\000\000\000\005\201\000\000\000\000\000\000\005\201\000\000\000\000\005\205\000\000\000\000\000\000\000\000\000\000\005\205\005\205\005\201\000\000\000\000\000\000\000\000\000\000\000\000\005\205\000\000\000\000\005\205\000\000\000\000\000\000\000\000\005\205\005\205\005\205\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\205\003V\002\190\000\000\005\205\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\005\205\005\205\005\205\000\000\005\205\005\205\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\005\205\000\000\000\000\000\000\005\205\000\000\000\000\000\000\000\000\003f\000\000\000\000\011\006\001\190\000\000\b\n\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003=\000\000\000\000\005z\000\000\003=\000\000\001\206\003=\000\000\000\000\005\130\005\134\000\000\000\000\011\030\000\000\000\000\003=\000\000\000\000\000\000\003=\000\000\003=\000\000\000\000\000\000\000\000\000\000\011&\000\000\000\000\0112\000\000\005\138\003=\000\000\000\000\000\000\000\000\004r\003=\000\000\000\000\001M\000\000\000\000\000\000\002\154\001M\003=\000\000\001M\003=\000\000\000\000\000\000\000\000\003=\003=\003=\000\000\001M\000\000\001M\000\000\001M\000\000\001M\000\000\000\000\000\000\000\000\000\000\003=\003=\000\000\000\000\004\154\000\000\001M\000\000\000\000\000\000\000\000\000\000\001M\000\000\003=\003=\001M\000\000\003=\003=\000\000\001M\000\000\000\000\001M\000\000\000\000\000\000\003=\001M\001M\000\238\000\000\001I\000\000\003=\000\000\000\000\001I\001M\003=\001I\000\000\000\000\000\000\001M\003=\000\000\000\000\001M\000\000\001I\000\000\001I\000\000\001I\000\000\001I\000\000\001M\001M\001M\000\000\001M\001M\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001M\000\000\001I\000\000\000\000\000\000\001I\001M\000\000\000\000\000\000\001I\000\000\000\000\001I\000\000\000\000\000\000\001M\001I\001I\000\238\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\001I\001\133\000\000\000\000\000\000\000\000\001\133\000\000\012\177\001\133\001I\001I\001I\000\000\001I\001I\000\000\012\177\000\000\001\133\000\000\001\133\000\000\001\133\001I\001\133\000\000\000\000\000\000\000\000\000\000\001I\000\000\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001I\001\133\012\177\000\000\000\000\000\000\000\000\000\000\012\177\000\000\000\000\000\000\000\000\001\133\000\000\000\000\000\000\000\000\001\133\001\133\001\133\000\000\000\000\0019\000\000\000\000\000\000\000\000\0019\000\000\000\157\0019\000\000\000\000\001\133\000\000\000\000\000\000\012\177\000\157\000\000\0019\000\000\0019\000\000\0019\000\000\0019\001\133\001\133\001\133\000\000\001\133\001\133\000\000\000\000\000\000\000\000\000\000\0019\000\000\000\000\000\000\000\000\000\000\0019\000\157\000\000\000\000\001\133\000\000\000\000\000\157\000\000\000\000\000\000\000\000\0019\000\000\000\000\001\133\000\000\0019\0019\0019\000\000\001\213\000\000\000\000\000\000\000\000\001\213\000\000\015\174\001\213\000\000\002\130\000\000\0019\000\000\001\202\001\206\000\157\000\000\001\213\000\000\000\000\000\000\001\213\000\000\001\213\000\000\0019\0019\0019\000\000\0019\0019\000\000\001\210\002\170\001\230\001\213\000\000\000\000\000\000\000\000\000\000\001\213\001\242\000\000\000\000\000\000\0019\015\178\000\000\000\000\001\213\000\000\000\000\001\213\000\000\001\246\002\146\0019\001\213\001\213\002\158\015\190\002\178\004\030\004*\000\000\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\001\213\000Y\000\000\000\000\001\213\000\000\000Y\000\000\000Y\000\000\000\000\000\000\004:\005\134\001\213\001\213\000\000\000Y\001\213\001\213\000Y\000\000\000\000\000\000\000Y\000Y\000\000\b\165\001\213\000\000\000\000\000\000\000\000\000\000\000\000\001\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000\000\001\213\000Y\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000\000\000\000\000\000\000\000\000Y\000Y\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000Y\000Y\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000Y\002\246\000\000\000Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\000Y\007\014\000\000\000Y\000\000\000\000\003Z\000\000\b\165\tB\000\000\000\000\000Y\004e\007f\000Y\000\000\t~\004e\003f\000\000\004e\r\210\001\190\000\000\000\000\000\000\000\000\000Y\002\178\000\000\004e\003\246\000\000\000\000\004e\003\250\004e\004\002\000\000\011\022\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004e\000\000\000\000\000\000\005z\000\000\004e\007\226\000\000\000\000\004e\000\000\005\130\005\134\000\000\004e\000\000\000\000\004e\000\000\000\000\000\000\000\000\004e\002\226\000\238\000\000\000\000\007\145\000\000\000\000\007\145\004e\004e\r\226\000\000\005\138\000\000\000\000\004e\004e\0035\004r\004e\000\000\000\000\0035\007\145\007\145\0035\007\145\007\145\000\000\004e\004e\000\000\000\000\004e\004e\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\004e\000\000\000\000\000\000\007\145\000\000\000\000\004e\000\000\000\000\0035\015\198\025\202\000\000\000\000\000\000\0035\000\000\004e\000\000\000\000\000\000\007\145\000\000\000\000\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\0035\000\000\000\000\007\145\0035\007\145\001\210\000\000\007\014\000\000\000\000\000\000\000\000\003Z\0035\0035\tB\005\226\0035\0035\007\145\007\145\000\000\000\000\023\142\007\145\003f\007\145\0035\003r\001\190\007\145\000\000\000\000\016&\0035\002\178\000\000\000\000\003\246\0035\000\000\000\000\003\250\000\000\004\002\0035\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\021\254\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\024Z\003f\005\138\000\000\011\006\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\006\238\000\000\005z\002\246\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\000\000\001\210\011\030\007\014\000\000\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\150\003f\005\138\000\000\011\006\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005\194\011\022\005v\000\000\000\000\000\000\003V\002\190\000\000\000\000\002\130\000\000\000\000\000\000\005z\002\246\000\000\000\000\000\000\000\000\005\198\000\000\005\130\005\134\000\000\001\210\011\030\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\022\246\003f\005\138\000\000\003r\001\190\000\000\000\000\004r\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\t%\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\t%\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\000\000\000\000\006\134\000\000\000\000\005\138\002\225\002\225\000\000\003f\002\225\004r\003r\001\190\000\000\002\225\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\002\225\003\250\000\000\004\002\005j\000\000\005v\002\225\000\n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\002\225\000\000\000\000\002\225\002\225\000\000\005\130\005\134\000\000\005\202\002\225\000\000\000\000\002\225\000\000\000\000\002\225\002\225\000\000\002\225\002\225\000\000\002\225\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\000\000\t%\000\000\002\225\000\000\004r\004M\004M\000\000\000\000\004M\002\225\002\225\000\000\002\225\004M\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\000\000\004M\000\000\000\000\000\000\000\000\000\000\000\000\004M\023F\000\000\002\225\023^\000\000\000\000\002\225\000\000\002\225\000\000\000\000\000\000\004M\000\000\000\000\004M\004M\000\000\000\000\000\000\000\000\000\000\004M\000\000\000\000\004M\000\000\000\000\000\238\004M\000\000\004M\004M\000\000\004M\0035\000\000\000\000\000\000\0035\0035\000\000\000\000\0035\0035\000\000\004M\0035\000\000\000\000\000\000\000\000\000\000\0035\004M\004M\000\000\0035\000\000\0035\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\015\198\000\000\000\000\0035\015\198\0035\004M\000\000\000\000\0035\000\000\000\000\004M\000\000\0035\000\000\000\000\0035\0035\000\000\000\000\0035\0035\0035\0035\000\000\0035\0035\0035\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\0035\000\000\000\000\000\000\000\000\000\000\0035\0035\025\210\000\000\0035\0035\026\002\000\000\0035\0035\012\169\000\000\000\000\000\000\000\000\012\169\000\000\000\000\012\169\000\000\016&\0035\000\000\000\000\016&\0035\0035\000\000\012\169\000\000\0035\000\000\012\169\000\000\012\169\000\000\000\000\000\000\000\000\000\000\005\t\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\012\169\000\000\000\000\003V\002\190\012\169\012\169\002\130\000\000\006\238\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\001\210\000\000\007\014\012\169\000\000\000\000\000\000\003Z\000\000\000\000\tB\000\000\000\000\012\169\012\169\002z\000\000\012\169\012\169\000\000\003f\000\000\000\000\tn\001\190\000\000\000\000\012\169\000\000\000\000\002\178\026\194\000\000\003\246\012\169\000\000\000\000\003\250\000\000\004\002\000\000\011\022\005v\005a\000\000\012\169\000\000\000\000\005a\000\000\000\000\005a\000\000\000\000\005z\000\000\000\000\000\000\000\000\000\000\000\000\005a\005\130\005\134\000\000\005a\000\000\005a\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005a\000\000\000\000\000\000\000\000\000\000\005a\005\138\000\000\000\000\000\000\000\000\b>\004r\000\000\005a\000\000\000\000\005a\000\000\000\000\000\000\000\000\005a\005a\000\238\000\000\005e\000\000\000\000\000\000\000\000\005e\000\000\000\000\005e\000\000\000\000\000\000\005a\005a\000\000\000\000\005a\000\000\005e\000\000\000\000\000\000\005e\000\000\005e\000\000\005a\005a\000\000\000\000\005a\005a\000\000\000\000\000\000\000\000\005e\000\000\000\000\000\000\000\000\000\000\005e\000\000\0035\000\000\000\000\005a\b>\0035\000\000\005e\0035\000\000\005e\000\000\000\000\000\000\005a\005e\005e\000\238\0035\000\000\000\000\000\000\0035\000\000\0035\000\000\000\000\000\000\000\000\000\000\000\000\005e\005e\000\000\000\000\005e\0035\015\198\000\000\000\000\000\000\000\000\0035\000\000\000\000\005e\005e\000\000\000\000\005e\005e\0035\000\000\000\000\0035\000\000\000\000\000\000\000\000\0035\0035\0035\006\017\000\000\000\000\000\000\005e\006\017\000\000\000\000\006\017\000\000\000\000\000\000\000\000\0035\000\000\005e\000\000\0035\006\017\000\000\000\000\000\000\006\017\000\000\006\017\000\000\000\000\0035\0035\017\174\000\000\0035\0035\000\000\000\000\000\000\006\017\000\000\000\000\000\000\000\000\000\000\006\017\000\000\000\000\000\000\000\000\016&\0035\000\000\000\000\006\017\000\000\000\000\006\017\000\000\000\000\000\000\000\000\006\017\006\017\000\238\000\000\000\000\000\000\000\000\000\000\025\170\000\000\000\000\000\000\000\000\000\000\003V\002\190\006\017\000\000\002\130\000\000\006\017\000\000\000\000\002\246\000\000\000\000\000\000\000\000\000\000\000\000\006\017\006\017\021\138\001\210\006\017\006\017\000\000\000\000\000\000\000\000\003Z\001\202\001\206\000\000\006\017\000\000\000\000\000\000\000\000\000\000\000\000\006\017\000\000\003f\000\000\000\000\003r\001\190\000\000\000\000\001\210\001\214\006\017\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\005\238\000\000\000\000\000\000\001\246\002\162\003V\002\190\005z\002\158\002\130\002\178\004\030\004*\000\000\002\246\005\130\005\134\0046\005\202\000\000\000\000\003\254\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\004:\000\000\000\000\004\217\000\000\005\138\000\000\006\218\000\000\t*\003f\004r\000\000\003r\001\190\000\000\000\000\000\000\000\000\026N\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\006J\000\000\000\000\000\000\000\000\000\000\003V\002\190\000\000\005z\002\130\000\000\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\006\158\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\006j\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\007\165\000\000\000\000\007\165\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\007\165\007\165\003\246\007\165\007\165\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006]\000\000\000\000\005z\007\165\004r\003V\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006]\000\000\000\238\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\005\138\011\210\000\000\000\000\000\000\000\000\004r\003V\002\190\000\000\003f\002\130\000\000\003r\001\190\000\000\002\246\007\165\000\000\007\165\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\007\165\005v\003Z\005\234\007\165\000\000\000\000\000\000\007\165\000\000\007\165\000\000\000\000\005z\007\165\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\011\222\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\005z\002\130\004r\000\000\000\000\000\000\002\246\000\000\005\130\005\134\000\000\005\202\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\000\000\000\000\000\000\003Z\000\000\000\000\000\000\011\234\000\000\000\000\000\000\000\000\005\138\003V\002\190\000\000\003f\002\130\004r\003r\001\190\000\000\002\246\000\000\000\000\000\000\002\178\000\000\000\000\003\246\000\000\000\000\001\210\003\250\000\000\004\002\005j\000\000\005v\003Z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005z\000\000\003f\000\000\000\000\003r\001\190\000\000\005\130\005\134\000\000\005\202\002\178\000\000\000\000\003\246\000\000\000\000\000\000\003\250\000\000\004\002\005j\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\138\006\129\000\000\000\000\005z\000\000\004r\000\000\002\190\000\000\000\000\002\130\005\130\005\134\000\000\005\202\002\246\000\000\000\000\000\000\000\000\006\129\000\000\000\000\000\000\000\000\001\210\000\000\000\000\000\000\002\250\000\000\000\000\000\000\000\000\000\000\005\138\000\000\000\000\000\000\000\000\002\254\004r\000\000\000\000\000\000\000\000\000\000\000\000\0032\001\190\000\000\000\000\000\000\000\000\000\000\002\178\000\000\000\000\003:\000\000\000\000\000\000\bz\b~\b\138\000\000\000\000\005v\000\000\000\000\000\000\007\t\007f\000\000\000\000\000\000\007\t\000\000\000\000\007\t\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\130\005\134\007\t\000\000\000\000\000\000\007\t\000\000\007\t\000\000\001\181\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\181\000\000\007\t\000\000\000\000\000\000\005\138\b\146\007\t\007\226\001\181\b\170\004r\000\000\001\181\000\000\001\181\007\t\000\000\000\000\007\t\000\000\000\000\000\000\000\000\007\t\007\t\000\238\001\181\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\000\000\000\000\000\000\007\t\000\000\001\181\000\000\007\t\001\181\000\000\000\000\000\000\000\000\001\181\001\181\001\181\000\000\007\t\007\t\000\000\000\000\007\t\007\t\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\001\217\001\181\000\000\000\000\000\000\001\217\007\t\000\000\001\217\000\000\000\000\001\181\001\181\000\000\000\000\001\181\001\181\000\000\001\217\000\000\000\000\017\186\001\217\000\000\001\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\181\000\000\000\000\000\000\001\217\001\181\000\000\000\000\000\000\000\000\001\217\000\000\000\000\006\021\000\000\000\000\000\000\000\000\006\021\001\217\000\000\006\021\001\217\000\000\000\000\000\000\000\000\001\217\001\217\000\000\000\000\006\021\000\000\000\000\000\000\006\021\000\000\006\021\000\000\000\000\000\000\000\000\000\000\001\217\000\000\000\000\000\000\001\217\000\000\006\021\000\000\000\000\000\000\000\000\000\000\006\021\000\000\001\217\001\217\000\000\000\000\001\217\001\217\000\000\006\021\000\000\000\000\006\021\000\000\000\000\000\000\001\217\006\021\006\021\000\238\000\000\000\000\000\000\001\217\000\000\000\000\000\000\000\000\021f\000\000\000\000\000\000\000\000\006\021\001\217\012\169\000\000\006\021\000\000\000\000\012\169\000\000\000\000\012\169\000\000\000\000\000\000\006\021\006\021\000\000\000\000\006\021\006\021\012\169\000\000\000\000\000\000\012\169\000\000\012\169\000\000\006\021\000\000\000\000\000\000\005\t\000\000\000\000\006\021\000\000\000\000\012\169\000\000\000\000\000\000\000\000\000\000\012\169\000\000\006\021\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\169\000\000\000\000\000\000\000\000\012\169\012\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012a\000\000\002\190\012a\000\000\028N\000\000\012\169\000\000\000\000\028R\000\000\000\000\012a\000\000\000\000\000\000\000\000\000\000\012a\000\000\012\169\012\169\002z\000\000\012\169\012\169\000\000\000\000\000\000\000\000\012a\000\000\004e\000\000\012\169\000\000\012a\004e\026\250\000\000\004e\012\169\001\002\001\190\000\000\012a\000\000\000\000\012a\000\000\004e\000\000\012\169\012a\004e\000\000\004e\000\000\000\000\004e\000\000\028V\004e\000\000\000\000\000\000\000\000\000\000\004e\012a\000\000\000\000\004e\012a\004e\000\000\004e\000\000\004e\000\000\000\000\000\000\028Z\012a\012a\000\000\004e\012a\000\000\000\000\004e\004e\002\226\000\000\000\000\000\000\004e\bE\bE\000\000\000\000\bE\b>\000\000\012a\004e\bE\004e\004e\000\000\000\000\000\000\016V\004e\002\226\000\238\bE\000\000\000\000\000\000\000\000\004e\004e\bE\000\000\004e\004e\000\000\000\000\004e\000\000\007\246\000\000\004e\000\000\000\000\bE\000\000\000\000\bE\bE\000\000\004e\004e\004e\000\000\bE\004e\004e\bE\000\000\000\000\000\000\bE\000\000\bE\bE\007\146\bE\000\000\000\000\000\000\000\000\001q\004e\000\000\000\000\000\000\001q\000\000\bE\001q\000\000\000\000\000\000\004e\000\000\000\000\bE\bE\000\000\001q\000\000\001q\000\000\001q\000\000\001q\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\237\000\000\001q\000\000\000\000\bE\000\000\000\000\001q\000\000\000\237\bE\000\000\000\000\000\237\000\000\000\237\000\000\000\000\000\000\001q\000\000\000\000\000\000\000\000\001q\001q\000\238\000\237\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\000\000\000\001q\000\000\000\237\000\000\000\000\000\237\000\000\000\000\000\000\000\000\000\237\000\237\000\238\000\000\001q\001q\001q\000\000\001q\001q\000\000\000\000\000\000\000\000\000\000\000\000\000\237\000\000\000\000\000\241\000\237\000\000\000\000\000\000\000\241\001q\000\000\000\241\000\000\000\000\000\237\000\237\000\000\000\000\000\237\000\237\001q\000\241\000\000\000\000\000\000\000\241\000\000\000\241\000\000\007\005\000\000\000\000\000\000\000\000\007\005\000\237\000\000\007\005\000\000\000\241\000\000\000\000\000\000\000\000\000\000\000\241\000\237\007\005\000\000\000\000\000\000\007\005\000\000\007\005\000\241\000\000\000\000\000\241\000\000\000\000\000\000\000\000\000\241\000\241\000\238\007\005\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\000\000\000\000\000\000\000\000\000\241\000\000\007\005\000\000\000\241\007\005\000\000\000\000\000\000\000\000\007\005\007\005\000\000\000\000\000\241\000\241\000\000\000\000\000\241\000\241\000\000\000\000\000\000\000\000\000\000\000\000\007\005\000\000\000\000\000\000\007\005\0116\000\000\000\000\000\000\000\241\000\000\001\202\001\206\011j\007\005\007\005\016\238\000\000\007\005\007\005\000\241\006\t\000\000\000\000\000\000\000\000\006\t\000\000\000\000\006\t\001\210\002\170\001\230\000\000\000\000\007\005\017\142\000\000\000\000\006\t\001\242\000\000\000\000\006\t\000\000\006\t\000\000\005m\007f\000\000\000\000\000\000\005m\001\246\002\146\005m\000\000\006\t\002\158\000\000\002\178\004\030\004*\006\t\000\000\005m\000\000\0046\000\000\005m\000\000\005m\006\t\000\000\000\000\006\t\000\000\000\000\000\000\000\000\006\t\006\t\000\000\005m\004:\000\000\000\000\000\000\000\000\005m\007\226\000\000\000\000\000\000\000\000\000\000\006\t\000\000\000\000\000\000\006\t\005m\000\000\000\000\000\000\000\000\005m\005m\000\238\000\000\006\t\006\t\000\000\000\000\006\t\006\t\000\000\000\000\000\000\000\000\012\017\000\000\005m\000\000\000\000\012\017\000\000\000\000\012\017\000\000\000\000\006\t\000\000\000\000\000\000\000\000\005m\005m\012\017\000\000\005m\005m\012\017\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\017\005m\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\001\202\002~\012\017\000\000\002\130\012\017\000\000\000\000\000\000\000\000\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\012\017\n\022\000\000\001\242\012\017\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\012\017\012\017\002\138\002\146\012\017\012\017\000\000\002\158\000\000\002\178\004\030\004*\004=\000\000\000\000\000\000\021>\004=\026\166\0045\004=\012\017\000\000\000\000\0045\000\000\000\000\0045\000\000\000\000\004=\000\000\n\250\004:\004=\000\000\004=\0045\000\000\000\000\000\000\0045\005\134\0045\000\000\000\000\000\000\000\000\004=\000\000\000\000\000\000\026\178\000\000\004=\0045\000\000\000\000\000\000\000\000\000\000\0045\000\000\004=\000\000\000\000\004=\000\000\000\000\021R\0045\004=\000\000\0045\000\000\000\000\000\000\000\000\0045\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004=\000\000\000\000\000\000\004=\004U\000\000\0045\000\000\000\000\004U\0045\004%\004U\004=\004=\000\000\004%\004=\004=\004%\0045\0045\004U\000\000\0045\0045\004U\000\000\004U\004%\000\000\000\000\000\000\004%\004=\004%\000\000\000\000\000\000\000\000\004U\0045\000\000\000\000\000\000\017\022\004U\004%\000\000\000\000\000\000\000\000\020\030\004%\000\000\004U\000\000\000\000\004U\000\000\000\000\000\000\004%\004U\000\000\004%\000\000\000\000\000\000\000\000\004%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004U\000\000\000\000\011*\004U\000\000\000\000\004%\000\000\001\202\001\206\004%\000\000\000\000\004U\004U\000\000\000\000\004U\004U\000\000\004%\004%\002\142\000\000\004%\004%\000\000\001\210\001\214\001\230\000\000\000\000\000\000\000\000\004U\000\000\000\000\001\242\000\000\000\000\000\000\004%\000\000\000\000\001\250\021\002\006\221\006\221\000\000\000\000\001\246\002\146\024z\000\000\000\000\002\158\000\000\002\178\004\030\004*\000\000\000\000\004.\000\000\0046\006\221\006\221\006\221\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\221\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\000\000\000\000\000\006\221\006\221\000\000\000\000\000\000\006\221\000\000\006\221\006\221\006\221\000\000\004E\000\000\000\000\006\221\000\000\004E\000\000\004-\004E\000\000\000\000\015\182\004-\000\000\000\000\004-\000\000\000\000\004E\000\000\006\221\000\000\004E\000\000\004E\004-\000\000\000\000\000\000\004-\000\000\004-\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004E\004-\000\000\004]\000\000\000\000\000\000\004-\004]\000\000\000\000\004]\004E\000\000\004\"\000\000\006\221\004E\000\000\004-\000\000\004]\000\000\000\000\004-\004]\000\000\004]\000\000\000\000\000\000\000\000\000\000\004E\000\000\000\000\000\000\000\000\000\000\004]\004-\000\000\000\000\000\000\000\000\004]\000\000\004E\004E\000\000\000\000\004E\004E\000\000\004-\004-\000\000\004]\004-\004-\000\000\000\000\004]\0116\000\000\000\000\000\000\000\000\004E\001\202\001\206\000\000\000\000\000\000\000\000\004-\000\000\000\000\004]\018Z\000\000\000\000\000\000\000\000\000\000\003\254\020\170\000\000\001\210\001\214\001\230\000\000\004]\004]\000\000\000\000\004]\004]\001\242\004y\000\000\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\001\246\002\146\004]\000\000\000\000\002\158\003\178\002\178\004\030\004*\004y\000\000\003\182\021*\0046\007}\000\000\000\000\007}\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\004:\000\000\000\000\007}\007}\000\000\007}\007}\024\166\000\000\000\000\017>\000\000\000\000\000\000\000\000\017V\000\000\000\000\000\000\007\169\000\000\000\000\007\169\000\000\000\000\000\000\007}\000\000\000\000\000\000\000\000\017^\000\000\000\000\000\000\004n\000\000\004r\007\169\007\169\000\000\007\169\007\169\000\000\007}\017r\017\158\000\000\000\000\004y\004y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\169\000\000\007\153\000\000\021\230\007\153\000\000\000\000\000\000\000\000\000\000\000\000\007}\000\000\007}\000\000\000\000\000\000\000\238\000\000\000\000\007\153\007\153\000\000\007\153\007\153\007}\000\000\000\000\005\234\007}\000\000\006\217\006\217\007}\000\000\007}\000\000\000\000\000\000\007}\000\000\000\000\000\000\000\000\007\153\000\000\000\000\007\169\000\000\007\169\006\217\006\217\006\217\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\217\007\169\000\238\000\000\005\234\007\169\000\000\000\000\000\000\007\169\000\000\007\169\000\000\006\217\006\217\007\169\ri\ri\006\217\000\000\006\217\006\217\006\217\000\000\000\000\000\000\000\000\006\217\000\000\000\000\000\000\000\000\007\153\000\000\007\153\ri\ri\ri\007z\000\000\000\000\000\000\000\000\000\000\006\217\ri\006F\000\000\000\000\005\234\007\153\000\000\000\000\000\000\007\153\000\000\007\153\000\000\ri\ri\007\153\000\000\000\000\ri\000\000\ri\ri\ri\000\000\000\000\000\000\000\000\ri\001\202\001\206\022\154\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\202\001\206\022\250\004\230\000\000\ri\000\000\000\000\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\001\210\002\170\001\230\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\242\000\000\001\246\002\146\001\202\001\206\000\000\002\158\000\000\002\178\004\030\004*\000\000\001\246\002\146\000\000\0046\000\000\002\158\000\000\002\178\004\030\004*\001\210\001\214\000\000\000\000\0046\000\000\000\000\000\000\000\000\000\000\004:\000\000\000\000\000\000\000\246\000\000\000\000\002\194\000\000\000\000\000\000\004:\000\000\001\246\002\162\000\000\000\000\004\153\002\158\000\000\002\178\004\030\004*\003\182\000\000\000\000\000\000\0046\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\186\000\000\000\000\000\000\000\000\000\000\016\218\000\000\000\000\004:\000\000\000\000\004\221\000\000\000\000\024\166\000\000\000\000\017>\000\000\000\000\000\000\000\000\017V\000\000\000\000\000\000\000\000\026N\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017^\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\017r\017\158\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\021\230"))
and lhs =
- (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\216\216\215\215\214\213\213\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\212\211\211\210\209\209\209\209\209\209\209\209\208\208\208\208\208\208\208\208\207\207\207\206\206\205\204\204\204\203\203\202\202\202\202\202\202\201\201\201\201\201\201\201\201\200\200\200\200\200\200\200\200\199\199\199\199\198\197\196\196\196\196\195\195\195\195\194\194\194\193\193\193\193\192\191\191\191\190\190\189\189\188\188\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\187\186\186\185\185\184\183\182\181\181\180\180\179\179\179\179\178\178\178\178\177\177\176\176\176\176\175\174\173\173\172\172\171\171\170\169\169\168\167\167\166\165\164\164\164\163\163\162\161\161\161\161\161\160\160\160\160\160\160\160\160\159\159\159\159\159\159\158\158\157\157\157\156\156\155\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\144\144\144\143\143\143\143\142\142\141\141\140\140\139\139\139\139\139\138\138\138\138\137\137\137\136\136\136\136\136\136\136\135\135\135\135\135\135\135\134\134\133\133\132\132\132\132\132\132\131\131\130\130\129\129\128\128\127\127\127~}}}||{{{{{{{{{zzyyxxxxxxxxxxxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::9988776655544433322211110/..................-----,,,,,,,+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++**))))))))))))))))))))))(((((((((((((((((((((((((((((((((((((((((((((((((((''&&&%%$$$$$$$$$$$$$$$$##\"\"!!!!!!! \031\031\030\030\030\030\030\029\029\028\027\026\026\026\025\025\024\024\024\024\024\024\024\024\024\024\023\023\022\022\022\022\021\021\020\019\019\019\019\019\018\017\017\016\016\016\015\015\015\014\014\014\014\r\r")
+ (8, "\012\011\n\t\b\007\006\005\004\003\002\001\000\218\218\217\217\216\215\215\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\214\213\213\212\211\211\211\211\211\211\211\211\210\210\210\210\210\210\210\210\209\209\209\208\208\207\206\206\206\205\205\204\204\204\204\204\204\203\203\203\203\203\203\203\203\202\202\202\202\202\202\202\202\201\201\201\201\200\199\198\198\198\198\197\197\197\197\196\196\196\195\195\195\195\194\193\193\193\192\192\191\191\190\190\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\189\188\188\187\187\186\185\184\183\183\182\182\181\181\181\181\180\180\180\180\179\179\178\178\178\178\177\176\175\175\174\174\173\173\172\171\171\170\169\169\168\167\166\166\166\165\165\164\163\163\163\163\163\162\162\162\162\162\162\162\162\161\161\160\160\160\160\160\160\159\159\158\158\158\157\157\156\156\156\156\155\155\154\154\153\153\152\152\151\151\150\150\149\149\148\148\147\147\146\146\145\145\145\144\144\144\144\143\143\142\142\141\141\140\140\140\140\140\139\139\139\139\138\138\138\137\137\137\137\137\137\137\136\136\136\136\136\136\136\135\135\134\134\133\133\133\133\133\133\132\132\131\131\130\130\129\129\128\128\128\127~~~}}|||||||||{{zzyyyyyyyyyyyxwvuutttttsrrqqppppppppppppppoonnmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmllkkjjiihhggffeeddccbbaaaaaaaaaaa`_^]\\[ZYXWWWWWWWWWWVVVUUUTTTTTSSSSSSSSSRRQQQQQPPOONMLLKKKKKJJIIHHHGGGGGGFFFEEDDCCBBAA@@@??>>==<<;;::9988776655544433322211110/...................-----,,,,,,,+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++**))))))))))))))))))))))(((((((((((((((((((((((((((((((((((((((((((((((((((''&&&%%$$$$$$$$$$$$$$$$##\"\"!!!!!!! \031\031\030\030\030\030\030\029\029\028\027\026\026\026\025\025\024\024\024\024\024\024\024\024\024\024\023\023\022\022\022\022\021\021\020\019\019\019\019\019\018\017\017\016\016\016\015\015\015\014\014\014\014\014\014\r\r")
and goto =
- ((16, "\000%\000\193\000G\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\012\000\000\000\000\000\129\001\152\000\030\0003\000#\000\004\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000b\000\000\000\000\000\000\000\000\000\000\000t\000\000\000\000\000\000\000\242\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=2\000\000\000\000\000\000\000\254\000\000\000\000\000\000\000\000\000\000\000\000\000\000'\238\001T\001>\000\223\000\000\001B9\220\001\236\001\218\000:\000\000\000\000\000\000\001x\000\000\000\000\000\182\000\000\000\000\000\000\000\000\003\156\000\000\002\150\000\000\000\000\000\000\000\000\000\000\001\022\000\000\000\218\003\202\bf\000\000\000\000\011\018'\238\000\000\000\000\001\254\000\000\000\027\000\000:~\002\184\000\000\001\156\001r\000\000\000\000\002\172\002\142\002\208\003b\001\226\003\202\004\142\000f\001\194\0022\003\216\002\152\011b\000\000\005(\003\244\003\188\002h\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004r\000\000\t>\005(\011\194\000\000\000\000\004.\005d\004\0301\236\000\000\000\000\000\000\000\000\000\000\000\000\000\000\007\148\000\000\004\168\005l\005@\000\000\000\000\000\000\000\000\000\173\000\000\000\000\005\144\000\167\006\018\006(\007\214\000\000\0050\005H\006*\000Q\004\228\006L \232\000\000\000\000\005X\006\254\011\204\000\000!\b\001\244!\026\"V\000\000\003B\000\000\000\000\000\000\000\000\006\018=F\006\020\000\000\001\012\0064\000\000\004P6\150\000\131\000\000\001\172\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0002:\005\190\000\000\000\000\000\000\000\192\000\000\tD\000\000\000\000\002\164\000o\000\000\000\000\003\248\000\000\006n\000\000\002\164\t\148\002\164\000\000\000\000\000\000\000\000\000\0007 \000\000\007\"\006@\000\000=\168\007N\030`\000\000\000\000\000\000\0062\000\000\000\000\000\000\000\000\006F\000\000\000\000\000\000\000\000\000\0002L\000\000\000\000\000\000\000\000\000\000\000\000\001\158\007N\000\000\000\000\000\000\006F\007\1342\146\006\224\007p\015\214\000\000\003\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000(\000\000\000\000\000\000\000\000\b\0122\160\000\000\000\000\007\030\b\0042\214\000\000\000\000\000\00038\007\0143\152\000\000\007\014\000\0003\164\007\014\000\0003\228\007\014\000\000\007\014\000\000\000\000\007\014\000\000\000\0004J\000\000\007\0144\138\000\000\007\014\002|\000\000\000\000\"V\000\000\000\000\000\000\000\000\007\014\"z\000\000\000\000\000\000\007\014\000\000\006F\007\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\016\000\000\007\136\000\000=\132\006F\000\000\000\000\000\000\000\000\b\b\b\184\012$\b\026\b\030\b@\b\028\005\014\b`\0001\t\006\000\000\000\000\000\029\005\136\b\160\001\172\b\200\bL\000\000\000\145\004\138\005\180\007\136\n\"\000\000\000\000C\158\000\000C\224\t\212\000\000=\198\006F>@\006F\000\000\003\"\000\000\003x\000\000\000\000\003\220\000\000\000\000\000\000\nt\000\000\n\030\000\145\000\000\000\000\t>\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\145\000\000\000\000\000\145\000\000\b\200\007\014\000\000\002\182\004\228\000\000\002\182\000\000\000\000\n\206\000\145\000\000\000\000\000\000\000\000\000\000\000\000\002\182\012\132\rL\n4\t\218\"\152\000n\000\000\t\130\b\182\r\158\t\234\b\228\025X1N\000\000\000\000\000\000\000\000\000\000\0032\t\188\000\000\000\000\000\000\t\250\b\244\007V\002\182\011\240\000\000\000\145\000\000\000\000\000\000\001\244\000\000>T\006F\r\166\n\018\t\030\r\254\n \t0\014\180\"\186\007\014\015\024\n\"\t89\190\n\244\000\000#\002\007\014>x\006F\n\238\000\000\000\000\000\000\000\000\007\148\011&\011L\000\000\000\000\b\176\015 \n\208\t>4\172\007\014\015t\n\222\tF6(\000\000>\172\000\000\000\000\015|\"\244\018\\\000\000\000\000\000\000\000\000>\208\000\000\000\000\000\000\007\172\016B\000\000\000\000\000\000\000\000#^>\222\000\000\000\000\000\000\000\000\000\000\n\170\016\150\000\000\n\180$\"\n\180$,\n\180\000\000?\026\000\000$\128\n\180\016\234\004\152\016\244\000\000\000\000$\136\n\180%\022\n\180%\030\n\180%\250\n\180&\002\n\180&\026\n\180&\152\n\180&\246\n\180&\254\n\180'\140\n\180'\148\n\180'\232\n\180(v\n\180(\128\n\180)\014\n\180)^\n\180)h\n\180)\246\n\180*F\n\180*\212\n\180\t\170*\2484\232\007\148\011x\000\000+8;l\000\000\017N\000\000?,\000\000\006F;\166\000\000\006F?P\006F\000\000\017\184\000\000\000\000\000\000+\\\000\000\000\000\000\000\000\000\000\000\007\014\000\000\000\000?\210\000\000\006F\000\000\000\000;\166\011\136\000\000@6\006F\018\018\000\000\000\000\011\"\000\000@H\006F\018\160\000\000\000\000\018\196\000\000\000\000\000\000@Z\006F\019\028\000\000\n\252\019\132\000\0005J\000\000\007\0145\142\000\000\007\0145\176\000\000\007\014\003d\000\000\000\000\000\000\000\000\000\0005\240\007\014\004\222\005\022\000\000\000\000\000\000\n\180\019\222\000\000\000\000\000\000+\150\n\180\000\000\000\000\000\000\000\000\0206\000\000\000\000\000\000\n\180\020D\000\000\020\158\000\000\000\000\000\000\021\004\000\000\000\000\000\000\000\000@\146\000\000\000\000\021^\000\000\000\000\000\000,H\n\180\021l\000\000\000\000\000\000,\138\n\180\021\196\000\000\000\000,\176\n\180\n\180\000\000\007\228\022\030\000\000\000\000-\b\n\180\022l\000\000\000\000-(\n\180-v\n\180\000\000.\004\n\180\000\000\000\000\022\250\000\000\000\000.\152\n\180\023,\000\000\000\000.\200\n\180\023\\\000\000\000\000.\232\n\180\000\000/\000\n\180\000\000;\138\000\000\000\000\n\180\000\000\000\000\023\142\000\000\000\000\023\192\000\000\000\000\011D\000\000\000\000\024\028\000\000\024$\000\000\000\000\000\000\007\148\011\226\000\0007\022\n<\002\164\025\004\000\0007r\000\000\000\000\000\0007\194\000\000\000\000\025$\000\000\025\146\000\000\000\000\000\000\000\000/\n\000\000\000\000\000\000/f\n\1800r\n\180\000\000\n\252\025\156\000\000\000\000\025\236\000\0000T\000\000\000\0001N\000\000\000\000\000\000\026\134\000\000\000\000\000\000\000\000\026\144\000\000\000\000\000\000\000\000\012\152\000\000\000\000\000\000\003\154\000\000\000<\000\000\000;\000\000\0128\000\000\004\144\000\000\000\000\000\000\000\000\000\000\000\000\0032\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\012\164\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\184\007\232\002\182\027T\000\000\011\166\t\224\012*\001\144\t\136\002\182\r@\000\145\t\176\002\182\000\000\027x\000\000\004\142\000\000\011\194\t\238\004X\000\000\000\000\000\000\000\000\000\000\011\218\001.\000\146\000\000\000\000\000\000;\222\000\000C\240\000\000\t\246\000\000\n\016\000\000\000\000\000\000\000\000\002\158\000\000\000\000\000\000\011*\002\164\000\000\002\164\001\178\000\000\rv\002\164\002\164\n\024\000\000\027\186\000\000\000\000\n8\012\172\000\0000\180\005$\000\000\000\000\000\000\000\000\000\000\000\000\n\180\000\000\028\180\000\000\n\180\000\000\000\000\014\242\000\000\000\145\000\000\016H\000\000\000\145\000\000\017\012\000\145\000\000\003Z\000\000\n<\n\022\005`\000\000\011\226\011\234\nV\012\024\012\164\017T\000\145\006\012\000\000\nZ\012\134\012\188\005\024\006\184\012\150\n\130\r\014\006\146\b\132\012\228\000\000\000\000\007\188\b\148\000\000\004\168\002\2426N\007\014\028\028\000\000\007X\003\178\012\158\n\154\011^\005\224\000\000\012\168\n\158\006\200\000\000@\172\006F\rZ\r\132\000\000\t:\000\000\012\244\n\166\006>\r2\003V\000\000\000\000\000\000\000\000\n\216\tZ\000\000\n\222\tl\000\000\bb\0164\rF\rP\n\228\006\216\t\172\000\000\n\230\007\138\n\018\000\000\rR\n\238\r\220\000\000\t\028\000\000\n\132\000\000\r\252\000\000\018\024\000\145\r\216\011\002\014\022\000\000\018\202\0056\r\236\000\000\000\000\003j\006\160\011$\000\000\019\228\000\145\011F\000\000\004\022\000\000\r\210\011\016\0212\006\154\000\000\r\222\011>\007\176\r2\r\230\r\240\011L\015F\000\000\014\000\001\200\000\000\000\000\000\000\000\000\000\171\011X\r\226@\190\006F\000\000\002\200\011\142\014\148\000\000\000\000\000\000\000\000\000\000\000\000A\000\006\164\000\000\011\182\014\246\000\000\000\000\000\000\000\000\000\000\000\000\006\174\000\000A\030\006F\011\226\000\000\006F\011\218\000\184\000\000\011\230\011\232\007\024\000\000\001\004\004L\000\000\002\190\000\000A\"\006F\006F\000\000\000\000\007\b\000\000\b\252\000\000\001\186\007\b\007\b\000\000\011\236;\204\006FA\152\006F\012\b\000\000\000\000\000\000\000\000\012\014\000\000\000\000\007N\000\000\007l\014`\011\240\015p\014*\000\000\000\000\001\196\b|\014h\000\000\000\000\011\250\015\128\014@\000\000\000\000\029\018\000\000\012\222\000\000!(6H\006F\000\000,N\018\132\000\000A\252\000\000\000\000\000\000\007\b\000\000\000\000\012:\014|\012\000\015\144\014J\000\000\000\000B\014\012\144\014\140\000\000\000\000\000\000<:\000\000\000\000\000\000\000\000\000\000\000\000\012\146\000\000\014\152\012\020\006\162\000\000\015\134\015>\012\180\014\166\000\000\000\000\014\170\012>\b*\000\000\000\000\tl6\150\005|\000\000\000\000\000\000\bL\014p\012p\000\000\014z\bL\000\000\015V\012\188\014\196\000\000\000\000\000\000\006F\003v\004(\005\180\000\000\000\000\000\000\000\000\014\138\012t\000\000\006\128\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006F\014z\012\128\015\208\014\138\000\0007\224\000\237\012\146\014^\003\156\000\019\012\150\015\016\000\000\015\200\028\130\000\000\000\000\029J\000\000\012\208\000\000\nL\000\000\000\000\000\000\000\000\000\000\000\000B\018\006F\000\000\015\204\029l\000\000\000\000\030\002\000\000\000\245\012\156\015r\000\000\000\0007\250:\020\015(\000\000B0\006F\0302\000\000\000\000\030T\000\000\000\000\r0\000\000\000\\\000\000\000\000\000\000\000\000\000\000\000\000:\204\000\000\000\0008\188:\208\015*\000\000BP\006F\030\234\000\000\000\000\031\028\000\000\000\000\012\184\031<\r<\000\000\012\190\012\198\002\016\002\208\012\200\t&\012\214\015|0\214\r\\\000\000\r\016\r2\tf\000\000\004*<Z\000\000\004.\000\000\rH9\0069Z\005\236\014j\006l\000\000\020\144;\138\000\000\0001\000\000\000\000\0001\000\000\000\000\0001\n\002\000\000\011\000\0001\015\1380\238\rh\000\000\0001\000\000\000\000Br\000\000\000\000\000\000\0001\000\000\000\000\r\166\000\000\r\030\005\190\r\200\000\000\rJ<\174\r\248\000\000\000\000\000\000\000\000\014\000\000\000\000\000\006\018\000\000\0001B\232\000\000\014\216\00019h\000\000\014\b\014\242\rN\016\n\014\200\000\0009r\014\014\015\002\000\000\000\000\000\000\019\012\b\026\000\000\000\000\000\000\000\000\000\000\000\000\n\170\014\020\000\000\015\018\000\000\000\000\000\000\000\000\014\026\027F\000\000\000\000\000\000\000\000\n\170\000\000\000\000\014.\031\170\000\000\000\000\000\000\000\000\000\000\002\182\000\145\000\000\000\000\007\014\000\000Bn\006F\000\000\007\212\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\202\rP\011\246\002\182\000\000\022\n\000\000\000\145\000\000\016\004\000\000\000\000\000\000\000\000\000\000 (\000\000\000\000\000\000\000\000\000\000\000\000\015\170\002\022\t\210\014p\003\144\r\148\000\000\000\226\000\000\000\000\000\000\000\000\000\000\000\000\000\000\014\138\005^\r\176\000\000\007$\016\n\015\188\014J\000\000\000\000\015\180\002\202\b\150\000\000\000\000\000\000\r\180\000\000\r\206\000\240\000\000\000\000\002\164\b\128\000\000\000\000\000\000\000\000\000\000.\226\000\000\000\000\007h\007\238\000\000\000\000C(\006F\006F\000\000CJ\006F\bP\000\000\000\000\000\000\006F\000\000\000\000\t\246\015\196\014\\\000\000\000\000\015\184\000\170\001\200\000\000\000\000\000\000\000\000\b\002\016\n\nl\015\200\014h\000\000\000\000\015\190\004\188\003\142\000\000\000\000\000\000\000\000\000\145\000\000\b\222\000\000\000\000\000\000 \004\000\000 \182\000\000\000\000\000\000\000\000\000\000-\226\000\000\000\000\000\000\005\022\000\190\000\000\000\000\000\000\000\000\000\000\002V\000\190\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0050\000\000\000\000\000\000<\198\000\000\006F\000\000\n*\000\000\000\000\000\000\001\030\000\000\000\000\000\000\001\214\000\000\000\000\000\000\0001\000\000\000\000\000\0000\250\007\014\000\000\000\000\000\014\000\000\000\000\000\000\000\000\0032\004\128\015\b\004D\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=.\000\000\014v\000\000\000\000\000\000\000\000\005H\006\246\r@+\182\000\000\000\000\014\150/~\000\000\000\000\000\000\014\162;\020\000\000\000\000\000\000\000\000"), (16, "\006\021\003\169\002\020\002\021\001e\0007\002\251\001\198\000\196\006\184\005{\000\200\000\201\005\158\001\246\001\031\001\230\002X\006\022\006\195\001\234\006\024\001\023\000q\001e\002Y\005\160\006\249\002\021\001e\006\025\006&\001\198\006\021\0067\002\020\002\021\001e\002g\005\210\0066\001\230\001\016\002\003\001\244\001\234\000\200\001\023\001\023\001\026\002X\006\022\006%\000\147\006\024\006\170\001\215\001\246\002Y\006\026\001\235\005\165\001\016\006\025\006&\001k\006\241\005\212\001\023\001\026\003\170\002g\001\016\004\132\001\236\002\020\002\021\001e\001\023\001\026\003\167\005\241\005\213\004&\006\190\001\235\002\003\005\215\000\203\000\200\000;\006\003\006\026\006\027\006\242\006\251\006\188\002i\003\165\001\236\004\219\006\028\002\004\001\230\001\198\003\174\001\242\001\234\002\024\001\023\002k\000\200\004\220\001\230\001\016\000\147\004\244\001\234\000\152\001\023\001\023\001$\005\169\006\135\001\031\006+\006\027\001 \003\187\002\251\002i\000@\001\027\006\252\006\028\002k\000\200\006\162\001\229\005}\006,\002\024\001(\002k\000\200\002\004\000\203\001\235\001\031\006\031\000\153\001\"\006\197\001\238\006!\006\165\000\196\001\235\006+\000\200\001\002\000?\001\031\000\147\006#\001 \000\156\002l\0012\002r\002\023\001\236\001%\006,\0007\002x\000:\001\132\002n\001\031\006$\003\178\006\031\002k\000\200\001\002\005\217\006!\0013\001\"\003\234\002\251\003\168\000\203\001*\001Q\006\\\006#\002z\006\131\002l\000\203\002r\006\021\000m\002\020\002\021\001e\002x\003\250\001\132\002n\000\147\006$\000\157\001\215\001l\003\168\000\\\001\016\002X\006\022\006%\001\016\006\024\001\023\001\026\000`\002Y\001\023\001$\002z\001*\006\025\006&\006\233\001\016\003\245\003\247\003\249\002l\002g\001\023\001$\0007\001\031\0007\001\016\002m\0018\001\132\002n\000\147\001\023\001$\000\152\006\130\001\016\006f\006\168\006\169\001\016\006\026\001\023\001\026\0007\006{\001\023\001$\006]\006\234\001\169\001e\001T\0011\003\250\001\023\004\219\001\016\005W\004\b\001%\001\196\001\031\001\023\001$\006\137\004\167\006g\004\220\000d\001f\002)\004\227\001h\001i\006\027\006h\000y\006\021\002i\002\020\002\021\001e\006\028\001%\002\251\000\129\001.\000\132\001\"\002\024\001>\002k\000\200\004\219\002X\006\022\006%\001%\006\024\006\213\001W\001F\002Y\003\217\006\237\004\220\006+\006\025\006&\004\221\006\131\003\137\002\246\002\247\001%\002g\006e\001\147\001e\001\019\003\253\006,\001\016\0009\001.\001\023\001\016\001H\001\023\001$\006\031\001\016\001\023\001\026\000\128\006!\006\026\001\023\001\026\006\238\006Z\003\254\000\200\001\127\001)\006#\001\016\000\203\002l\000\203\002r\006\166\001\023\001$\001n\003\220\002x\000\200\001\132\002n\001\016\006$\000\147\000\135\006q\001\215\001\023\001$\000\196\001\238\006\027\000\200\000\201\006\021\002i\002\020\002\021\001e\006\028\002z\001%\006\167\003\140\003\145\004\219\002\024\004\000\002k\000\200\004\219\002X\006\022\006%\000=\006\024\000\174\004\220\001`\002Y\005\210\004\226\004\220\006+\006\025\006&\004\252\006y\004\003\003\181\001e\000\134\002g\000\196\001\129\000\186\000\200\000\201\006,\001%\006i\006j\001\130\002\001\001\132\001l\000\203\006\031\005\212\006k\006l\003\234\006!\006\026\002\244\001e\000\147\006-\000\181\001\215\006m\004\b\006#\005\213\001\016\002l\001.\002r\005\215\006\214\001\023\001$\005\238\002x\000\179\001\132\002n\001\016\006$\000\189\002\020\002\021\001e\001\023\001\026\000\196\000\151\006\027\000\200\000\201\006\021\002i\002\020\002\021\001e\006\028\002z\004\236\003\248\003\247\003\249\000\150\002\024\003\165\002k\000\200\002\251\002X\006\022\006%\003\174\006\024\000\202\000\183\005F\002Y\005\210\001\016\000\172\006+\006\025\006&\004\239\001\023\001$\002\001\001\217\000\178\002g\000\200\006i\006j\002\251\003\175\006,\001\031\000\203\004\241\001+\006k\006l\000\203\000\196\006\031\005\212\000\200\001\002\004\215\006!\006\026\006m\004\b\004c\006)\001\003\000\200\002\002\004\242\006#\005\213\004\147\002l\001\"\002r\005\215\007\005\002\021\001e\005\231\002x\001\219\001\132\002n\004'\006$\002\023\001\023\001\031\001\006\001\031\001 \004c\001 \006\027\000\200\0012\003\178\002i\002k\000\200\001\002\006\028\002z\006\021\001\223\002\020\002\021\001e\002\024\006\180\002k\000\200\005\251\005F\001\"\0013\001\"\007\b\007\t\004\213\002X\007\011\001O\004\149\006\024\006+\005M\005N\002Y\004f\001\222\001\132\003\168\006\025\007\r\000\194\001\023\0007\005\254\006\167\006,\002g\005^\003\173\001\016\0007\005W\004\b\002\002\006\031\001\023\001$\001\224\006\000\006!\002l\004\150\001*\006c\001*\001\132\000\184\006\026\002m\006#\001\132\002n\002l\000\196\002r\000\196\000\200\000\201\000\200\000\201\002x\0018\001\132\002n\006\001\006$\007\006\006\206\002k\000\200\006\179\001\016\000\188\001\016\002\020\002\021\001e\001\023\001$\001\023\001$\006\027\000\203\002z\005\210\002i\000\193\001%\006\021\006\028\002\020\002\021\001e\007\028\004\149\002\251\002\024\006G\002k\000\200\005M\005N\003\221\007\020\000\196\002X\007\021\000\200\001\002\006\024\007\016\000\204\005\212\002Y\001.\000\211\005V\001\246\006\025\007\029\005W\004\b\001>\002\251\001>\006?\002g\005\213\006,\001%\002\251\001%\005\215\004\218\005\205\001F\005\222\006\031\001\246\002\251\003\168\006\207\006!\001\250\003\230\004\b\002\003\006\026\000\147\000\200\001\202\001\215\006#\006\221\003\220\002l\001.\002r\001.\001H\002\251\001H\002\253\002x\002\005\001\132\002n\002\003\006$\002\023\000\200\0049\006\208\000\203\006\168\006\169\000\224\006\215\001\023\002\001\002\024\006\027\002k\000\200\004c\002i\002z\000\200\000\228\006\028\002\252\001d\001e\002~\005W\004\b\002\024\004\014\002k\000\200\006\021\004F\002\020\002\021\001e\002\004\004\138\004c\004\019\007!\000\200\001f\002\192\003\234\001h\001i\006\216\002X\006\022\0063\001\198\006\024\001\239\003\220\002\251\002Y\002\004\004+\006,\001\230\006\025\006&\000\212\001\234\005\245\001\023\000\225\006\031\002g\002l\006\217\003\234\006!\002\001\004(\001\031\002\251\002m\001 \001\132\002n\006\222\006#\001\132\000\234\002l\000\241\002r\006\218\006\026\005?\003\247\003\249\002x\000\249\001\132\002n\000\147\006$\0050\001\215\001\229\001\"\001\235\006o\001Y\001\132\001\031\000\196\001\n\001 \000\200\000\201\004U\001e\001m\002z\001\236\005S\003\247\003\249\004Q\002\002\006\027\000\203\001\r\001n\002i\000\203\000\200\001\030\006\028\001;\006\021\001\"\002\020\002\021\001e\002\024\005\210\002k\000\200\006\002\0044\004\198\001*\000\203\002\251\007\020\000\236\002X\007\021\002\251\000\196\006\024\006+\000\200\001\002\002Y\004\201\002\193\000\242\002\251\006\025\007\024\001\164\006v\005\212\005\254\005\217\006,\002g\000\196\003\234\001\016\000\200\000\201\001*\000\245\006\031\001\023\001$\005\213\006\000\006!\001\129\002\002\005\215\001B\001\006\004>\005\219\006\026\001\157\006#\001\132\001l\002l\004\143\002r\006\144\000\200\002\251\005\210\0007\002x\001\016\001\132\002n\006\001\006$\000\203\001\023\001$\004\155\001d\001e\004`\004\b\004\188\005[\003\247\003\249\000\203\001\246\001-\006\027\004r\002z\004:\002i\005\212\001%\001\023\006\028\001f\001v\001G\001h\001i\000\203\002\024\003\220\002k\000\200\006\021\005\213\002\020\002\021\001e\001\247\005\215\002\251\002\003\007\027\005\216\000\200\001>\004\210\001.\001\246\000\200\002X\006\022\001%\001\016\006\024\000\250\004\203\004\228\002Y\001\023\001$\006,\001V\006\025\006/\006\176\001w\001\229\001x\002\199\006\031\002g\001G\001E\002!\006!\001\159\002\003\001\\\001.\000\200\000\147\001H\005:\001\215\006#\001\156\001\016\002l\004\243\002r\000m\006\026\001\023\001$\001C\002x\001\127\001\132\002n\002\004\006$\000\196\005#\004v\000\200\001\002\004\245\001n\001t\001\023\000\200\001]\001\031\004\239\001\031\001 \000\203\001 \002z\003\b\001\246\004\222\000\200\001\002\001~\006\027\004C\001\031\004\241\002i\005$\005d\005%\006\028\000\203\002\004\001\163\001\203\001\175\001\"\002\024\001\"\002k\000\200\001d\001e\003\204\003@\004\242\002\003\000\200\001\002\000\200\001\016\006@\003\025\000\203\0062\005F\001\023\001\026\005&\004L\001\016\001f\002\192\001\129\001h\001i\001\023\001$\004\222\006,\000\203\001\130\002\251\001\132\001l\003\220\002\251\005\254\006\031\001*\003Q\001*\001u\006!\002\251\002\251\004\159\004\b\001\198\003\234\001\199\005'\006\000\006#\001\186\006\157\002l\001\230\002r\001\180\005(\001\234\005)\001\023\002x\002\004\001\132\002n\001\016\006$\001\016\002\020\002\021\001e\001\023\001$\001\023\001$\006\001\0007\006\143\002\251\001\031\001\016\004\016\005e\002X\002z\001\188\001\023\001$\004\t\006\133\003\202\002Y\001m\006\152\003\247\003\249\004\253\006Q\001\235\001\031\004?\000\203\001 \001n\002g\005+\000\200\001\185\004D\006z\005-\0057\001\236\000\203\005M\005N\001>\001\195\001>\001\031\005a\005C\004\b\001%\002\251\001%\001\"\005f\002\015\005O\005_\002\020\002\021\001e\005W\004\b\005b\003r\001%\006g\002\251\004\224\001\191\005F\000\200\006\187\002X\000\203\006h\002\251\001.\002\018\001.\001H\002Y\001H\003u\000m\004~\002 \003\147\004\222\001\129\002i\001\023\006\131\001\237\002g\001\031\001*\001\157\001 \001\132\001l\002\024\001\208\002k\000\200\001\016\000\203\002/\002\251\001\246\005I\001\023\001$\002\020\002\021\001e\0022\000\203\004\\\001\210\0028\005\200\001\"\002M\000\200\001\016\005\130\002R\002X\001\246\001\031\001\023\001$\002o\004h\003\212\002Y\001G\002\003\005F\000\203\000\200\006\229\004k\001\226\001\016\001\233\000m\000\203\002g\003\195\001\023\001$\002i\001\031\003\216\003\191\001 \002\003\002\251\002l\000\200\002r\001%\002\024\001*\002k\000\200\002x\000\203\001\132\002n\005M\005N\005\192\004s\001>\002\170\000\203\006\159\001\246\001\"\000\203\001%\003\203\000\203\006\231\005O\005_\000\203\001&\002z\005W\004\b\001\016\002\014\002o\002\004\005F\005\224\001\023\001$\000\200\001%\003\209\001\198\004*\001\228\002i\002\003\001.\003\224\000\200\001H\001\230\003\241\002\251\002\004\001\234\002\024\001\023\002k\000\200\002l\001*\002r\004w\005\134\003\243\001\016\0010\002x\004\005\001\132\002n\001\023\001$\001\031\006\173\000\203\001 \005M\005N\006a\004\b\001>\000\203\002\017\004\n\001\031\004)\002o\001%\001\016\002z\002\031\005O\005_\001\235\001\023\001$\005W\004\b\004/\001\"\0046\000\203\002.\002\004\002\020\002\021\001e\001\236\000\203\0021\0027\002C\000\203\002l\001.\002r\005F\001H\004\127\002X\004<\002x\001%\001\132\002n\000\203\002@\002Y\001\198\000\203\001\254\002\251\004O\006V\004T\005M\005N\001\230\004_\001>\002g\001\234\001*\001\023\002z\000\203\001%\000\203\002\251\003o\005O\005_\002\020\002\021\001e\005W\004\b\002\020\002\021\001e\000\203\000\196\000\203\004g\000\200\000\201\004j\002X\002H\004q\004u\001\016\002X\001.\004z\002Y\001H\001\023\001$\001\246\002Y\001\235\000\203\001\016\004\134\006D\004\021\002G\002g\001\023\001$\004\153\005\210\002g\000\203\001\236\000\203\002L\004\144\002i\000\203\002\020\002\021\001e\002Q\004P\002\254\002w\002\003\002\174\002\024\000\200\002k\000\200\004\158\004\148\002X\002\209\005M\005N\005\212\004\163\001>\002\216\002Y\000\203\002\251\004\173\000\203\001%\004\015\000\203\000\203\006\155\006\156\005\213\000\203\002g\005W\004\b\005\215\001%\002o\002\245\005\226\002\251\000\203\002i\002\251\002\020\002\021\001e\002i\000\203\004\179\001\246\001.\003d\002\024\001H\002k\000\200\003l\002\024\002X\002k\000\200\002\004\003\252\002l\002\251\002r\002Y\001\198\004\190\002$\000\203\002x\003\201\001\132\002n\006K\001\230\000\203\002\003\002g\001\234\000\200\001\023\000\203\002o\003\161\004\205\004\202\003\171\002o\002i\003\193\004\223\004\209\002z\004\230\001\031\004\247\003\208\005\b\003\210\002\024\005\001\002k\000\200\005\026\004\235\002\251\002\251\004\240\000\203\002l\003\223\003\014\004\004\005/\002l\004\012\002r\002x\001\235\001\132\002n\001\"\002x\002\251\001\132\002n\0045\002\251\000\203\005\024\004.\002o\001\236\006\021\0059\002\004\002i\002\251\0040\0043\002z\002\020\002\021\001e\004B\002z\000\203\002\024\007\020\002k\000\200\007\021\000\203\000\203\006\024\000\203\002X\000\203\002l\005E\002r\005Y\000\203\006\025\002Y\000\203\002x\005i\001\132\002n\001\031\0048\005 \005,\003\198\000\203\005o\002g\005s\002o\004A\005\143\002\020\002\021\001e\002\251\002\020\002\021\001e\002z\0054\002\251\006\026\001\016\005K\005\183\000\203\002X\005\243\001\023\001$\002X\005\188\005\227\005|\002Y\002l\002\251\002r\002Y\005\193\003\184\004=\002\251\002x\003\136\001\132\002n\002g\004@\004N\000\203\002g\000\203\000\196\004S\006\027\000\200\000\201\000\203\002\020\002\021\001e\001\198\006\028\003\214\002i\002z\000\203\005\223\000\203\004[\001\230\000\203\002\251\002X\001\234\002\024\001\023\002k\000\200\001%\005\159\002Y\007\023\005\210\005\199\000\203\005\185\003\131\000\203\002\251\004Z\004^\000\203\000\203\002g\005\207\005\248\001\016\006\r\006J\000\203\006\030\005\196\001\023\001$\002i\001.\002o\005\230\002i\006\031\005\212\004i\002\251\001\235\006!\002\024\002\251\002k\000\200\002\024\002\251\002k\000\200\002\251\006#\005\213\002\251\001\236\000\203\002\251\005\215\004t\006d\002l\005\244\003\014\004p\004y\005\242\002\251\006$\002x\004\141\001\132\002n\000\203\006p\002o\006~\001d\001e\002o\002i\002\251\001%\005\246\000\203\000\203\004\129\000\203\000\203\006\128\002\251\002\024\002z\002k\000\200\004\140\002\251\001f\001v\004\135\001h\001i\002l\002\251\002r\004\139\002l\005\250\002r\004\002\002x\005\255\001\132\002n\002x\006\011\001\132\002n\006\018\002\251\003\127\006 \000\203\002o\006'\002\251\002\020\002\021\001e\004\152\002\020\002\021\001e\002z\0060\004\157\000\203\002z\000\203\005\000\001w\002X\001x\0024\004\162\002X\004\165\004\169\006u\002Y\002l\000\203\002r\002Y\004\177\003x\004\184\006\161\002x\003i\001\132\002n\002g\006\175\004\195\004\255\002g\004\248\004\249\004\254\007\014\001\127\002\020\002\021\001e\005\002\002\020\002\021\001e\005\003\005\"\002z\001n\005\027\005\028\000\200\007\025\002X\005!\0056\0052\002X\007\030\003\130\0053\002Y\0055\005`\005D\002Y\000\196\003a\005H\000\200\000\201\001\198\005J\004\029\002g\003Y\005L\005X\002g\005h\001\230\005j\005k\005p\001\234\005t\001\023\002i\001d\001e\005x\002i\005\138\005\145\005\149\005\173\005\194\005\210\002\024\005\218\002k\000\200\002\024\005\228\002k\000\200\006\020\001\129\001f\001g\006\014\001h\001i\006\015\006\019\001\130\006\"\001\132\001l\006I\006T\006_\006s\006t\001\235\005\212\006x\006\160\006\164\006\174\002o\006\178\005#\002i\002o\007\000\000\000\002i\001\236\000\000\005\213\002\020\002\021\001e\002\024\005\215\002k\000\200\002\024\006\007\002k\000\200\000\000\000\000\000\000\000\000\002X\002l\000\000\002r\005$\002l\005%\002r\002Y\002x\000\000\001\132\002n\002x\002d\001\132\002n\000\000\000\000\000\000\002o\002g\000\000\000\000\002o\000\000\001m\002\020\002\021\001e\000\000\000\000\002z\000\000\000\000\005&\002z\001n\000\000\000\000\000\200\000\000\002X\000\000\000\000\000\000\000\000\002l\000\000\002r\002Y\002l\000\000\003\014\000\000\002x\002q\001\132\002n\002x\000\000\001\132\002n\002g\000\000\000\000\000\000\000\000\005'\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\005(\002z\005)\002i\000\000\002z\000\000\002X\000\000\001\198\000\000\004!\002X\000\000\002\024\002Y\002k\000\200\001\230\001\129\002Y\002\128\001\234\000\000\001\023\005c\002\127\001\157\002g\001\132\001l\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002i\002o\000\000\005+\000\000\000\000\000\000\000\000\005-\0057\000\000\002\024\002X\002k\000\200\000\000\000\000\001\235\005a\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002\179\000\000\002l\000\000\002r\001\236\000\000\002g\005b\000\000\002x\000\000\001\132\002n\000\000\000\000\002i\002o\000\000\000\000\000\000\002i\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002\024\002z\002k\000\200\001\198\000\000\004$\002X\000\000\000\000\000\000\000\000\002l\001\230\002r\002Y\000\000\001\234\000\000\001\023\002x\002\190\001\132\002n\000\000\000\000\000\000\002o\002g\000\000\000\000\000\000\002o\000\000\002i\000\000\000\000\002\020\002\021\001e\001\198\000\000\0042\002z\000\000\002\024\000\000\002k\000\200\001\230\000\000\000\000\002X\001\234\002l\001\023\002r\001\235\000\000\002l\002Y\002r\002x\000\000\001\132\002n\002\213\002x\000\000\001\132\002n\001\236\000\000\002g\002\020\002\021\001e\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\002i\000\000\000\000\002z\000\000\000\000\001\235\000\000\000\000\000\000\003T\002\024\000\000\002k\000\200\001\031\000\000\002l\005\015\002r\001\236\002\020\002\021\001e\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\003U\000\000\002X\000\000\000\000\002\020\002\021\001e\001\"\002o\002Y\002i\000\000\000\000\002z\000\000\002\220\001\198\000\000\004\131\002X\000\000\002\024\002g\002k\000\200\001\230\000\000\002Y\000\000\001\234\000\000\001\023\000\000\002\223\000\000\002l\000\000\002r\006\021\000\000\002g\000\000\000\000\002x\000\000\001\132\002n\002\023\002\020\002\021\001e\000\000\000\000\002o\000\000\000\000\006\022\000\000\002\024\006\024\002k\000\200\000\000\002X\000\000\000\000\002z\000\000\006\025\001\235\000\000\002Y\000\000\000\000\000\000\000\000\000\000\002\229\000\000\001\016\002l\002i\002r\001\236\002g\001\023\001$\000\000\002x\000\000\001\132\002n\002\024\003W\002k\000\200\000\000\006\026\000\000\002i\002\020\002\021\001e\000\000\000\000\001\198\000\000\004\137\000\000\000\000\002\024\002z\002k\000\200\001\230\002X\000\000\002l\001\234\000\000\001\023\000\000\000\000\002Y\002o\002m\000\000\001\132\002n\002\232\000\000\006\027\000\000\000\000\000\000\000\000\002g\001%\000\000\006\028\000\000\000\000\002o\002i\000\000\002\020\002\021\001e\000\000\000\000\000\000\002l\000\000\002r\002\024\000\000\002k\000\200\001\235\002x\002X\001\132\002n\006\029\001.\000\000\000\000\000\000\002Y\002l\000\000\002r\001\236\000\000\003\001\000\000\000\000\002x\006\030\001\132\002n\002g\002z\000\000\000\000\000\000\002o\006\031\000\000\002\020\002\021\001e\006!\000\000\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\006#\000\000\002X\000\000\002\024\000\000\002k\000\200\000\000\002X\002Y\002l\000\000\002r\000\000\000\000\006$\002Y\000\000\002x\003\011\001\132\002n\002g\000\000\000\000\000\000\003\016\000\000\000\000\002g\000\000\002\020\002\021\001e\000\000\002o\000\000\002i\002\020\002\021\001e\002z\000\000\001\198\000\000\004\146\000\000\000\000\002\024\000\000\002k\000\200\001\230\002X\003T\000\000\001\234\000\000\001\023\000\000\000\000\002Y\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\003\018\001\132\002n\002g\000\000\000\000\000\000\005\214\000\000\002o\002i\000\000\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\002\024\002z\002k\000\200\001\235\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\000\000\002l\000\000\002r\001\236\000\000\002Y\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\003\022\000\000\002o\002g\002\023\000\000\000\000\000\000\000\000\002o\000\000\002i\002\020\002\021\001e\002\024\002z\002k\000\200\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002X\000\000\002l\000\000\003\014\000\000\000\000\002X\002Y\002l\002x\003\014\001\132\002n\000\000\002Y\000\000\002x\003\030\001\132\002n\002g\000\000\003W\000\000\003$\000\000\002o\002g\000\000\000\000\000\000\000\000\002z\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\000\000\000\000\002\024\002l\002k\000\200\000\000\002X\000\000\000\000\002l\002m\003\014\001\132\002n\002Y\000\000\001\198\002x\004\154\001\132\002n\000\000\000\000\000\000\003*\001\230\000\000\002g\000\000\001\234\000\000\001\023\000\000\002o\000\000\002i\002\020\002\021\001e\000\000\002z\000\000\002i\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\002\024\000\000\002k\000\200\000\000\000\000\002Y\002l\000\000\003\014\000\000\000\000\0032\000\000\000\000\002x\001\235\001\132\002n\002g\000\000\000\000\002\020\002\021\001e\002o\000\000\000\000\000\000\000\000\001\236\000\000\002o\002i\000\000\000\000\000\000\002X\002z\000\000\000\000\000\000\000\000\000\000\002\024\002Y\002k\000\200\000\000\000\000\000\000\0037\002l\000\000\003\014\000\000\000\000\000\000\002g\002l\002x\003\014\001\132\002n\000\000\000\000\000\000\002x\000\000\001\132\002n\001\198\000\000\006O\000\000\000\000\002o\000\000\002i\000\000\001\230\000\000\000\000\002z\001\234\000\000\001\023\000\000\000\000\002\024\002z\002k\000\200\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\003.\000\000\000\000\002X\000\000\000\000\002x\000\000\001\132\002n\000\000\002Y\002i\002\020\002\021\001e\002o\000\000\000\000\001\235\000\000\003C\000\000\002\024\002g\002k\000\200\000\000\002X\002z\000\000\000\000\000\000\001\236\000\000\000\000\002Y\002\020\002\021\001e\000\000\000\000\000\000\002l\000\000\002r\003H\000\000\000\000\002g\000\000\002x\002X\001\132\002n\002o\000\000\000\000\000\000\000\000\002Y\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\003M\000\000\000\000\002g\002z\000\000\000\000\002X\000\000\000\000\000\000\000\000\002l\002i\002r\002Y\000\000\002\020\002\021\001e\002x\000\000\001\132\002n\002\024\003\\\002k\000\200\002g\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\002i\000\000\002Y\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\002\024\003_\002k\000\200\002g\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002X\000\000\000\000\002o\002X\002l\000\000\003\014\002Y\002i\000\000\000\000\002Y\002x\003e\001\132\002n\000\000\003g\000\000\002\024\002g\002k\000\200\000\000\002g\000\000\002o\000\000\000\000\002l\000\000\003\014\000\000\002i\000\000\002z\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002o\000\000\002l\000\000\003\014\000\000\000\000\000\000\000\000\002z\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\002l\002i\003\014\000\000\000\000\002i\002z\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\000\000\000\000\002\020\002\021\001e\002l\000\000\003.\000\000\000\000\000\000\002z\000\000\002x\000\000\001\132\002n\002X\002\020\002\021\001e\000\000\000\000\000\000\002o\002Y\000\000\000\000\002o\000\000\000\000\003q\000\000\002X\000\000\000\000\002z\000\000\002g\000\000\000\000\002Y\000\000\000\000\002\020\002\021\001e\003z\000\000\000\000\000\000\002l\000\000\002r\002g\002l\000\000\002r\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\003\182\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\002z\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\000\000\002Y\002i\000\000\000\000\000\000\002Y\003}\000\000\000\000\000\000\000\000\003\139\002\024\002g\002k\000\200\000\000\002i\002g\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\002\023\002o\002Y\000\000\000\000\000\000\000\000\000\000\003\142\000\000\000\000\002\024\000\000\002k\000\200\002g\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002i\002r\000\000\000\000\000\000\002i\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002l\002\024\002r\002k\000\200\000\000\000\000\000\000\002x\000\000\001\132\002n\002\020\002\021\001e\002z\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002l\002X\002o\000\000\002i\002z\002X\002o\002m\002Y\001\132\002n\000\000\000\000\002Y\002\024\000\000\002k\000\200\003\152\000\000\000\000\002g\000\000\003\157\000\000\000\000\002g\000\000\002l\000\000\002r\000\000\000\000\002l\000\000\002r\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\006\021\002i\002x\000\000\001\132\002n\002i\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\002\024\006\022\002k\000\200\006\024\000\000\000\000\002X\002z\000\000\002\020\002\021\001e\006\025\000\000\002Y\000\000\000\000\000\000\000\000\000\000\003\206\000\000\000\000\000\000\002X\000\000\002o\002g\000\000\000\000\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\003\219\000\000\000\000\006\026\002\020\002\021\001e\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\003\014\000\000\002X\002l\000\000\003\014\002x\000\000\001\132\002n\002Y\002x\000\000\001\132\002n\000\000\004\007\000\000\000\000\000\000\006\027\000\000\000\000\002g\000\000\000\000\000\000\000\000\006\028\002z\000\000\002i\000\000\000\000\002z\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002i\000\000\002X\006(\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002\024\000\000\002k\000\200\000\000\004J\000\000\006\030\000\000\000\000\000\000\000\000\002g\000\000\002o\000\000\006\031\000\000\000\000\000\000\000\000\006!\002i\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\006#\002o\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002l\002X\002r\000\000\000\000\000\000\006$\000\000\002x\002Y\001\132\002n\001d\001e\000\000\005w\000\000\000\000\002l\000\000\002r\000\000\002g\000\000\002o\000\000\002x\000\000\001\132\002n\002i\002z\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002z\000\000\002l\000\000\002r\000\000\004\023\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\001\031\000\000\000\000\005\012\000\000\000\000\000\000\002o\000\000\001w\000\000\001x\0024\000\000\000\000\002i\002z\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\001\"\002k\000\200\000\000\000\000\000\000\000\000\002l\002X\002r\002\020\002\021\001e\001\127\000\000\002x\002Y\001\132\002n\000\000\000\000\000\000\005z\000\000\001n\002X\000\000\000\200\000\000\002g\000\000\002o\000\000\002Y\000\000\003\130\000\000\000\000\002z\005\137\000\000\000\000\000\000\005\014\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\005\017\000\000\000\000\000\000\001\129\000\000\002\020\002\021\001e\002i\002z\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\002\024\002X\002k\000\200\000\000\000\000\002i\000\000\000\000\002Y\002\020\002\021\001e\000\000\000\000\005\140\000\000\002\024\000\000\002k\000\200\000\000\002g\000\000\000\000\002X\000\000\002\020\002\021\001e\000\000\005\018\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\153\000\000\001\031\002X\004\220\001 \005\023\002g\005\020\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\156\000\000\001.\002l\000\000\002r\000\000\002g\000\000\000\000\000\000\002x\001\"\001\132\002n\000\000\000\000\000\000\000\000\000\000\002l\000\000\002r\000\000\000\000\002i\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\002z\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002i\000\000\002z\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\002\024\002X\002k\000\200\000\000\000\000\002i\000\000\002o\002Y\000\000\002\020\002\021\001e\000\000\005\177\000\000\002\024\000\000\002k\000\200\000\000\002g\000\000\001\016\000\000\002X\002\020\002\021\001e\001\023\001$\002o\000\000\002Y\002l\000\000\002r\000\000\000\000\005\180\000\000\002X\002x\000\000\001\132\002n\002g\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\005\184\000\000\000\000\002l\000\000\002r\000\000\002g\000\000\000\000\002z\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\001>\002l\000\000\002r\000\000\006\021\002i\001%\000\000\002x\000\000\001\132\002n\000\000\000\000\002z\000\000\002\024\000\000\002k\000\200\000\000\000\000\006\022\000\000\000\000\006\024\000\000\000\000\000\000\000\000\002i\002z\000\000\001.\006\025\000\000\001?\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002i\000\000\002o\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\006\026\000\000\000\000\002X\000\000\000\000\000\000\001d\001e\000\000\002o\002Y\002l\000\000\002r\000\000\000\000\006\191\000\000\000\000\002x\000\000\001\132\002n\002g\000\000\002o\001f\001v\000\000\001h\001i\000\000\000\000\006\027\000\000\000\000\002l\000\000\002r\000\000\000\000\006\028\002z\000\000\002x\000\000\001\132\002n\000\000\006Y\000\000\000\000\002l\000\000\002r\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\0061\000\000\002z\000\000\001w\000\000\001x\0024\000\000\000\000\000\000\002\020\002\021\001e\000\000\006\030\000\000\002i\002z\000\000\000\000\000\000\000\000\000\000\006\031\000\000\002X\000\000\002\024\006!\002k\000\200\000\000\000\000\002Y\001\127\002\020\002\021\001e\006#\006\193\000\000\000\000\000\000\000\000\000\000\001n\002g\000\000\000\200\000\000\002X\002\020\002\021\001e\006$\000\000\003\130\000\000\002Y\002o\000\000\001d\001e\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002g\000\000\000\000\002Y\001\031\000\000\000\000\005\012\000\000\000\000\001f\001v\000\000\001h\001i\002l\002g\002r\000\000\000\000\001\166\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\001\"\000\000\001\129\002i\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\002\024\002z\002k\000\200\000\000\000\000\000\000\000\000\001w\000\000\001x\001\153\000\000\000\000\002i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\005\014\002i\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\002o\001\016\002l\000\000\002r\000\000\000\000\001\023\005\017\000\000\002x\000\000\001\132\002n\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\004\024\000\000\000\000\000\000\002z\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002l\000\000\004\020\001d\001e\000\000\000\000\000\000\002x\001\129\001\132\002n\000\000\000\000\000\000\002z\005\018\001\130\000\000\001\132\001l\001d\001e\001f\001v\000\000\001h\001i\004\220\000\000\005\022\002z\005\020\001\150\000\000\002\020\002\021\001e\000\000\000\000\000\000\001f\001v\001.\001h\001i\000\000\000\000\000\000\000\000\002X\001\155\000\000\001d\001e\000\000\000\000\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\153\000\000\002g\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\002\020\002\021\001e\001w\000\000\001x\001\153\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\002X\001\127\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\000\000\000\000\001n\001f\001v\000\200\001h\001i\000\000\001\127\001w\002g\001x\0024\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\002i\000\000\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\001\127\000\000\002X\000\000\000\000\001w\000\000\001x\002<\000\000\002Y\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\001\129\000\000\003~\002g\000\000\000\000\002o\000\000\001\130\002i\001\132\001l\000\000\000\000\000\000\000\000\001\127\000\000\001\129\000\000\002\024\000\000\002k\000\200\000\000\000\000\001\130\001n\001\132\001l\000\200\000\000\000\000\002l\000\000\003\190\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\001\129\000\000\002o\000\000\000\000\000\000\000\000\002?\001\130\000\000\001\132\001l\002i\000\000\002z\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\000\000\002l\002X\003X\000\000\000\000\000\000\002X\001\129\002x\002Y\001\132\002n\000\000\000\000\002Y\001\130\000\000\001\132\001l\000\000\000\000\000\000\002g\000\000\000\000\000\000\002o\002g\000\000\000\000\000\000\002z\000\000\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\002X\002l\000\000\002\255\002Y\000\000\000\000\000\000\002Y\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002i\000\000\000\000\002z\000\000\002i\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002o\000\000\000\000\002X\002i\002o\000\000\002Y\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002g\002k\000\200\000\000\002g\000\000\000\000\002l\000\000\002t\000\000\000\000\002l\000\000\002v\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\002o\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002{\000\000\002l\002i\002\130\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\002\020\002\021\001e\000\000\002\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\002X\002\020\002\021\001e\002X\000\000\000\000\000\000\002Y\002o\000\000\000\000\002Y\002o\000\000\000\000\002X\000\000\000\000\000\000\000\000\002g\000\000\000\000\002Y\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002g\002\132\000\000\002l\000\000\002\134\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002i\000\000\000\000\000\000\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002i\002k\000\200\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\002X\002o\000\000\000\000\002X\000\000\000\000\000\000\002Y\000\000\000\000\000\000\002Y\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\002l\002g\002\136\000\000\002l\000\000\002\138\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002l\000\000\002\140\000\000\002\024\000\000\002k\000\200\002x\000\000\001\132\002n\000\000\000\000\000\000\002z\000\000\000\000\000\000\002z\002\020\002\021\001e\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\002X\002o\000\000\000\000\002X\002i\000\000\000\000\002Y\002i\000\000\000\000\002Y\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\024\002g\002k\000\200\000\000\002g\000\000\000\000\002l\000\000\002\142\002\020\002\021\001e\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\001\031\000\000\000\000\001 \002X\000\000\002o\000\000\000\000\000\000\002o\000\000\002Y\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\001\"\000\000\006\140\000\000\000\000\000\000\002l\000\000\002\144\000\000\002l\002i\002\146\000\000\002x\002i\001\132\002n\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\002\024\000\000\002k\000\200\000\000\000\000\000\000\002\020\002\021\001e\000\000\002z\002\020\002\021\001e\002z\000\000\001*\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002X\002o\000\000\002Y\002i\002o\000\000\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\001\016\000\000\002g\000\000\000\000\000\000\001\023\001$\000\000\002l\000\000\002\148\000\000\002l\000\000\002\150\000\000\002x\000\000\001\132\002n\002x\000\000\001\132\002n\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\002z\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\001>\002X\000\000\000\000\002l\002i\002\152\001%\000\000\002Y\002i\006\147\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\002\024\002g\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\002\020\002\021\001e\001.\002z\000\000\001H\000\000\000\000\000\000\002X\000\000\000\000\000\000\000\000\002X\000\000\002o\002Y\000\000\000\000\000\000\002o\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\154\000\000\000\000\002l\002i\002\156\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002\020\002\021\001e\000\000\002z\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\002X\000\000\000\000\000\000\002i\000\000\000\000\002o\002Y\002i\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\002\024\002g\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\158\000\000\000\000\000\000\002X\000\000\002x\000\000\001\132\002n\000\000\002o\002Y\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002g\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\000\000\002\160\000\000\000\000\002l\002i\002\162\002x\000\000\001\132\002n\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\002z\000\000\000\000\000\000\000\000\002z\002X\000\000\000\000\000\000\002\171\001e\000\000\000\000\002Y\002i\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\002\225\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\002l\000\000\002\164\000\000\000\000\000\000\002\188\000\000\002x\000\000\001\132\002n\000\000\002o\002\191\001d\001e\001f\002\192\000\000\001h\001i\000\000\000\000\002\188\000\000\000\000\002\230\002\246\002\247\000\000\002z\002\191\000\000\000\000\001f\002\192\000\000\001h\001i\002l\002i\002\166\002\020\002\021\001e\000\000\000\000\002x\000\000\001\132\002n\002\024\000\000\002k\000\200\000\000\006\021\002X\001\127\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\000\000\000\000\001n\002z\007\020\000\200\000\000\007\021\000\000\000\000\006\024\002g\000\000\000\000\000\000\000\000\002o\000\000\000\000\006\025\000\000\000\000\000\000\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\002\250\000\000\000\200\000\000\000\000\000\000\001m\000\000\002l\000\000\002\168\000\000\000\000\006\026\000\000\000\000\002x\001n\001\132\002n\000\200\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\002\020\002\021\001e\000\000\002\193\001\130\002i\001\132\001l\000\000\002z\001\031\000\000\000\000\005\012\002X\000\000\002\024\006\027\002k\000\200\000\000\002\193\002Y\002\195\000\000\006\028\000\000\000\000\001\129\000\000\000\000\000\000\002\020\002\021\001e\002g\001\157\001\"\001\132\001l\000\000\002\194\000\000\000\000\000\000\007\022\001\129\002X\002o\000\000\000\000\002\020\002\021\001e\001\157\002Y\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\006\030\000\000\002X\000\000\002g\000\000\000\000\000\000\000\000\006\031\002Y\002l\000\000\003\005\006!\000\000\005\014\000\000\000\000\002x\000\000\001\132\002n\002g\006#\000\000\000\000\000\000\000\000\000\000\002i\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\000\000\006$\002\024\002z\002k\000\200\001\016\002X\002\020\002\021\001e\000\000\001\023\005\017\000\000\002Y\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002X\002i\000\000\000\000\000\000\002g\000\000\000\000\002Y\000\000\000\000\002o\002\024\000\000\002k\000\200\000\000\000\000\000\000\000\000\002i\002g\000\000\000\000\002\020\002\021\001e\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\000\000\000\000\000\000\002l\002X\003\"\005\018\000\000\000\000\002o\000\000\002x\002Y\001\132\002n\000\000\000\000\000\000\004\220\000\000\005\021\000\000\005\020\000\000\000\000\002g\000\000\000\000\002o\002i\000\000\000\000\000\000\001.\002z\000\000\002l\000\000\003(\000\000\002\024\005#\002k\000\200\002x\002i\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002\024\003-\002k\000\200\002\020\002\021\001e\002x\000\000\001\132\002n\002z\000\000\005$\006\199\005%\002o\000\000\000\000\002X\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002Y\002i\000\000\002z\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\002\024\002g\002k\000\200\002l\005&\0035\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\000\000\000\000\000\000\000\000\002l\000\000\003:\000\000\000\000\000\000\000\000\000\000\002x\000\000\001\132\002n\002o\000\000\000\000\002z\000\000\000\000\005'\002\020\002\021\001e\000\000\000\000\000\000\000\000\000\000\005(\000\000\005)\000\000\002z\000\000\000\000\002X\000\000\000\000\000\000\000\000\002l\002i\003<\002Y\002\020\002\021\001e\000\000\002x\000\000\001\132\002n\002\024\005e\002k\000\200\002g\000\000\000\000\002X\002\020\002\021\001e\000\000\000\000\001\031\000\000\002Y\001 \000\000\000\000\002z\002\020\002\021\001e\002X\005+\006\201\001d\001e\002g\005-\0057\002Y\002o\000\000\000\000\002X\000\000\000\000\000\000\005a\001\"\000\000\000\000\002Y\002g\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\005b\002g\000\000\000\000\002l\000\000\003?\000\000\002i\000\000\000\000\000\000\002x\000\000\001\132\002n\002\020\002\021\001e\002\024\000\000\002k\000\200\000\000\000\000\000\000\006\021\000\000\001*\000\000\000\000\002X\002i\000\000\001w\002z\001x\0024\000\000\002Y\000\000\007\020\000\000\002\024\007\021\002k\000\200\006\024\002i\000\000\000\000\002o\002g\000\000\000\000\000\000\006\025\001\016\000\000\002\024\002i\002k\000\200\001\023\001$\001\127\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002o\001n\000\000\002l\000\200\003F\000\000\000\000\000\000\000\000\006\026\002x\003\129\001\132\002n\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002l\002o\003K\000\000\000\000\000\000\006\139\002z\002x\002i\001\132\002n\000\000\001%\000\000\000\000\002l\006\027\003P\000\000\002\024\000\000\002k\000\200\002x\006\028\001\132\002n\002l\000\000\003S\002z\000\000\001\129\002\171\001e\002x\000\000\001\132\002n\001.\001\130\000\000\001\132\001l\007\026\000\000\002z\002\020\002\021\001e\000\000\002o\000\000\002\225\001v\000\000\001h\001i\002z\000\000\000\000\000\000\002X\006\030\000\000\000\000\000\000\000\000\000\000\000\000\002Y\000\000\006\031\000\000\000\000\000\000\000\000\006!\002l\000\000\003\133\002\171\001e\002g\000\000\000\000\002x\006#\001\132\002n\000\000\000\000\000\000\000\000\000\000\002\230\002\246\002\247\002\171\001e\000\000\002\225\001v\006$\001h\001i\000\000\000\000\000\000\002z\002\171\001e\000\000\000\000\000\000\000\000\001d\001e\002\225\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\001\127\000\000\000\000\002\225\001v\000\000\001h\001i\000\000\001f\001v\001n\001h\001i\000\200\002i\002\230\002\246\002\247\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\024\000\000\002k\000\200\002\020\002\021\001e\002\230\002\246\002\247\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\144\002\230\002\246\002\247\001\127\000\000\000\000\000\000\001w\002\022\001x\006\245\000\000\006\247\002o\001n\000\000\000\000\000\200\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001n\001\127\001\130\000\200\001\132\001l\000\000\001\127\000\000\002l\000\000\003\135\001n\000\000\000\000\000\200\004\r\002x\001n\001\132\002n\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\005\195\001d\001e\000\000\000\000\000\000\000\000\002z\000\000\001\129\000\000\000\000\005\229\000\000\000\000\000\000\002\023\001\130\000\000\001\132\001l\001f\001v\000\000\001h\001i\001\129\002\024\000\000\002k\000\200\000\000\000\000\000\000\001\130\000\000\001\132\001l\001\129\000\000\000\000\000\000\000\000\000\000\001\129\000\000\001\130\001\031\001\132\001l\001 \000\000\001\130\0012\001\132\001l\001\031\000\000\000\000\001 \000\000\000\000\0012\000\000\001w\000\000\001x\006:\000\000\000\000\000\000\000\000\000\000\0013\001\"\000\000\000\000\000\000\000\000\000\000\0014\000\000\0013\001\"\001d\001e\002l\000\000\000\000\001M\000\000\001d\001e\000\000\002m\001\127\001\132\002n\000\000\000\000\000\000\000\000\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\001f\001v\000\000\001h\001i\000\000\001*\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0018\000\000\000\000\000\000\001f\001v\000\000\001h\001i\0018\000\000\000\000\001\016\001w\000\000\001x\001\158\000\000\001\023\001$\001w\001\016\001x\001\136\000\000\000\000\000\000\001\023\001$\000\000\000\000\001\129\000\000\001d\001e\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\000\000\001\127\000\000\000\000\001w\000\000\001x\001\133\001\127\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\001n\001>\000\000\000\200\000\000\000\000\000\000\000\000\001%\000\000\001>\000\000\001F\000\000\000\000\000\000\001\127\001%\000\000\001d\001e\001F\000\000\000\000\000\000\001d\001e\001n\000\000\000\000\000\200\000\000\000\000\000\000\001w\001.\001x\001z\001H\001f\001v\000\000\001h\001i\001.\001f\001v\001H\001h\001i\000\000\000\000\001\129\000\000\000\000\000\000\000\000\001d\001e\001\129\001\130\000\000\001\132\001l\000\000\001\127\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\001n\001f\001v\000\200\001h\001i\001w\000\000\001x\001}\001\129\000\000\001w\000\000\001x\001\128\000\000\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\001\127\001w\000\000\001x\001\131\001n\000\000\000\000\000\200\001f\001v\001n\001h\001i\000\200\000\000\001\129\000\000\000\000\000\000\000\000\001d\001e\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\141\000\000\000\000\001f\001v\000\000\001h\001i\000\000\001\129\000\000\000\000\000\000\001d\001e\001\129\000\000\001\130\000\000\001\132\001l\000\000\002\221\001\130\000\000\001\132\001l\000\000\001\127\001w\002\224\001x\001\144\001f\002\192\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\001w\001\129\001x\002N\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\132\001l\000\000\001\127\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001m\001\132\001l\000\000\000\000\000\000\001d\001e\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\001w\000\000\001x\002\235\000\000\001\129\000\000\000\000\001f\001v\000\000\001h\001i\001\130\000\000\001\132\001l\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\000\000\000\000\002\193\000\000\000\000\001\130\001\127\001\132\001l\001w\000\000\001x\002\238\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\002\020\002\021\001e\000\000\001w\001\129\001x\002\241\000\000\000\000\000\000\000\000\000\000\001\157\000\000\001\132\001l\000\000\001\127\000\000\001d\001e\000\000\002S\001\031\000\000\000\000\001 \000\000\001n\001I\000\000\000\200\000\000\000\000\001\127\001w\000\000\001x\002\249\001f\001v\000\000\001h\001i\000\000\001n\000\000\000\000\000\200\001K\001\"\000\000\000\000\001\129\000\000\004\213\000\000\000\000\000\000\000\000\000\000\001\130\001\031\001\132\001l\001 \001\127\000\000\001I\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001w\000\000\001x\004H\000\000\001\129\001K\001\"\000\000\000\000\000\000\001*\002\023\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\001\129\002\024\000\000\002k\000\200\000\000\0018\000\000\001\130\001\127\001\132\001l\000\000\000\000\000\000\001d\001e\000\000\001\016\000\000\001n\000\000\000\000\000\200\001\023\001$\000\000\001\031\001*\000\000\001 \000\000\001\129\0012\000\000\001f\002\192\000\000\001h\001i\001\130\000\000\001\132\001l\000\000\0018\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0017\001\"\000\000\000\000\001\016\000\000\000\000\002l\001d\001e\001\023\001$\000\000\000\000\000\000\002m\001>\001\132\002n\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\129\005\011\001f\002\192\000\000\001h\001i\000\000\001\130\000\000\001\132\001l\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\001d\001e\001.\000\000\000\000\001H\000\000\001>\001m\000\000\000\000\000\000\000\000\0018\001%\001d\001e\000\000\001F\001n\001f\002\192\000\200\001h\001i\001\016\000\000\000\000\001d\001e\000\000\001\023\001$\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\001.\000\000\000\000\001H\005\157\000\000\000\000\001f\002\192\000\000\001h\001i\003r\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\003t\000\000\000\000\000\000\001>\000\000\001\129\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\157\001F\001\132\001l\000\000\000\000\000\000\000\000\001m\000\000\000\000\000\000\000\000\003r\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\001m\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\003s\000\000\001n\000\000\001m\000\200\001\129\001d\001e\000\000\000\000\000\000\000\000\000\000\001\157\001n\001\132\001l\000\200\000\000\000\000\003r\000\000\000\000\005\181\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\000\000\000\000\000\000\006\b\000\000\000\000\000\000\003w\000\000\000\000\000\000\001d\001e\001\129\000\000\000\000\002\193\000\000\000\000\000\000\000\000\001\157\000\000\001\132\001l\000\000\000\000\000\000\001\129\000\000\000\000\001f\002\192\000\000\001h\001i\001\157\000\000\001\132\001l\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\157\006\n\001\132\001l\001d\001e\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\000\000\001d\001e\000\000\001m\000\000\000\000\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\001n\001f\002\192\000\200\001h\001i\001f\002\192\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\001m\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\193\000\000\005#\001n\000\000\000\000\000\200\000\000\000\000\000\000\001f\002\192\000\000\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\005$\006\181\005%\001\157\001m\001\132\001l\005\208\000\000\000\000\001\031\001m\000\000\001 \000\000\001n\001m\000\000\000\200\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001n\000\000\000\000\000\200\005&\001\129\000\000\000\000\000\000\000\000\001\"\000\000\000\000\001\157\000\000\001\132\001l\000\000\000\000\000\000\004\198\000\000\005\208\000\000\000\000\000\000\005\221\001m\000\000\006\b\000\000\000\000\000\000\000\000\006\b\005\154\001\031\005'\001n\001 \000\000\000\200\000\000\000\000\000\000\000\000\005(\001\129\005)\000\000\000\000\000\000\000\000\001*\001\129\001\157\000\000\001\132\001l\001\129\000\000\000\000\001\157\001\"\001\132\001l\000\000\001\157\005\220\001\132\001l\005e\003v\003\237\000\000\001\031\006\t\001\031\001 \000\000\001 \006\017\001\016\000\000\000\000\000\000\000\000\006}\001\023\001$\000\000\000\000\000\000\000\000\005+\000\000\000\000\001\129\000\000\005-\0057\006\021\001\"\000\000\001\"\001\157\001*\001\132\001l\005a\000\000\000\000\004\198\000\000\004\198\000\000\007\020\000\000\000\000\007\021\000\000\000\000\006\024\000\000\000\000\005b\000\000\005\168\000\000\005\178\000\000\006\025\000\000\001>\000\000\001\016\000\000\000\000\000\000\000\000\001%\001\023\001$\000\000\004\203\001*\000\000\001*\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\026\000\000\002\020\002\021\001e\000\000\000\000\001.\001f\002\177\001H\001h\001i\000\000\001\016\000\000\001\016\000\000\000\000\000\000\001\023\001$\001\023\001$\001\031\003T\001>\001 \000\000\000\000\000\000\000\000\000\000\001%\006\027\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006\028\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\"\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001.\002\214\007\031\003\244\000\000\001>\000\000\001>\000\000\000\000\001\"\000\000\001%\000\000\001%\000\000\004\203\000\000\004\203\001\"\000\000\006\030\001m\000\000\000\000\000\000\000\000\000\000\005#\003\237\006\031\000\000\000\000\001n\001*\006!\000\200\002\023\000\000\001.\000\000\001.\001H\003\240\001H\006#\000\000\000\000\002\024\000\000\002k\000\200\000\000\001*\001\031\000\000\005$\001 \005%\000\000\000\000\006$\001*\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\001\016\003V\000\000\000\000\005\203\005&\001\023\001$\000\000\001\016\001\129\000\000\000\000\000\000\001\031\001\023\001$\001 \001\157\000\000\001\132\001l\000\000\000\000\000\000\002l\001\031\000\000\000\000\001 \000\000\000\000\001>\002m\000\000\001\132\002n\000\000\005'\001%\000\000\001\"\001*\002\185\000\000\000\000\000\000\005(\000\000\005)\000\000\001>\000\000\001\"\000\000\000\000\000\000\000\000\001%\000\000\001>\000\000\004\231\000\000\000\000\004\234\001.\001%\006\021\001H\000\000\001\016\005*\000\000\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \001*\001.\007\011\000\000\001H\006\024\001\031\000\000\006\225\001 \001.\005+\001*\003\244\006\025\000\000\005-\0057\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\005a\000\000\000\000\001\016\000\000\000\000\000\000\001\"\000\000\001\023\001$\001\031\001>\000\000\001 \001\016\005b\006\026\000\000\001%\000\000\001\023\001$\004\218\000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\"\000\000\001*\000\000\000\000\000\000\001\031\000\000\001.\001 \000\000\001H\001*\006\027\000\000\000\000\001>\000\000\001\"\000\000\000\000\006\028\000\000\001%\000\000\000\000\001<\004\231\001>\000\000\005\249\001\016\000\000\001\"\000\000\001%\000\000\001\023\001$\006\226\000\000\001\016\007\012\001*\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\006\030\001*\001.\000\000\000\000\001H\000\000\001\031\000\000\006\031\001 \000\000\001\016\000\000\006!\000\000\001*\001\031\001\023\001$\001 \000\000\001>\000\000\006#\000\000\000\000\000\000\000\000\001%\001\016\000\000\001>\006\186\001\"\001\031\001\023\001$\001 \001%\006$\000\000\000\000\001X\001\"\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\002\020\002\021\001e\001.\000\000\000\000\001H\000\000\000\000\001\"\001>\000\000\000\000\001.\000\000\000\000\001H\001%\002\020\002\021\001e\001\174\000\000\002U\001*\002\020\002\021\001e\001>\000\000\000\000\000\000\000\000\000\000\001*\001%\000\000\000\000\000\000\000\000\000\000\002_\000\000\001>\001.\000\000\000\000\001H\002j\000\000\001%\000\000\001*\001\016\001\212\002\020\002\021\001e\000\000\001\023\001$\000\000\001.\001\016\000\000\001D\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\001.\002y\000\000\001H\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\002\023\000\000\000\000\000\000\001\"\000\000\000\000\000\000\000\000\001>\000\000\002\024\000\000\002k\000\200\000\000\001%\000\000\002\023\001>\001\214\000\000\001\"\000\000\000\000\002\023\001%\000\000\000\000\002\024\002+\002k\000\200\000\000\000\000\000\000\002\024\001>\002k\000\200\000\000\000\000\000\000\001.\001%\000\000\001H\001*\002>\000\000\000\000\000\000\000\000\001.\000\000\002\023\001H\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\001*\002\024\000\000\002k\000\200\002l\001.\000\000\000\000\001H\000\000\001\016\000\000\002m\000\000\001\132\002n\001\023\001$\000\000\000\000\000\000\001\"\002l\000\000\000\000\000\000\000\000\000\000\001\016\002l\002m\000\000\001\132\002n\001\023\001$\000\000\002m\000\000\001\132\002n\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\002l\000\000\001>\001\031\000\000\001*\001 \000\000\002m\001%\001\132\002n\001\"\002\182\000\000\000\000\000\000\000\000\000\000\000\000\001>\001\"\000\000\002\020\002\021\001e\000\000\001%\000\000\000\000\001\"\002\187\000\000\000\000\001\016\000\000\001.\000\000\000\000\001H\001\023\001$\000\000\000\000\001\031\000\000\003\027\001 \000\000\000\000\000\000\000\000\000\000\001\031\001.\001*\001 \001H\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\016\001>\001\031\000\000\000\000\001 \001\023\001$\001%\001\016\000\000\000\000\002\204\000\000\000\000\001\023\001$\001\031\001\016\001\031\001 \000\000\001 \000\000\001\023\001$\000\000\000\000\000\000\001\"\001*\000\000\000\000\000\000\002\023\001.\000\000\000\000\001H\001*\000\000\000\000\000\000\000\000\001\"\002\024\001\"\002k\000\200\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\001\016\001>\000\000\002\211\000\000\000\000\001\023\001$\001%\001\016\001>\000\000\002\218\001*\000\000\001\023\001$\001%\000\000\001\031\000\000\002\227\001 \000\000\000\000\000\000\001.\000\000\001*\001H\001*\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\001.\002l\001\"\001H\001\023\001$\000\000\001>\000\000\002m\000\000\001\132\002n\001\016\001%\001\016\001>\000\000\004W\001\023\001$\001\023\001$\001%\000\000\001\031\000\000\004\175\005\012\000\000\000\000\000\000\000\000\000\000\001\031\000\000\001\031\005\012\000\000\001 \000\000\001.\000\000\000\000\001H\001*\000\000\000\000\000\000\001>\001.\001\031\001\"\001H\001 \000\000\001%\000\000\000\000\000\000\004\187\001\"\000\000\001\"\001>\000\000\001>\001\031\000\000\000\000\001 \001%\000\000\001%\001\016\004\200\000\000\004\217\001\"\000\000\001\023\001$\001\031\001.\001\031\001 \001H\005\012\000\000\000\000\000\000\000\000\000\000\000\000\001\"\005\014\000\000\000\000\001.\000\000\001.\001H\000\000\001H\005\014\000\000\001*\000\000\000\000\001\"\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\001\016\001>\000\000\000\000\000\000\000\000\001\023\005\017\001%\001\016\000\000\001\016\004\233\001*\000\000\001\023\005\017\001\023\001$\001\031\000\000\000\000\005\012\000\000\000\000\000\000\001\016\000\000\001*\000\000\005\014\000\000\001\023\001$\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\000\000\000\000\001\"\000\000\001\023\001$\000\000\001\031\000\000\000\000\001 \000\000\000\000\001\016\005\018\001\016\000\000\000\000\001>\001\023\001$\001\023\005\017\005\018\001\031\001%\004\220\001 \005\019\005\133\005\020\000\000\000\000\001>\001\"\004\220\000\000\005\031\000\000\005\020\001%\001.\000\000\000\000\005\151\005\014\000\000\000\000\000\000\001>\001.\001\"\001.\000\000\000\000\001H\001%\000\000\000\000\000\000\005\175\000\000\000\000\000\000\001>\000\000\001\031\001.\000\000\001 \001H\001%\000\000\005\018\001\016\006=\000\000\001*\000\000\000\000\001\023\005\017\000\000\001.\000\000\004\220\001H\005\235\000\000\005\020\000\000\000\000\000\000\001\"\001*\000\000\000\000\000\000\001.\001\031\001.\001H\001 \000\000\000\000\000\000\001\016\001\031\000\000\000\000\001 \000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\001\"\000\000\000\000\001\023\001$\000\000\005\018\000\000\001\"\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\220\000\000\006\005\000\000\005\020\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\001.\000\000\000\000\000\000\000\000\001%\001\016\000\000\000\000\006\146\001*\000\000\001\023\001$\000\000\001>\000\000\000\000\001*\000\000\000\000\000\000\001%\000\000\000\000\000\000\006\150\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001\016\000\000\001.\000\000\000\000\001H\001\023\001$\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\001.\000\000\000\000\001\207\000\000\000\000\001%\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\209\000\000\000\000\000\000\000\000\001.\000\000\000\000\003\239"))
+ ((16, "\000%\001k\000O\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\000\000\000\000\000\245\000\208\000&\001K\000\241\000!\000\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\195\000\000\000\000\000\000\000\000\000\000\000\187\000\000\000\000\000\000\000\155\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000=\192\000\000\000\000\000\000\000\139\000\000\000\000\000\000\000\000\000\000\000\000\000\000;(\0001\000&\000\217\000\000\000\234\002\132\000 \000\250\000\025\000\000\000\000\000\000\000|\000\000\000\000\002\132\000\000\000\000\000\000\000\000\001\234\000\000\000\238\000\000\000\000\000\000\000\000\000\000\000H\000\000\002\234\002$\b\"\000\000\000\000\n\226;(\000\000\000\000\000)\000\000\002P\000\000\031V\001\014\000\000\000\250\001~\000\000\000\000\000\254\001B\002\188\003\158\004\200\002$\002\000\000\139\002\188\001\200\001L\002p\011\160\000\000>(\001\222\003\234\000\161\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\132\000\000\t\022>(\011\208\000\000\000\000\002 \004\252\002\0141\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000#h\000\000\002F\005\012\002\210\000\000\000\000\000\000\000\000\0068\000\000\000\000\005\016\000#\005@\006d\b\006\000\000\002\144\003\000\005\146\001\128\002\224\005\226\001H\000\000\000\000\003$\006f\012\006\000\000\002\234\012\144#\242$&\000\000\000u\000\000\000\000\000\000\000\000\003\226>$\004J\000\000\007\020\004f\000\000!>7\016\000\129\000\000\000\213\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0001R\004\014\000\000\000\000\000\000\011\028\000\000\000\234\000\000\000\000\004\218\002(\000\000\000\000\007\158\000\000\015\224\000\000\004\218\000\254\004\218\000\000\000\000\000\000\000\000\000\0007$\000\000\006\188\0050\000\000\0216\007.\027V\000\000\000\000\000\000\004\218\000\000\000\000\000\000\000\000\004\158\000\000\000\000\000\000\000\000\000\0001\206\000\000\000\000\000\000\000\000\000\000\000\000\000@\005v\000\000\000\000\000\000\004\158\005\1542*\005\028\0074;\138\000\000\005T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\000\000\000\000\000\000\000\000\006\1362<\000\000\000\000\005\142\007\2302J\000\000\000\000\000\0003\000\005~32\000\000\005~\000\0003<\005~\000\0003\162#h\006j\006\178\000\000\000\000;\196\000\000\000\000\000\000\000\000\000\000\000\000\005~\000\000\000\0003\234\000\000\005~>\\\000\000\004\158\000\000\000\0004\160\000\000\005~\000>\000\000\000\000\005~\005~\000\000\000\000\005~\000\000\000\000$&\000\000\000\000\000\000\000\000\005~$\176\000\000\000\000\005~\000\000\001P\006\244\000\000\000\000\000\000\000\000\000\000\000\000\000\0007v\000\000\006\136\000\000>\134\004\158\000\000\000\000\000\000\000\000\006\200\007^\012\132\006\190\006\218\006\222\b\218\004\246\b\230\000\015\007\186\000\000\000\000\t \tl\tZ\000&\007R\n\198\000\000\004\200\004\174\003\254\000\222\b\198\000\000\000\000.\204\000\000DL\b\142\000\000>\192\004\158>\216\004\158\000\000\000\188\003>\000\000\012f\004\200\000\000\000\000\007\198\000\000\000\000\000\000\000\000\000\000\014\246\004\200\016^\004\200\000\000\002\230\000\000\000\000\003\148\000\000\000\000\000\000\t\024\000\000\000\000\000\000\004\200\000\000\000\000\004\200\000\000\007R\0060\000\000\000>\002\224\000\000\000>\000\000\000\000\0174\004\200\000\000\000\000\000\000\000\000\000\000\000\000\000>\012\206\rx\t\022\b\206\004\1404\170\000\000\b>\n\000\r\194\bz\n\002?\024?N\000\000\000\000\000\000\000\000\000\000\004\014\t\192\000\000\000\000\000\000\b\166\nD\006\198\000>\017\198\000\000\004\200\000\000\000\000\000\000\012\144\000\000?\170\004\158\r\204\b\190\np\014\022\b\228\nv\014<$l\005~\0154\t:\n\200:\024\n:\000\000$\144\005~?\180\004\158\n>\000\000\000\000\000\000\000\000#h\n&\000\0007\172\015<\t\186\n\2024\224\005~\015~\t\208\n\212?V\000\000?~\000\000\000\000\015\164\006.\007F\000\000\000\000\000\000\000\000@>\000\000\000\000\000\000\000\252\015\254\000\000\000\000\000\000\000\000%\n@\146\000\000\000\000\000\000\000\000\000\000\t\166\016n\000\000\t\208%`\t\208%\180\t\208\000\000@\208\000\000%\190\t\208\017\012\004T\017h\000\000\000\000&\"\t\208&~\t\208&\162\t\208'D\t\208'd\t\208'\150\t\208(0\t\208(b\t\208(\130\t\208(\252\t\208),\t\208)N\t\208)\248\t\208*\026\t\208*:\t\208*\220\t\208*\228\t\208+&\t\208+\200\t\208+\208\t\208\n\218\017t5j#h\n\176\000\000,\148;\246\000\000\018\006\000\000@\012\000\000\004\158<H\000\000\004\158@\214\004\158\000\000\018*\000\000\000\000\000\000,\184\000\000\000\000<H\n\180\000\000@\246\004\158\018t\000\000\000\000\nD\000\000A\022\004\158\019\n\000\000\000\000\019r\000\000\000\000\000\000A4\004\158\019\162\000\000\n\026\019\236\000\0005*\000\000\005~5v\000\000\005~6\030\000\000\005~\004T\000\000\000\000\000\000\000\000\000\0006f\005~\000\000\004,\005\254\000\000\000\000\000\000\t\208\020\012\000\000\000\000\000\000\020<\000\000\000\000\000\000\000\000\000\000\021\026\000\000\000\000\000\000\t\208\021d\000\000\021\132\000\000\000\000\000\000\021\182\000\000\000\000\000\000\000\000A\130\000\000\000\000\022T\000\000\000\000\000\000,\238\t\208\022\254\000\000\000\000\000\000,\246\t\208\023\030\000\000\000\000\000\000-J\t\208\002\252\023N\000\000\000\000-\184\t\208\023\200\000\000\000\000.(\t\208\023\232\000\000\000\000.|\t\208\000\000\000\000\023~\000\000\000\000.\132\t\208\024\184\000\000\000\000.\198\t\208\024\198\000\000\000\000.\234\t\208\000\000/F\t\208\000\000<\146\000\000\000\000\t\208\000\000\000\000\025 \000\000\000\000\025z\000\000\000\000\n^\000\000\000\000\025\228\000\000\026.\000\000\000\000\000\000#h\011>\000\0007\246\002\160\004\218\026^\000\0008\000\000\000\000\000\000\0008D\000\000\000\000\026\244\000\000\027P\000\000\000\000\000\000\000\0000.\000\000\000\000\000\000/\170\t\2080n\t\208\000\000\n\026\027Z\000\000\000\000\027\180\000\0000\158\000\000\000\000?N\000\000\000\000\000\000\028\026\000\000\000\000\000\000\000\000\028J\000\000\000\000\000\000\000\000\011\204\000\000\000\000\000\0006\178\000\000\001\216\000\000\004F\000\000\011\150\000\000\002(\000\000\000\000\000\000\000\000\000\000\000\000\004\014\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t\208\000\000\012\006\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\n\224\006\250\000>\028\196\000\000\011\024\n\228\011\194\004\180\007\182\000>\017\208\004\200\007\214\000>\000\000\029\026\000\000\006~\000\000\011\142\n\240\006\184\000\000\000\000\000\000\000\000\000\000\011\188\000\025\001\178\000\000\000\000\000\000<\154\000\000D\174\000\000\011$\000\000\011(\000\000\000\000\000\000\000\000\006\014\000\000\000\000\000\000\004\150\004\218\000\000\004\218\000\016\000\000\006j\004\218\004\218\011J\000\000\029\132\000\000\000\000\011T\012\142\000\000\029\180\b,\000\000\000\000\000\000\000\000\000\000\000\000\t\208\000\000\030\028\000\000\t\208\000\000\000\000\018L\000\000\004\200\000\000\018~\000\000\004\200\000\000\019>\004\200\000\000\001\b\000\000\011V\bp\001\244\000\000\011\208\011\216\011p\012\n\012\164\019\214\004\200\b\158\000\000\011\128\012\132\012\148\007\012\b\178\012l\011\152\012\176\007r\b\202\012\128\000\000\000\000\007\146\b\248\000\000\004\252\003 6\224\005~\030\128\000\000\006\000\003j\012:\011\154\t\n\003\184\000\000\012D\011\182\b\152\000\000A\206\004\158\012\244\012\248\000\000\t$\000\000\012h\011\196\bn\012\198\006\248\000\000\000\000\000\000\000\000\011\214\tn\000\000\011\244\t\146\000\000\bH3>\012\206\012\236\012\b\004\248\t\178\000\000\012\"\005\238\t\206\000\000\012\242\r\b\0126\r2\012\164\022\144\004\200\000\000\012>\r\164\000\000\b\006\000\000\nX\000\000\r\186\000\000\022\192\005\026\r\142\012J\r\200\000\000\0248\005Z\r\156\000\000\000\000\004\\\003^\n\138\000\000\024d\004\200\n\156\000\000\005\208\000\000\rZ\012~\024\140\005\168\000\000\r\\\012\142\b\194\012\198\r^\rh\012\170\014\196\000\000\r\160\003N\000\000\000\000\000\000\000\000\007\136\012\174\rxA\226\004\158\000\000\000i\012\186\014<\000\000\000\000\000\000\000\000\000\000\000\000A\242\006\026\000\000\012\198\014\144\000\000\000\000\000\000\000\000\000\000\000\000\022\b\000\000B2\004\158\n\160\000\000\004\158\012\214\b\196\000\000\012\246\012\254\t\248\000\000\n\150\026~\000\000\006\n\000\000B\166\004\158\004\158\000\000\000\000\006@\000\000\n \000\000\n\208\006@\006@\000\000\r$\":\004\158B\204\004\158\011x\000\000\000\000\000\000\000\000\011\154\000\000\000\000\0072\000\000\b\190\014\004\r6\015\028\r\214\000\000\000\000\011\166\t\002\014<\000\000\000\000\rH\015Z\014\024\000\000\000\000\012\158\000\000\b\188\000\000\015\2065|\004\158\000\000*\246\n\000\000\0002\226\000\000\000\000\000\000\006@\000\000\000\000\011\156\014~\r^\015\150\014h\000\000\000\0004l\011\180\014\216\000\000\000\000\000\0009\194\000\000\000\000\000\000\000\000\000\000\000\000\000\000\011\222\000\000\014\244\r`\005\014\000\000\015\230\015\162\011\238\015\012\000\000\000\000\015 \rn\005\236\000\000\000\000\tp7\016\006\182\000\000\000\000\000\000\tb\014\238\rv\000\000\015\004\tb\000\000\015\222\012*\015N\000\000\000\000\000\000\004\158\000O\000\208\t\020\000\000\000\000\000\000\000\000\015\018\rx\000\000\tl\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\158\015\000\r\128\016\\\015\022\000\0008\180\000\165\r\130\014\234\003\214\0000\r\138\015\162\000\000\016R\030\178\000\000\000\000\031\026\000\000\012T\000\000\004\246\000\000\000\000\000\000\000\000\000\000\000\000B\230\004\158\000\000\016X\031J\000\000\000\000\031\178\000\000\000\248\r\194\016\004\000\000\000\0009\002:\234\015\186\000\000B\246\004\158 \026\000\000\000\000 L\000\000\000\000\012t\000\000\002\162\000\000\000\000\000\000\000\000\000\000\000\000:\252\000\000\000\0009j;\006\015\188\000\000C\n\004\158 \176\000\000\000\000 \228\000\000\000\000\r\204!\024\012\146\000\000\r\208\r\230\003\136\003\210\r\242\b\154\014\006\016\024!\218\012\250\000\000\0140\014D\n*\000\000\005*<\196\000\000\007\234\000\000\014T9N9\182\005t\015\000\005\224\000\000;Z<\146\000\000\002\154\000\000\000\000\002\154\000\000\000\000\002\154\nZ\000\000\011\002\002\154\0166\"^\r(\000\000\002\154\000\000\000\000C\030\000\000\000\000\000\000\002\154\000\000\000\000\r\180\000\000\012\254\005\184\r\212\000\000\014j<\192\r\232\000\000\000\000\000\000\000\000\014\018\000\000\000\000\006*\000\000\002\154C\178\000\000\014\184\002\1549\194\000\000\014&\015\152\014n\016\178\015h\000\000:\006\014>\015\164\000\000\000\000\000\000\014\148\006\190\000\000\000\000\000\000\000\000\000\000\000\000\t\166\014\212\000\000\015\190\000\000\000\000\000\000\000\000\014\236=D\000\000\000\000\000\000\000\000\t\166\000\000\000\000\015\030=j\000\000\000\000\000\000\000\000\000\000\000>\004\200\000\000\000\000\005~\000\000C\200\004\158\000\000\007\214\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015r\014\176\t\220\000>\000\000\024\240\000\000\004\200\000\000\016\186\000\000\000\000\000\000\000\000\000\000\"\130\000\000\000\000\000\000\000\000\000\000\000\000\016b\004\020\n4\014\238\007v\014\178\000\000\003\246\000\000\000\000\000\000\000\000\000\000\000\000\000\000\015\018\t\170\014\180\000\000\b\014\016\196\016|\015$\000\000\000\000\016t\004Z\004\\\000\000\000\000\000\000\014\186\000\000\014\200\002z\000\000\000\000\004\218\003\014\000\000\000\000\000\000\000\000\000\000\019\174\000\000\000\000\bd\bR\000\000\000\000D\000\004\158\004\158\000\000D\024\004\158\t\242\000\000\000\000\000\000\004\158\000\000\000\000\n\004\016\132\015d\000\000\000\000\016x\004\"\000R\000\000\000\000\000\000\000\000\011H\016\196\n\b\016\136\015l\000\000\000\000\016|\bR\003\b\000\000\000\000\000\000\000\000\004\200\000\000\n\178\000\000\000\000\000\000\"\252\000\000#,\000\000\000\000\000\000\000\000\000\000\000\226\000\000\000\000\000\000\007\016\000\151\000\000\000\000\000\000\000\000\000\000\000\020\000\151\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\t&\000\000\000\000\000\000=\164\000\000\004\158\000\000\n^\000\000\000\000\000\000\002\016\000\000\000\000\000\000\003T\000\000\000\000\000\000\000C\000\000\000\000\000\0000\184\005~\000\000\000\000\000|\000\000\000\000\000\000\000\000\004\014\004\194\015\188\004\150\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000'6\000\000\015\148\000\000\000\000\000\000\000\000\005\012\006\174\000\170\002L\000\000\000\000\015\174\003\238\000\000\000\000\000\000\015\206\005\144\000\000\000\000\000\000\000\000"), (16, "\006(\0007\002,\002-\001e\000q\001e\000;\001\031\003\007\001\216\006\156\000\147\006\203\006\189\001\233\001\031\002n\006)\006\214\001\240\006+\001\019\000?\001\244\002o\001\023\006\209\001\023\000@\006,\0069\006\232\005Y\000m\001\"\001\031\006(\002}\002,\002-\001e\0007\005\142\001k\000\196\004\005\000\196\000\200\000\201\000\200\000\201\001\159\001e\002n\006)\0068\007\004\006+\006-\000\147\002\012\002o\000\156\001\016\001\245\004\005\006,\0069\000\196\001\023\001\026\000\200\001\002\000\\\002}\005\229\006o\000`\001\246\002\014\001\003\007\012\002-\001e\007\005\000\147\001\214\000\157\001\233\000\203\004\254\000\203\006.\000d\001\240\006-\002\127\001T\001\244\006\207\001\023\006/\006(\000y\005\231\001\006\006I\001\016\0020\002\027\002\129\000\200\000\200\001\023\001$\001\016\005\001\007'\003\007\005\232\007(\001\023\001$\006+\005\234\006>\000\202\002\025\006\022\006.\0055\005\003\006,\002\127\001\027\001\016\005`\005a\006/\001\245\006?\001\023\001$\0007\001\031\0020\001W\002\129\000\200\007\014\0062\005\004\005q\006\216\001\031\0064\005j\004\019\0056\006\218\0057\006-\006>\000\128\0007\0066\001%\000\129\002\130\002\028\002\136\002\006\005\144\000:\001%\005Y\002\142\006?\001\139\002\132\004\b\0067\006\233\002,\002-\001e\006\185\0062\007\015\0058\002\129\000\200\0064\001.\001%\006.\001l\002\006\002n\002\144\004\011\004\t\0066\000\134\006/\002\130\002o\002\136\006(\003\007\002,\002-\001e\002\142\0009\001\139\002\132\006\186\0067\002}\001\251\004\014\0059\000\200\007*\002n\006)\0068\002\025\006+\000\203\005:\005;\002o\005<\000\203\002\144\000\196\006,\0069\000\200\001\002\002\026\0061\001\016\006(\002}\002,\002-\001e\001\023\001$\003\020\0062\001\016\000\200\001\002\005x\0064\005\177\001\023\001$\002n\006)\0068\000\132\006+\006-\0066\000\151\002o\006\142\005\179\000\135\001\221\006,\0069\0042\002\127\005`\005a\005>\006\220\002}\0067\003\178\005@\005J\002\014\003%\0020\000\150\002\129\000\200\000\196\005i\005t\000\200\001\002\005j\004\019\006.\000\183\001%\006-\002\127\001\182\000\172\006m\000\179\006/\006(\005u\001%\000\178\0041\000=\0020\002\027\002\129\000\200\000\200\002\133\001\031\000\184\003\184\007'\003\007\000\203\007(\001&\001\006\006+\003\245\006>\000\203\000\203\000\174\006.\0055\0010\006,\002\127\002\026\001\031\000\147\002\025\006/\000\152\006?\002\130\005\184\004#\000\188\0020\006\252\002\129\000\200\002\142\0062\001\139\002\132\000\196\001\031\0064\000\200\001\002\0056\006\200\0057\006-\006>\000\203\000\147\0066\006\132\001\233\002\130\002\028\002\136\000\153\002\144\004\000\004\002\004\004\002\142\006?\001\139\002\132\0007\0067\006\253\002,\002-\001e\0046\0062\001\023\0058\003\179\006\181\0064\000\196\001\016\006.\000\200\001\002\002n\002\144\001\023\001\026\0066\005\188\006/\002\130\002o\002\136\006(\001\031\002,\002-\001e\002\142\001\016\001\139\002\132\000\193\0067\002}\001\023\001$\0059\006\154\007)\002n\006)\0068\006\004\006+\003\179\005:\005;\002o\005<\001\016\002\144\000\147\006,\0069\000\152\001\023\001$\0061\006\149\006(\002}\002,\002-\001e\000\211\000\189\002\026\0062\001\016\002\014\003\007\005x\0064\006R\001\023\001$\002n\006)\0068\001(\006+\006-\0066\000\224\002o\006@\004\185\001%\000\228\006,\0069\000\147\002\127\000\181\001\233\005>\002\018\002}\0067\002\027\005@\005J\000\200\001\253\0020\001\016\002\129\000\200\001%\001\023\005t\001\023\001$\003K\006\150\006.\000\200\001\002\006-\002\127\0043\007\000\006<\001\016\006/\006(\005u\001%\000\203\001\023\001$\0020\006\152\002\129\000\200\006\150\002\133\001\236\006\199\000\147\007'\001\220\001\233\007(\003\192\001e\006+\001\240\006>\005\236\003\\\001\244\006.\001\023\003z\006,\002\127\007\001\003\007\002\028\000\200\006/\004\161\006?\002\130\000\200\004\031\000\186\0020\006\186\002\129\000\200\002\142\0062\001\139\002\132\000\241\002\025\0064\002\255\001e\003\180\001%\000\196\006-\006>\000\200\000\201\0066\003\007\002\000\002\130\001\245\002\136\000\249\002\144\001\023\006x\0007\002\142\006?\001\139\002\132\006\184\0067\001Y\002,\002-\001e\006\150\0062\007\024\002-\001e\005\229\0064\003\007\002\001\006.\001\031\000\196\002n\002\144\000\200\000\201\0066\004\\\006/\002\130\002o\002\136\006(\006\140\002,\002-\001e\002\142\006\014\001\139\002\132\003\007\0067\002}\005\231\006p\007\027\007\028\007-\002n\007\030\003\181\005\229\006+\001)\000\194\005\149\002o\006y\005\232\002\144\001\n\006,\007 \005\234\006\017\002\002\0061\006\001\006(\002}\002,\002-\001e\007/\001\r\000\147\0062\005C\001\233\006\019\005\231\0064\0007\007'\003\t\002n\007(\004\165\006z\006+\006-\0066\002\026\002o\003\007\005\232\001\030\006{\006,\0070\005\234\002\127\006|\006}\005\250\006\020\002}\0067\006\141\006\187\006\188\006~\006\127\0020\001`\002\129\000\200\000\203\007\025\001\016\002\129\000\200\006\128\004\019\006.\001\023\001$\006-\002\127\005j\004\019\000\204\003\228\006/\006(\003\007\002\014\006|\006}\006z\0020\004\167\002\129\000\200\001\016\002\133\006~\006\127\006{\007'\001\023\001$\007(\001\016\007#\006+\005\153\006\128\004\019\001\023\001$\006.\004\138\002\029\006,\002\127\002\027\003\007\004}\000\200\006/\002\148\006?\002\130\001\023\003\201\001;\0020\001%\002\129\000\200\002\142\0062\001\139\002\132\003\231\000\147\0064\005M\001\233\0074\000\212\000\196\006-\000\203\000\200\000\201\0066\001B\000\225\002\130\000\234\002\136\004\150\002\144\004\007\003\007\001G\002\142\006?\001\139\002\132\0007\0067\001\016\002,\002-\001e\001V\0062\001\023\001$\001\177\005\229\0064\000\236\002\028\006.\001\239\000\196\002n\002\144\000\200\000\201\0066\004\156\006/\002\130\002o\002\136\006(\006\b\002,\002-\001e\002\142\001\\\001\139\002\132\003\007\0067\002}\005\231\001\031\000\203\004Q\0072\002n\006)\006F\005\229\006+\000\203\003\007\000\203\002o\000\242\005\232\002\144\001\239\006,\0069\005\234\004\168\004\173\0061\005\241\006(\002}\002,\002-\001e\003\007\000\196\001\175\0062\000\200\000\201\000\203\005\231\0064\004\129\007'\002\014\002n\007(\003\245\001\023\006+\006-\0066\001\239\002o\001t\005\232\001\016\000\245\006,\007+\005\234\002\127\001\023\001\026\005\238\005\229\002}\0067\003\b\001\216\001~\002\015\006J\0020\002\027\002\129\000\200\000\200\004\167\001\240\000\203\006\225\004\206\001\244\006.\001\023\006\021\006-\002\127\001\031\001\135\001\239\001 \006/\005\231\0012\004\003\004\002\004\004\005\236\0020\004\246\002\129\000\200\001\016\002\133\002,\002-\001e\005\232\001\023\001$\003\232\006\017\005\234\0013\001\"\006>\005\235\002\014\000\203\006.\001Q\000\250\001\245\002\127\001\134\004\233\006\019\003_\006/\003\245\006?\002\130\002\028\003c\004W\0020\001\246\002\129\000\200\002\142\0062\001\139\002\132\002\014\0029\0064\001G\002\027\007.\001\181\000\200\003`\006\020\006\226\001\193\0066\001\031\001*\002\130\001+\002\136\001%\002\144\003\231\001E\004\240\002\142\006?\001\139\002\132\003\215\0067\004n\002\027\0018\000\200\000\200\0062\005R\004\002\004\004\004D\0064\001\"\000\203\006\227\001\198\001\016\004\r\002\144\006\234\001\023\0066\001\023\001$\002\130\004\027\002\136\006(\002/\002,\002-\001e\002\142\004\020\001\139\002\132\002\028\0067\003\241\004\019\0020\006\137\002\129\000\200\002n\006)\005\005\003\213\006+\001\203\001C\001\031\002o\001]\001 \002\144\000\203\006,\006B\006\235\0055\004I\002\028\003\231\004n\002}\002\014\000\200\001>\004q\001\031\001\139\005\001\001 \001\016\001%\003b\004N\001\"\001F\001\023\001\026\002\014\006\236\006\163\001\016\006-\005\003\0056\005w\0057\001\023\001$\003\223\001\209\005Y\002\027\001\"\002\005\000\200\002\130\006\237\001.\004`\001e\001H\003\007\005\004\002\131\003\227\001\139\002\132\002\027\000\203\003\231\000\200\000\203\006\198\001\226\0058\006.\001*\000\196\0007\002\127\000\200\000\201\006S\001\031\006/\003\231\005\026\006v\004\237\001\139\006\176\0020\004\144\002\129\000\200\001*\001\016\001u\001\023\001%\004\238\001\228\001\023\001$\005\006\001\243\001\016\0059\006E\006\017\001\"\002\028\001\023\001$\002\014\002\004\005:\005;\003\007\005<\002,\002-\001e\006?\006\019\001\016\001.\002\028\003\007\004\025\001\016\001\023\001$\0062\003\007\002n\001\023\001\026\0064\001\016\003\007\0045\005x\002o\002\027\001\023\001$\000\200\0066\006d\006\020\002\130\003\206\002\136\005`\005a\002}\005\224\001>\002\142\000\203\001\139\002\132\003\007\0067\001%\005>\003\202\003\007\005b\005r\005@\005J\001\031\005j\004\019\001 \001>\006\187\006\188\002&\005t\002\144\001\016\001%\003\007\004?\001\016\005y\001\023\001$\002\014\001.\001\023\001\026\001H\004E\005u\005j\004\019\001\"\006\162\005\007\006\240\002\028\002,\002-\001e\004J\000m\002)\001.\004k\004\019\001H\002\127\003\245\005Y\004[\001\204\002n\002\027\003\007\001\216\000\200\001\206\002\n\0020\002o\002\129\000\200\004O\0027\001\240\003\158\004n\005\015\001\244\000\200\001\023\003\007\002}\001%\001*\002F\001\031\004\237\001\031\005!\001\031\001 \005\211\001 \004g\004\177\004\019\003\007\005\\\004\238\002\133\003\245\001\216\004\245\002I\002\007\005f\004\002\004\004\004\240\001.\003\007\001\240\001\"\001\016\001\"\001\244\001\"\001\023\001\245\001\023\001$\002\028\000\203\001\213\002,\002-\001e\002\130\000\203\002\136\004s\005Y\001\246\005Y\000m\002\142\002\014\001\139\002\132\002n\002\127\004n\004\240\006\241\000\200\001\139\002O\002o\004v\005n\004\002\004\004\0020\006\248\002\129\000\200\001\245\001*\002\144\001*\002}\005`\005a\006^\004~\001>\002\027\003\245\002[\000\200\001\246\006\178\001%\006\192\005V\004\019\005b\005r\004\130\003\007\004\228\005j\004\019\000\200\002\133\001\016\000\203\001\016\002X\001\016\002^\001\023\001$\001\023\001$\001\023\001$\006\250\001\031\001.\004\242\001 \001H\000\200\003\007\005\219\002'\002*\000\200\006\130\002b\001\139\002\130\003\007\002\136\003\007\006\171\004\002\004\004\002\127\002\142\002g\001\139\002\132\003\007\001\"\002\028\001\031\003\n\005\243\001 \0020\000\200\002\129\000\200\005`\005a\005`\005a\001>\0028\001>\005Y\002\144\001%\002\141\001%\004\145\001%\006\195\005b\005r\005b\005r\001\"\005j\004\019\005j\004\019\002\196\001\016\002\220\002G\002\133\002\227\002J\001\023\001\026\001*\000\203\000\203\001.\004\162\001.\001\216\001.\001H\001\217\001H\006t\004\019\004\166\003\000\004\220\001\240\002,\002-\001e\001\244\001\016\001\023\002\130\006\206\002\136\003o\001\023\001\026\001*\001\016\002\142\002n\001\139\002\132\000\203\001\023\001$\002P\002c\002o\002,\002-\001e\002h\000\196\006i\002\192\000\200\000\201\003\214\004\237\003\220\002}\002\144\003\007\002n\000\203\003\235\001\016\000\203\001\245\003w\004\238\002o\001\023\001$\004\239\002,\002-\001e\003\172\003\007\003\007\006W\001\246\005\229\002}\005`\005a\004\237\001\016\001>\002n\003\252\003\007\003\254\001\023\001$\001%\001G\002o\004\238\006\174\006\175\003\182\004\244\004 \005j\004\019\003\204\000\203\000\203\004\016\002}\005\231\003\007\000\203\004\021\0044\000\203\0011\002\127\000\203\003\007\000\203\001.\003\219\001%\001H\005\232\000\203\004:\004\253\0020\005\234\002\129\000\200\001\016\005\245\004A\002,\002-\001e\001\023\001\026\002\127\003\221\001\187\001e\005\002\005*\004G\004Z\003\007\001.\002n\000\203\0020\000\203\002\129\000\200\001\031\0052\002o\005\030\002\133\004_\001f\002A\004\026\001h\001i\002\127\004j\003\007\000\203\002}\002,\002-\001e\000\203\000\203\004r\005?\0020\003\234\002\129\000\200\001\"\002\133\003\007\005G\002n\002\130\000\203\002\136\004\237\004u\004\015\004\023\002o\002\142\000\203\001\139\002\132\003\007\003\212\004|\004\238\003\148\003\001\003\002\005\014\002}\000\203\000\203\002\133\002\130\004@\003\026\004\128\005^\0049\001\216\002\144\002\142\001\238\001\139\002\132\000\203\004\134\005 \004;\001\240\004\140\002\127\000\203\001\244\004>\001\023\004\152\001\127\005\143\004M\002\130\000\203\002\136\0020\002\144\002\129\000\200\004C\002\142\001n\001\139\002\132\000\200\003\007\005\178\004L\000\203\001\016\002,\002-\001e\004H\004\171\001\023\005#\004K\000\203\004Y\002\127\005\204\004\176\002\144\004^\002n\001\245\002\133\003\007\003\151\003\156\000\203\0020\002o\002\129\000\200\004\181\004f\004\191\004e\001\246\000\203\004i\003\209\004\197\000\203\002}\002,\002-\001e\004\208\000\203\002,\002-\001e\002\130\000\196\002\136\004\223\000\200\000\201\001\129\002n\002\142\002\133\001\139\002\132\002n\005$\001\130\002o\001\139\001l\005\215\004\241\002o\003\195\000\203\004\227\004t\004\238\003\147\005)\002}\005&\000\203\002\144\005\229\002}\002,\002-\001e\002\130\004\127\002\136\001.\005\249\004\248\003\007\000\203\002\142\000\203\001\139\002\132\002n\002\127\005\t\000\203\004{\001d\001e\004\139\002o\000\203\003\007\005\019\005\231\0020\003\142\002\129\000\200\000\203\004\133\002\144\003\007\002}\005,\005B\004\135\001f\001v\005\232\001h\001i\005L\004\159\005\234\000\203\005X\005l\006\007\000\203\002\127\005|\005\130\003\007\004\147\002\127\005\134\002\133\006(\004\158\003\138\004\153\0020\003\007\002\129\000\200\004\157\0020\000\203\002\129\000\200\004\170\004\175\005\018\006\005\003\007\006)\000\203\004\180\006+\001w\004\183\001x\002L\005\162\002\130\000\203\003\026\006,\005\202\006\t\006\006\002\127\002\142\002\133\001\139\002\132\000\203\000\203\002\133\006\r\004\187\005\207\004\195\0020\000\203\002\129\000\200\005\246\000\203\000\203\001\127\004\202\004\213\000\203\000\203\002\144\006-\005\212\000\203\005\017\006\018\002\130\001n\002\136\005\n\000\200\002\130\005\011\002\136\002\142\006\030\001\139\002\132\003\141\002\142\002\133\001\139\002\132\005\242\002,\002-\001e\006%\002,\002-\001e\000\203\005\016\005\218\003\007\006.\000\203\002\144\000\203\002n\005\020\005\226\002\144\002n\006/\005\021\003\007\002o\002\130\000\203\002\136\002o\006\011\003\131\006 \000\203\002\142\003t\001\139\002\132\002}\002,\002-\001e\002}\000\203\0054\001\129\0060\000\196\005-\003\007\000\200\000\201\003\007\001\130\002n\001\139\001l\002\144\002,\002-\001e\0061\002o\005.\000\203\006]\006w\006\131\003l\001\216\006\145\0062\001\248\002n\000\203\002}\0064\006\147\005\229\001\240\0063\002o\000\203\001\244\003\007\001\023\0066\001\031\003\007\0053\005\030\003d\006:\000\203\002}\000\203\001\031\002\127\005I\001 \005E\002\127\0067\002,\002-\001e\005F\005\231\003\007\0020\005H\002\129\000\200\0020\001\"\002\129\000\200\006C\002n\005s\006\136\003\007\005\232\001\"\001\245\005W\002o\005\234\000\203\000\203\000\203\006\026\002z\000\203\002\127\005[\005]\003\007\001\246\002}\000\203\002\133\005_\005k\005{\002\133\0020\005}\002\129\000\200\005~\005\131\006\180\002\127\005\135\005\139\006\194\005 \005\157\002,\002-\001e\005\164\005\168\005\192\0020\001*\002\129\000\200\002\130\005\213\002\136\005\237\002\130\002n\002\136\007!\002\142\002\133\001\139\002\132\002\142\002o\001\139\002\132\005\247\006'\001\016\002\135\007,\006!\006\"\006&\001\023\005#\002}\001\016\002\133\002\127\0065\002\144\006\\\001\023\001$\002\144\0071\002\130\006g\002\136\006r\0020\006\134\002\129\000\200\002\142\006\135\001\139\002\132\006\139\006\179\006\183\006\193\006\197\007\019\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002\144\002,\002-\001e\000\000\002\133\000\000\000\000\000\000\005$\000\000\001-\001\216\000\000\000\000\001\250\002n\002\127\001%\002\144\000\000\004\238\001\240\005(\002o\005&\001\244\000\000\001\023\0020\002\150\002\129\000\200\002\130\000\000\002\136\001.\002}\000\000\000\000\000\000\002\142\000\000\001\139\002\132\001.\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\002\193\001e\000\000\000\000\000\000\000\000\000\000\002\133\002n\000\000\002\144\000\000\000\000\001\245\000\000\000\000\002o\000\000\000\000\000\000\002\236\001v\002\149\001h\001i\000\000\000\000\001\246\000\000\002}\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\136\000\000\000\000\000\000\000\000\002\127\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\241\003\001\003\002\001\216\002\144\000\000\002\022\000\000\000\000\000\000\002,\002-\001e\001\240\000\000\000\000\000\000\001\244\000\000\001\023\000\000\000\000\000\000\000\000\002\133\002n\002\127\000\000\002,\002-\001e\000\000\001\127\002o\000\000\000\000\000\000\000\000\0020\002\201\002\129\000\200\000\000\002n\001n\000\000\002}\000\200\000\000\000\000\000\000\002o\002\130\000\000\002\136\000\000\000\000\002\212\001\245\000\000\002\142\000\000\001\139\002\132\002}\002,\002-\001e\000\000\000\000\002\133\000\000\001\246\000\000\000\000\000\000\001\216\003\005\003\006\002<\002n\001\216\000\000\002\144\003\225\000\000\001\240\000\000\002o\000\000\001\244\001\240\001\023\000\000\002\224\001\244\000\000\001\023\002\130\000\000\002\136\002}\000\000\000\000\001\129\002\127\002\142\000\000\001\139\002\132\000\000\000\000\001\130\000\000\001\139\001l\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\127\000\000\000\000\000\000\000\000\000\000\002\144\000\000\001\245\000\000\000\000\000\000\0020\001\245\002\129\000\200\000\000\002,\002-\001e\001\216\000\000\001\246\004(\000\000\000\000\002\133\001\246\000\000\000\000\001\240\000\000\002n\000\000\001\244\000\000\001\023\002\127\000\000\000\000\002o\000\000\000\000\000\000\002\133\001\216\002\231\000\000\004,\0020\000\000\002\129\000\200\002}\002\130\001\240\002\136\000\000\000\000\001\244\000\000\001\023\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002,\002-\001e\002\130\000\000\002\136\001\245\000\000\000\000\000\000\000\000\002\142\002\133\001\139\002\132\002n\002\144\000\000\000\000\000\000\001\246\000\000\000\000\002o\002,\002-\001e\000\000\000\000\002\234\000\000\001\245\000\000\000\000\002\144\000\000\002}\000\000\001\031\002n\002\130\001 \002\136\002\127\000\000\001\246\000\000\002o\002\142\000\000\001\139\002\132\000\000\002\240\000\000\0020\000\000\002\129\000\200\000\000\002}\002,\002-\001e\000\000\001\"\000\000\000\000\000\000\000\000\000\000\002\144\001\216\000\000\000\000\004/\002n\002,\002-\001e\000\000\000\000\001\240\000\000\002o\000\000\001\244\002\133\001\023\000\000\002\243\000\000\002n\000\000\000\000\002\127\000\000\002}\000\000\000\000\002o\002,\002-\001e\000\000\000\000\003\r\0020\001*\002\129\000\200\000\000\000\000\002}\000\000\002\130\002n\002\136\000\000\002\127\000\000\000\000\000\000\002\142\002o\001\139\002\132\001\245\000\000\000\000\003\017\0020\000\000\002\129\000\200\000\000\000\000\002}\001\016\002\133\000\000\001\246\000\000\000\000\001\023\001$\002\144\000\000\001\216\000\000\000\000\004=\000\000\000\000\000\000\000\000\002\127\000\000\001\240\000\000\000\000\000\000\001\244\002\133\001\023\000\000\000\000\002\130\0020\002\136\002\129\000\200\002\127\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\006\158\002\130\000\000\002\136\000\000\000\000\002\127\001%\002\144\002\142\002\133\001\139\002\132\001\245\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002,\002-\001e\000\000\002\133\001\246\000\000\000\000\000\000\000\000\002\144\000\000\001.\000\000\000\000\002n\002\130\000\000\002\136\000\000\000\000\000\000\001\031\002o\002\142\001 \001\139\002\132\002\133\000\000\000\000\000\000\002\130\003\023\002\136\000\000\002}\002,\002-\001e\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002\144\000\000\001\"\000\000\000\000\002n\002,\002-\001e\002\130\001<\002\136\000\000\002o\000\000\000\000\002\144\002\142\000\000\001\139\002\132\002n\000\000\003\028\000\000\000\000\002}\000\000\000\000\002o\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\003\030\002\144\000\000\002}\000\000\000\000\001*\002n\000\000\002\127\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\003\"\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\002\127\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\002,\002-\001e\0020\000\000\002\129\000\200\004\216\000\000\000\000\002\130\000\000\003\026\000\000\000\000\002n\002\127\001>\002\142\002\133\001\139\002\132\004\219\002o\001%\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\003*\000\000\002\133\002}\000\000\000\000\000\000\001*\002\144\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\026\000\000\001.\000\000\000\000\001D\002\142\000\000\001\139\002\132\000\000\002\133\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\001\016\002\142\000\000\001\139\002\132\000\000\001\023\001$\002\144\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\002\130\000\000\003\026\000\000\000\000\000\000\002\144\002\127\002\142\000\000\001\139\002\132\002n\002,\002-\001e\000\000\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\002n\000\000\0030\002\144\000\000\002}\001>\000\000\002o\002,\002-\001e\001\216\001%\000\000\004\137\000\000\004\221\0036\000\000\000\000\002}\001\240\002\133\002n\000\000\001\244\000\000\001\023\000\000\000\000\000\000\002o\002,\002-\001e\001\216\000\000\003=\004\149\001.\000\000\000\000\001H\000\000\002}\001\240\000\000\002n\000\000\001\244\002\130\001\023\003\026\000\000\000\000\002o\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\003N\001\245\000\000\002}\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\001\246\002\144\000\000\000\000\002n\002,\002-\001e\000\000\000\000\001\245\0020\002o\002\129\000\200\000\000\000\000\000\000\003B\000\000\002n\000\000\000\000\002\127\001\246\002}\000\000\002\133\002o\000\000\000\000\000\000\000\000\000\000\003G\0020\000\000\002\129\000\200\000\000\000\000\002}\000\000\002\133\000\000\000\000\000\000\002\127\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\026\000\000\0020\000\000\002\129\000\200\002\142\000\000\001\139\002\132\002\133\000\000\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002\130\0020\002\136\002\129\000\200\002\127\000\000\002\144\002\142\000\000\001\139\002\132\000\000\000\000\002,\002-\001e\0020\000\000\002\129\000\200\002,\002-\001e\002\130\000\000\003\026\000\000\000\000\002n\000\000\002\144\002\142\002\133\001\139\002\132\002n\002o\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\003S\001\216\002\133\002}\004\155\000\000\000\000\003X\002\144\000\000\002}\001\240\000\000\000\000\002\130\001\244\002\136\001\023\000\000\002,\002-\001e\002\142\001\216\001\139\002\132\004\164\000\000\000\000\000\000\002\130\000\000\002\136\001\240\002n\000\000\000\000\001\244\002\142\001\023\001\139\002\132\002o\001\216\000\000\002\144\004\172\000\000\000\000\000\000\000\000\000\000\003g\001\240\000\000\002}\001\245\001\244\000\000\001\023\000\000\002\144\002\127\000\000\002,\002-\001e\000\000\000\000\002\127\001\246\000\000\000\000\000\000\0020\000\000\002\129\000\200\001\245\002n\000\000\0020\000\000\002\129\000\200\000\000\000\000\002o\000\000\000\000\000\000\000\000\001\246\001\216\000\000\000\000\006b\003j\001\245\000\000\002}\000\000\000\000\001\240\000\000\000\000\002\133\001\244\000\000\001\023\000\000\000\000\001\246\002\133\002\127\000\000\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002n\000\000\002\130\000\000\003\026\000\000\000\000\000\000\002o\002\130\002\142\003\026\001\139\002\132\003p\000\000\001\245\002\142\000\000\001\139\002\132\002}\002,\002-\001e\000\000\002\133\002\127\000\000\000\000\001\246\000\000\000\000\002\144\000\000\000\000\000\000\002n\000\000\0020\002\144\002\129\000\200\000\000\000\000\002o\002,\002-\001e\000\000\000\000\003r\000\000\000\000\002\130\000\000\003\026\000\000\002}\000\000\000\000\002n\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002o\001\031\002\133\000\000\001 \000\000\003|\000\000\000\000\000\000\000\000\002\127\000\000\002}\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\001\"\000\000\002\130\000\000\003\026\004\231\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\002\127\000\000\000\000\000\000\002,\002-\001e\002\133\000\000\000\000\000\000\000\000\0020\002\144\002\129\000\200\000\000\000\000\000\000\002n\000\000\000\000\000\000\001*\002\127\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\003\133\000\000\002\130\0020\002\136\002\129\000\200\002}\000\000\000\000\002\142\002\133\001\139\002\132\000\000\000\000\000\000\002,\002-\001e\001\016\000\000\002,\002-\001e\000\000\001\023\001$\001\031\000\000\000\000\001 \002n\002\144\000\000\002\133\000\000\002n\000\000\002\130\002o\002\136\000\000\000\000\000\000\002o\003\136\002\142\000\000\001\139\002\132\003\150\000\000\002}\000\000\001\"\000\000\000\000\002}\000\000\000\000\000\000\000\000\002\130\000\000\002\136\002\127\002,\002-\001e\002\144\002\142\001>\001\139\002\132\000\000\000\000\000\000\0020\001%\002\129\000\200\002n\004\236\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\144\000\000\003\153\000\000\001*\000\000\000\000\000\000\000\000\002}\000\000\000\000\001.\000\000\000\000\001H\002\133\000\000\002\127\000\000\000\000\000\000\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\001\016\0020\000\000\002\129\000\200\002n\001\023\001$\000\000\000\000\002\130\000\000\002\136\002o\002,\002-\001e\000\000\002\142\000\000\001\139\002\132\000\000\003\163\000\000\000\000\002}\000\000\002\133\002n\000\000\000\000\000\000\002\133\002\127\000\000\000\000\002o\000\000\000\000\000\000\002\144\000\000\000\000\000\000\000\000\0020\003\168\002\129\000\200\002}\000\000\001>\000\000\000\000\000\000\002\130\000\000\002\136\001%\000\000\002\130\000\000\002\136\002\142\000\000\001\139\002\132\000\000\002\142\000\000\001\139\002\132\000\000\000\000\002,\002-\001e\002\133\000\000\000\000\000\000\000\000\000\000\000\000\002\127\001.\002\144\000\000\001?\002n\000\000\002\144\000\000\000\000\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\003\217\000\000\002\130\000\000\002\136\002\127\000\000\002}\000\000\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\002n\000\000\000\000\000\000\002\144\000\000\000\000\000\000\002o\000\000\000\000\000\000\000\000\000\000\003\230\000\000\000\000\000\000\000\000\000\000\002\133\002}\000\000\000\000\002\130\000\000\003\026\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\0020\003\026\002\129\000\200\002n\000\000\002\144\002\142\000\000\001\139\002\132\000\000\002o\000\000\002\193\001e\000\000\000\000\004\018\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\002\144\002\127\002\133\000\000\002\236\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\136\000\000\000\000\000\000\001d\001e\002\142\000\000\001\139\002\132\000\000\000\000\000\000\002\133\002\241\003\001\003\002\000\000\000\000\000\000\000\000\000\000\002\127\000\000\001f\001v\000\000\001h\001i\002\144\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\002\130\000\000\002\136\000\000\000\000\001\127\004\"\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\002\133\001w\002n\001x\002L\000\000\002\144\000\000\000\000\000\000\002o\000\000\002,\002-\001e\000\000\004U\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\003\005\004\024\002n\002\130\000\000\002\136\000\000\001\127\000\000\000\000\002o\002\142\000\000\001\139\002\132\000\000\005\138\000\000\000\000\001n\000\000\000\000\000\200\002}\000\000\000\000\000\000\001\129\000\000\000\000\003\141\000\000\000\000\000\000\002\144\001\130\000\000\001\139\001l\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002o\002,\002-\001e\000\000\000\000\005\141\0020\000\000\002\129\000\200\000\000\000\000\002}\000\000\001\031\002n\001\129\001 \000\000\002\127\000\000\000\000\000\000\002o\001\130\000\000\001\139\001l\000\000\005\156\000\000\0020\000\000\002\129\000\200\000\000\002}\000\000\002\133\000\000\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\248\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\006\144\002\130\002n\002\136\000\000\000\000\002\127\000\000\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\005\159\000\000\0020\001*\002\129\000\200\000\000\002}\000\000\000\000\002\130\000\000\002\136\000\000\002\127\000\000\002\144\000\000\002\142\000\000\001\139\002\132\000\000\002,\002-\001e\0020\000\000\002\129\000\200\000\000\000\000\000\000\001\016\002\133\000\000\000\000\000\000\002n\001\023\001$\002\144\000\000\000\000\000\000\000\000\002o\000\000\002,\002-\001e\000\000\005\172\000\000\000\000\000\000\000\000\000\000\002\133\002}\000\000\000\000\002\130\002n\002\136\000\000\002\127\000\000\000\000\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\005\175\0020\000\000\002\129\000\200\000\000\000\000\002}\001>\002\130\000\000\002\136\000\000\000\000\000\000\001%\002\144\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\000\000\002n\000\000\000\000\000\000\002\144\002\127\001.\000\000\002o\003\255\000\000\002,\002-\001e\005\196\000\000\000\000\0020\000\000\002\129\000\200\002}\000\000\000\000\000\000\002\130\002n\002\136\000\000\000\000\002\127\000\000\000\000\002\142\002o\001\139\002\132\002,\002-\001e\005\199\000\000\0020\000\000\002\129\000\200\000\000\002}\000\000\002\133\000\000\000\000\002n\000\000\000\000\000\000\002\144\000\000\000\000\000\000\002o\000\000\000\000\000\000\001\031\000\000\005\203\001 \000\000\000\000\0012\000\000\000\000\002}\002\133\000\000\000\000\002\130\000\000\002\136\002\127\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\0013\001\"\0020\000\000\002\129\000\200\000\000\001O\000\000\000\000\000\000\000\000\002\130\000\000\002\136\000\000\002\127\000\000\002\144\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\127\002\144\001*\002\193\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002\133\0018\002\130\000\000\002\136\002\236\001v\000\000\001h\001i\002\142\000\000\001\139\002\132\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\002\133\000\000\002\130\000\000\002\136\000\000\000\000\002\144\000\000\000\000\002\142\000\000\001\139\002\132\001\031\000\000\000\000\001 \000\000\000\000\000\000\002\241\003\001\003\002\000\000\002\193\001e\000\000\002\130\000\000\002\136\000\000\000\000\002\144\000\000\000\000\002\142\000\000\001\139\002\132\001>\001\"\000\000\001d\001e\002\236\001v\001%\001h\001i\000\000\001F\000\000\001\127\000\000\000\000\000\000\000\000\000\000\002\144\000\000\000\000\000\000\001f\001v\001n\001h\001i\000\200\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\006l\002\241\003\001\003\002\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\003\005\005\214\000\000\000\000\000\000\002,\002-\001e\001w\000\000\001x\002L\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\002n\001\127\001\023\001$\000\000\000\000\000\000\001\129\002o\002,\002-\001e\000\000\001n\006\210\001\130\000\200\001\139\001l\001\127\000\000\002}\000\000\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\001n\002o\000\000\000\200\000\000\000\000\000\000\006\212\000\000\001d\001e\003\141\000\000\000\000\002}\003\005\005\248\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\004\249\001f\001v\004\252\001h\001i\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002\127\001\130\001.\001\139\001l\001H\000\000\000\000\000\000\000\000\000\000\001\129\0020\000\000\002\129\000\200\000\000\000\000\000\000\001\130\000\000\001\139\001l\001w\002\127\001x\001\143\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\002\133\000\000\000\000\000\000\000m\001f\001v\000\000\001h\001i\001\127\001d\001e\000\000\000\000\001\184\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\002\133\000\200\000\000\000\000\002\130\000\000\002\136\001f\001v\000\000\001h\001i\002\142\000\000\001\139\002\132\000\000\001\169\000\000\000\000\000\000\000\000\001d\001e\001w\000\000\001x\001\172\002\130\000\000\002\136\000\000\000\000\000\000\000\000\002\144\002\142\000\000\001\139\002\132\001d\001e\001f\001v\000\000\001h\001i\000\000\000\000\000\000\001w\000\000\001x\001\172\000\000\001\127\001d\001e\001\129\002\144\001f\001v\000\000\001h\001i\000\000\001\130\001n\001\139\001l\000\200\000\000\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\001\127\000\000\000\000\000\000\001w\001\174\001x\002L\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\002,\002-\001e\001w\000\000\001x\002T\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\001\127\000\000\000\000\001w\000\000\001x\001\172\002o\000\000\000\000\000\000\001\129\001n\000\000\000\000\000\200\000\000\000\000\001\127\001\130\002}\001\139\001l\003\137\000\000\000\000\000\000\002,\002-\001e\001n\000\000\000\000\000\200\001\127\000\000\000\000\001\129\000\000\000\000\000\000\000\000\002n\000\000\000\000\001\130\001n\001\139\001l\000\200\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002W\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\001\129\000\000\002,\002-\001e\000\000\000\000\002\127\001\130\000\000\001\139\001l\002n\000\000\000\000\000\000\000\000\002n\001\129\0020\002o\002\129\000\200\000\000\000\000\002o\001\130\000\000\001\139\001l\000\000\000\000\000\000\002}\001\129\000\000\000\000\000\000\002}\000\000\000\000\000\000\001\130\000\000\001\139\001l\000\000\000\000\000\000\000\000\002\127\002\133\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002n\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\130\000\000\003\011\000\000\000\000\000\000\000\000\000\000\002\142\002}\001\139\002\132\000\000\002\127\000\000\002\133\000\000\000\000\002\127\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\0020\002\144\002\129\000\200\002n\000\000\000\000\002,\002-\001e\000\000\000\000\002o\002\130\000\000\002\138\000\000\000\000\000\000\000\000\000\000\002\142\002n\001\139\002\132\002}\000\000\002\133\000\000\000\000\002o\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002}\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\130\000\000\002\140\000\000\000\000\002\130\000\000\002\145\002\142\000\000\001\139\002\132\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\006(\000\000\000\000\002\133\000\000\002\127\000\000\002\144\000\000\002,\002-\001e\002\144\000\000\000\000\000\000\000\000\0020\007\030\002\129\000\200\006+\000\000\002\127\002n\002,\002-\001e\000\000\000\000\006,\002\130\002o\002\152\000\000\0020\000\000\002\129\000\200\002\142\002n\001\139\002\132\000\000\000\000\002}\000\000\000\000\002o\002\133\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\006-\000\000\002}\002\144\000\000\000\000\002n\000\000\002\133\000\000\000\000\000\000\000\000\000\000\002o\000\000\000\000\000\000\002\130\000\000\002\154\000\000\000\000\000\000\000\000\000\000\002\142\002}\001\139\002\132\000\000\000\000\000\000\000\000\006.\000\000\002\130\000\000\002\156\000\000\000\000\000\000\000\000\006/\002\142\002\127\001\139\002\132\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\000\000\007\031\000\000\000\000\002\144\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\000\000\0061\002n\000\000\000\000\002\127\000\000\000\000\002\133\000\000\002o\0062\002,\002-\001e\000\000\0064\0020\000\000\002\129\000\200\000\000\000\000\002}\002\133\000\000\0066\002n\002,\002-\001e\000\000\000\000\000\000\000\000\002o\002\130\000\000\002\158\000\000\000\000\000\000\0067\002n\002\142\000\000\001\139\002\132\002}\002\133\000\000\002o\002\130\000\000\002\160\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002}\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\162\000\000\000\000\002\127\002\144\000\000\002\142\000\000\001\139\002\132\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\002\127\002\144\000\000\000\000\000\000\002o\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\000\000\002}\002\133\000\000\002n\000\000\002,\002-\001e\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002}\000\000\002\133\000\000\002o\002\130\000\000\002\164\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\002}\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\166\000\000\000\000\002\127\002\144\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\002\130\0020\002\168\002\129\000\200\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\127\002\144\000\000\002\133\000\000\002n\000\000\002,\002-\001e\000\000\000\000\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002n\002,\002-\001e\002}\002\133\000\000\000\000\002o\002\130\000\000\002\170\000\000\000\000\000\000\000\000\002n\002\142\000\000\001\139\002\132\002}\002\133\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\172\000\000\002}\000\000\000\000\002\144\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\174\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\002\127\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\127\002\144\002,\002-\001e\000\000\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\127\002n\000\000\000\000\000\000\002n\000\000\001\031\000\000\002o\005\030\002\133\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002}\002,\002-\001e\002}\000\000\002\133\000\000\000\000\000\000\000\000\000\000\001\"\000\000\000\000\000\000\002n\002\130\000\000\002\176\000\000\000\000\002\133\000\000\002o\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\178\002}\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\002\144\000\000\002\130\000\000\002\180\000\000\000\000\005 \000\000\000\000\002\142\002\127\001\139\002\132\000\000\002\127\000\000\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\000\000\000\000\002\144\002,\002-\001e\001\016\002,\002-\001e\000\000\000\000\001\023\005#\000\000\000\000\000\000\002\127\002n\000\000\000\000\000\000\002n\000\000\002\133\000\000\002o\000\000\002\133\0020\002o\002\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002\182\000\000\002\130\000\000\002\184\000\000\002\142\002\133\001\139\002\132\002\142\005$\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\238\000\000\005'\000\000\005&\000\000\002\144\000\000\000\000\000\000\002\144\000\000\002\130\000\000\002\186\001.\000\000\000\000\000\000\000\000\002\142\002\127\001\139\002\132\000\000\002\127\000\000\000\000\000\000\001d\001e\000\000\000\000\0020\000\000\002\129\000\200\0020\002\210\002\129\000\200\000\000\000\000\002\144\000\000\000\000\002\213\001d\001e\001f\002\214\000\000\001h\001i\000\000\000\000\002\210\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\213\002\133\000\000\001f\002\214\002\133\001h\001i\000\000\002,\002-\001e\000\000\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002n\000\000\000\000\000\000\002n\002\130\000\000\002\188\002o\002\130\000\000\002\190\002o\002\142\000\000\001\139\002\132\002\142\000\000\001\139\002\132\002}\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\000\000\001m\002\144\000\000\000\000\000\000\002\144\000\000\000\000\000\000\000\000\000\000\002n\001n\000\000\000\000\000\200\000\000\000\000\001m\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\002}\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\127\000\000\002\215\000\000\002\127\000\000\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\002\215\002n\002\217\000\000\000\000\000\000\000\000\001\129\000\000\002o\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\002\216\000\000\002}\000\000\002\133\001\129\002\127\000\000\002\133\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\0020\000\000\002\129\000\200\002,\002-\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003.\000\000\002\130\002n\0034\000\000\002\142\000\000\001\139\002\132\002\142\002o\001\139\002\132\000\000\000\000\002\133\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\002\127\000\000\002\144\002,\002-\001e\002\144\002,\002-\001e\000\000\000\000\0020\000\000\002\129\000\200\000\000\002\130\002n\003:\000\000\000\000\002n\000\000\000\000\002\142\002o\001\139\002\132\000\000\002o\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\002,\002-\001e\002}\002\133\000\000\000\000\000\000\002\144\000\000\000\000\001\031\000\000\000\000\001 \002n\002\127\000\000\002,\002-\001e\000\000\000\000\002o\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002\130\002n\003@\000\000\002}\000\000\001\"\000\000\002\142\002o\001\139\002\132\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\002\127\000\000\002\133\000\000\002\127\002\144\002,\002-\001e\000\000\000\000\000\000\0020\000\000\002\129\000\200\0020\000\000\002\129\000\200\000\000\002n\000\000\001*\000\000\000\000\000\000\000\000\000\000\002o\002\130\000\000\003E\000\000\000\000\000\000\000\000\002\127\002\142\000\000\001\139\002\132\002}\000\000\002\133\000\000\000\000\000\000\002\133\0020\000\000\002\129\000\200\001\016\000\000\002\127\002,\002-\001e\001\023\001$\002\144\000\000\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\002n\002\130\000\000\003J\000\000\002\130\000\000\003Q\002o\002\142\002\133\001\139\002\132\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\002}\000\000\000\000\000\000\000\000\000\000\000\000\002\133\000\000\002\127\000\000\002\144\000\000\001>\000\000\002\144\000\000\002\130\000\000\003V\001%\0020\000\000\002\129\000\200\002\142\000\000\001\139\002\132\000\000\000\000\001d\001e\000\000\000\000\002\130\000\000\003[\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\001.\002\144\000\000\001\225\001f\001v\002\133\001h\001i\000\000\000\000\000\000\002\127\000\000\000\000\002,\002-\001e\000\000\002\144\000\000\000\000\000\000\000\000\0020\000\000\002\129\000\200\000\000\000\000\002n\000\000\000\000\000\000\002\130\000\000\003^\000\000\002o\000\000\001\187\001e\002\142\000\000\001\139\002\132\000\000\001w\000\000\001x\002L\002}\000\000\001d\001e\000\000\002\133\000\000\000\000\000\000\001f\002A\000\000\001h\001i\002\144\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001v\000\000\001h\001i\001\127\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\144\000\000\000\000\000\000\001n\000\000\002\142\000\200\001\139\002\132\000\000\000\000\000\000\000\000\000\000\003\140\003\148\003\001\003\002\000\000\001d\001e\000\000\000\000\002\127\000\000\000\000\000\000\000\000\002\144\001w\000\000\001x\007\b\000\000\007\n\0020\000\000\002\129\000\200\001f\001v\000\000\001h\001i\000\000\000\000\000\000\001\127\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\0012\000\000\000\000\001n\001\127\000\000\000\200\001\129\000\000\000\000\000\000\002\133\000\000\000\000\000\000\001\130\001n\001\139\001l\000\200\0013\001\"\000\000\000\000\000\000\000\000\001w\0014\001x\006M\000\000\000\000\003\155\000\000\000\000\000\000\000\000\000\000\000\000\002\130\000\000\003\146\000\000\000\000\000\000\000\000\000\000\002\142\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\001\031\001\127\000\000\001 \000\000\000\000\0012\001\129\001*\000\000\000\000\000\000\000\000\001n\002\144\001\130\000\200\001\139\001l\000\000\001\129\000\000\000\000\000\000\000\000\0018\0013\001\"\001\130\000\000\001\139\001l\000\000\001M\000\000\000\000\000\000\000\000\001\016\001d\001e\000\000\000\000\000\000\001\023\001$\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\001f\001v\001*\001h\001i\001\129\000\000\001f\001v\000\000\001h\001i\000\000\001\130\000\000\001\139\001l\000\000\000\000\0018\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\001\016\001F\001w\000\000\001x\001\176\001\023\001$\000\000\000\000\000\000\001w\000\000\001x\001\164\000\000\000\000\000\000\001w\000\000\001x\001\161\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\001\031\000\000\000\000\005\030\001\127\000\000\000\000\001n\001d\001e\000\200\001\127\000\000\000\000\001>\000\000\001n\000\000\000\000\000\200\000\000\001%\000\000\001n\000\000\001F\000\200\001\"\001f\001v\000\000\001h\001i\001d\001e\000\000\0055\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\001f\001v\000\000\001h\001i\001f\001v\000\000\001h\001i\000\000\0056\000\000\0057\001\129\000\000\000\000\005 \001w\000\000\001x\001z\001\130\001\129\001\139\001l\000\000\000\000\000\000\000\000\001\129\001\130\000\000\001\139\001l\000\000\001d\001e\001\130\000\000\001\139\001l\0058\001w\000\000\001x\001}\001\016\001w\001\127\001x\001\128\000\000\001\023\005#\000\000\001f\001v\000\000\001h\001i\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\001\127\0059\000\000\000\000\000\000\001\127\000\000\000\000\000\000\000\000\005:\005;\001n\005<\000\000\000\200\000\000\001n\001f\001v\000\200\001h\001i\000\000\000\000\001w\000\000\001x\001\160\000\000\000\000\000\000\005$\000\000\000\000\000\000\005v\000\000\000\000\000\000\000\000\000\000\000\000\000\000\004\238\000\000\005%\001\129\005&\000\000\000\000\000\000\000\000\000\000\000\000\001\130\001\127\001\139\001l\001.\005>\001w\000\000\001x\001\148\005@\005J\000\000\001n\000\000\001\031\000\200\001\129\005\030\000\000\005t\000\000\001\129\000\000\000\000\001\130\000\000\001\139\001l\000\000\001\130\000\000\001\139\001l\001d\001e\005u\001\127\002,\002-\001e\000\000\001\"\000\000\000\000\000\000\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\001f\001v\000\000\001h\001i\000\000\000\000\003\176\000\000\000\000\000\000\000\000\001d\001e\003\185\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\005 \001f\001v\000\000\001h\001i\003\198\000\000\000\000\000\000\000\000\000\000\001w\000\000\001x\001\156\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\001\016\000\000\001\130\000\000\001\139\001l\001\023\005#\001f\001v\000\000\001h\001i\001\127\001w\000\000\001x\002d\002/\000\000\001d\001e\000\000\000\000\000\000\001n\001d\001e\000\200\002\232\003\189\000\000\002\129\000\200\001\002\000\000\001\031\002\235\000\000\001 \001f\002\214\001I\001h\001i\001\127\001f\001v\000\000\001h\001i\001w\000\000\001x\002\246\000\000\000\000\001n\000\000\005$\000\200\000\000\001K\001\"\000\000\000\000\000\000\003\179\004\231\000\000\000\000\004\238\000\000\0051\000\000\005&\000\000\000\000\000\000\000\000\000\000\000\000\001\127\000\000\000\000\001\129\001.\000\000\000\000\001w\002\130\001x\002\249\001\130\001n\001\139\001l\000\200\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\001d\001e\000\000\000\000\001m\000\000\000\000\001\129\000\000\000\000\001\127\000\000\000\000\0018\000\000\001\130\001n\001\139\001l\000\200\001f\001v\001n\001h\001i\000\200\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\001d\001e\000\000\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\002\215\001\130\000\000\001\139\001l\001f\001v\000\000\001h\001i\000\000\000\000\001w\000\000\001x\002\252\000\000\000\000\000\000\000\000\000\000\000\000\002,\002-\001e\001\129\000\000\001>\000\000\000\000\000\000\001\129\000\000\001\138\001%\001\139\001l\000\000\005\029\001\130\000\000\001\139\001l\001\127\000\000\003\176\001d\001e\001w\000\000\001x\003\004\003\185\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\001.\000\000\000\000\001H\000\000\001f\001v\000\000\001h\001i\000\000\000\000\000\000\000\000\003\186\000\000\001\031\000\000\001\127\001 \000\000\000\000\001I\000\000\000\000\000\000\001\031\000\000\000\000\001 \001n\000\000\0012\000\200\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001K\001\"\000\000\000\000\000\000\000\000\001w\000\000\001x\004S\0017\001\"\001\129\000\000\002/\000\000\000\000\000\000\001d\001e\001\130\000\000\001\139\001l\000\000\000\000\003\189\000\000\002\129\000\200\001\002\000\000\000\000\000\000\000\000\004\030\000\000\001\127\001f\002\214\000\000\001h\001i\000\000\001*\001d\001e\000\000\001\129\001n\000\000\000\000\000\200\000\000\001*\000\000\001\130\000\000\001\139\001l\000\000\0018\000\000\003\179\000\000\001f\002\214\000\000\001h\001i\000\000\0018\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001d\001e\001\016\000\000\002\130\001d\001e\000\000\001\023\001$\000\000\000\000\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\001f\002\214\000\000\001h\001i\001f\002\214\001\129\001h\001i\001m\000\000\000\000\000\000\000\000\001\130\000\000\001\139\001l\001d\001e\000\000\001n\000\000\001>\000\200\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\001>\001F\000\000\001m\000\000\001f\002\214\001%\001h\001i\000\000\001F\000\000\000\000\000\000\001n\000\000\000\000\000\200\000\000\000\000\000\000\000\000\002\215\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001m\001d\001e\000\000\000\000\001m\000\000\000\000\001\129\000\000\003}\000\000\001n\000\000\000\000\000\200\001\138\001n\001\139\001l\000\200\001f\002\214\000\000\001h\001i\000\000\000\000\000\000\003\128\000\000\000\000\000\000\000\000\000\000\001\129\000\000\000\000\000\000\001m\001d\001e\000\000\001\138\000\000\001\139\001l\003}\000\000\000\000\000\000\001n\003}\000\000\000\200\000\000\000\000\005\176\000\000\000\000\001f\002\214\000\000\001h\001i\000\000\003\127\000\000\000\000\000\000\000\000\003~\001\129\000\000\000\000\000\000\000\000\001\129\001d\001e\001\138\000\000\001\139\001l\000\000\001\138\003}\001\139\001l\000\000\000\000\000\000\001d\001e\000\000\001m\000\000\000\000\001f\002\214\000\000\001h\001i\000\000\000\000\003\130\000\000\001n\000\000\005\200\000\200\001\129\001f\002\214\000\000\001h\001i\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001d\001e\000\000\0055\001m\000\000\001d\001e\000\000\000\000\000\000\000\000\006\027\000\000\000\000\000\000\001n\000\000\000\000\000\200\001f\002\214\000\000\001h\001i\000\000\001f\002\214\000\000\001h\001i\0056\000\000\0057\000\000\000\000\000\000\001\129\000\000\000\000\001d\001e\001m\000\000\000\000\001\138\000\000\001\139\001l\001d\001e\002\215\000\000\000\000\001n\000\000\001m\000\200\000\000\006\029\001f\002\214\0058\001h\001i\000\000\000\000\000\000\001n\001f\002\214\000\200\001h\001i\000\000\000\000\001\129\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\005\227\000\000\000\000\000\000\000\000\001m\0059\000\000\000\000\000\000\000\000\001m\000\000\000\000\002\215\005:\005;\001n\005<\000\000\000\200\000\000\000\000\001n\000\000\001\129\000\200\000\000\000\000\000\000\000\000\000\000\000\000\001\138\000\000\001\139\001l\000\000\000\000\001\129\000\000\005=\000\000\000\000\000\000\001m\005\240\001\138\000\000\001\139\001l\000\000\005\227\000\000\001m\000\000\000\000\001n\006\027\000\000\000\200\000\000\000\000\000\000\000\000\005>\001n\000\000\000\000\000\200\005@\005J\001\031\000\000\000\000\001 \000\000\001\129\000\000\000\000\005t\001\031\000\000\001\129\001 \001\138\001\031\001\139\001l\001 \000\000\001\138\006\027\001\139\001l\000\000\005u\000\000\005\239\001\"\000\000\003\129\000\000\001\031\000\000\006\028\001 \000\000\001\"\004\216\000\000\000\000\000\000\001\"\000\000\000\000\000\000\001\129\004\216\000\000\002,\002-\001e\004\216\005\173\001\138\001\129\001\139\001l\000\000\001\"\000\000\006\159\005\187\001\138\000\000\001\139\001l\005\197\006$\000\000\000\000\001*\003_\000\000\001d\001e\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001f\001g\005\233\001h\001i\000\000\000\000\001\016\001*\001d\001e\000\000\000\000\001\023\001$\000\000\001\016\000\000\000\000\000\000\000\000\001\016\001\023\001$\000\000\000\000\000\000\001\023\001$\001f\001\137\000\000\001h\001i\001d\001e\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\002/\000\000\000\000\000\000\001f\002\199\000\000\001h\001i\001>\000\000\000\000\0020\000\000\002\129\000\200\001%\000\000\001>\000\000\004\221\000\000\000\000\001>\001m\001%\000\000\000\000\000\000\004\221\001%\000\000\001\031\000\000\004\221\001 \001n\000\000\000\000\000\200\001>\000\000\000\000\001.\000\000\000\000\001H\001%\003b\000\000\000\000\006\166\001.\001m\000\000\001H\000\000\001.\000\000\001\"\001H\002,\002-\001e\000\000\001n\000\000\000\000\000\200\002\225\000\000\000\000\002\130\001\031\001.\000\000\001 \001H\001m\000\000\002\131\000\000\001\139\002\132\003_\000\000\000\000\000\000\000\000\000\000\001n\000\000\001\031\000\200\001\031\001 \001\129\001 \000\000\000\000\001\"\000\000\001*\000\000\001\138\000\000\001\139\001l\000\000\000\000\003\248\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\"\000\000\001\"\000\000\000\000\003\251\001\129\005\222\000\000\000\000\000\000\000\000\000\000\001\016\001\138\000\000\001\139\001l\000\000\001\023\001$\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\006(\000\000\001\129\000\000\000\000\000\000\000\000\000\000\002/\000\000\001\138\000\000\001\139\001l\001*\000\000\001*\000\000\006)\006(\0020\006+\002\129\000\200\000\000\001\016\000\000\000\000\000\000\000\000\006,\001\023\001$\000\000\000\000\000\000\001>\006)\000\000\000\000\006+\000\000\000\000\001%\001\016\000\000\001\016\002\207\000\000\006,\001\023\001$\001\023\001$\000\000\000\000\003a\000\000\001\031\006-\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\001\031\001H\000\000\001 \000\000\001>\006-\000\000\002\130\000\000\000\000\000\000\001%\001\"\000\000\000\000\002\131\000\000\001\139\002\132\000\000\006.\000\000\000\000\001>\000\000\001>\001\"\000\000\000\000\006/\001%\000\000\001%\000\000\004\249\000\000\004\236\006\012\001.\006.\000\000\003\255\000\000\002,\002-\001e\000\000\000\000\006/\001\031\000\000\006\244\001 \006;\000\000\001*\000\000\001.\000\000\001.\001H\000\000\001H\000\000\000\000\000\000\006Z\000\000\0061\001*\000\000\000\000\006D\000\000\000\000\000\000\001\"\001\031\0062\000\000\001 \000\000\000\000\0064\000\000\001\016\000\000\0061\000\000\000\000\000\000\001\023\001$\0066\000\000\000\000\000\000\0062\001\031\001\016\000\000\001 \0064\000\000\001\"\001\023\001$\000\000\000\000\0067\000\000\000\000\0066\000\000\000\000\000\000\000\000\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\001\"\000\000\001\031\0067\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\001>\002/\001\031\000\000\000\000\001 \000\000\001%\000\000\000\000\001*\006\245\001\016\0020\001>\002\129\000\200\001\"\001\023\001$\000\000\001%\000\000\000\000\000\000\006\205\002,\002-\001e\001\"\000\000\001*\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001.\003\193\000\000\001H\000\000\002,\002-\001e\000\000\002,\002-\001e\001*\001\016\000\000\000\000\001>\000\000\000\000\001\023\001$\000\000\000\000\001%\001*\002\130\000\000\001X\002.\002,\002-\001e\002i\002\131\000\000\001\139\002\132\000\000\000\000\000\000\000\000\000\000\001\016\000\000\001>\000\000\000\000\000\000\001\023\001$\001.\001%\002k\001H\001\016\001\151\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\001\031\001>\000\000\001 \000\000\000\000\000\000\000\000\001%\002/\000\000\000\000\001\192\000\000\001.\000\000\000\000\001H\000\000\000\000\000\000\0020\001\"\002\129\000\200\000\000\000\000\001\"\000\000\000\000\001>\000\000\000\000\000\000\000\000\001.\002/\001%\001H\000\000\002/\001\230\001>\000\000\001\031\000\000\000\000\001 \0020\001%\002\129\000\200\0020\001\232\002\129\000\200\000\000\000\000\000\000\000\000\002/\002,\002-\001e\001.\001*\000\000\001H\000\000\000\000\001*\001\"\0020\000\000\002\129\000\200\001.\000\000\000\000\001H\000\000\002\130\000\000\000\000\002u\000\000\000\000\000\000\000\000\002\131\000\000\001\139\002\132\000\000\000\000\001\016\000\000\000\000\000\000\000\000\001\016\001\023\001$\002,\002-\001e\001\023\001$\002\130\000\000\000\000\000\000\002\130\000\000\001*\000\000\002\131\000\000\001\139\002\132\002\131\000\000\001\139\002\132\000\000\000\000\002\128\000\000\000\000\000\000\000\000\000\000\002\130\000\000\002,\002-\001e\000\000\000\000\000\000\002\131\000\000\001\139\002\132\001\016\001\031\000\000\001>\001 \000\000\001\023\001$\001>\000\000\001%\000\000\002/\002\143\002C\001%\000\000\001\031\000\000\002V\001 \000\000\000\000\000\000\0020\000\000\002\129\000\200\001\"\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \001.\000\000\000\000\001H\000\000\001.\000\000\001\"\001H\000\000\000\000\001\031\000\000\000\000\001 \001>\000\000\002/\000\000\000\000\000\000\000\000\001%\001\"\000\000\000\000\002\204\000\000\000\000\0020\000\000\002\129\000\200\000\000\001*\000\000\000\000\000\000\001\"\000\000\000\000\000\000\002,\002-\001e\000\000\000\000\002\130\002/\001.\001*\000\000\001H\000\000\000\000\002\131\000\000\001\139\002\132\000\000\0020\000\000\002\129\000\200\001\016\003'\001*\000\000\000\000\000\000\001\023\001$\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\001*\000\000\000\000\000\000\000\000\001\023\001$\001\031\002\130\000\000\001 \000\000\000\000\000\000\000\000\001\016\002\131\001\031\001\139\002\132\001 \001\023\001$\000\000\000\000\001\031\000\000\000\000\001 \000\000\001\016\000\000\000\000\000\000\001\"\001>\001\023\001$\000\000\002\130\000\000\000\000\001%\000\000\001\"\000\000\002\209\002\131\000\000\001\139\002\132\001>\001\"\000\000\000\000\000\000\002/\001\031\001%\000\000\001 \000\000\002\222\000\000\000\000\000\000\000\000\001>\0020\001.\002\129\000\200\001H\000\000\001%\000\000\000\000\001*\002\229\000\000\000\000\000\000\001>\000\000\001\"\001.\000\000\001*\001H\001%\000\000\000\000\000\000\002\238\000\000\001*\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001\031\001.\001\016\001 \001H\000\000\000\000\000\000\001\023\001$\001\016\000\000\001*\002\130\000\000\000\000\001\023\001$\000\000\001\031\000\000\002\131\001 \001\139\002\132\000\000\000\000\001\"\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\001\031\000\000\001\016\001 \001>\000\000\001\"\000\000\001\023\001$\001\031\001%\000\000\001 \001>\004b\000\000\000\000\000\000\001\"\001\031\001%\001>\005\030\000\000\004\193\000\000\001\"\000\000\001%\001*\000\000\000\000\004\205\000\000\000\000\000\000\001\"\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\001\"\001.\001*\000\000\001H\000\000\000\000\001>\000\000\001.\000\000\000\000\001H\001\016\001%\001*\000\000\000\000\004\218\001\023\001$\000\000\000\000\001*\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\001*\000\000\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\005 \001H\001\016\000\000\001\031\000\000\000\000\005\030\001\023\001$\001\016\000\000\000\000\000\000\000\000\001\031\001\023\001$\001 \000\000\001\016\000\000\001>\000\000\000\000\000\000\001\023\001$\000\000\001%\001\016\001\"\000\000\004\235\000\000\000\000\001\023\005#\000\000\000\000\000\000\001>\001\"\001\031\000\000\000\000\001 \000\000\001%\000\000\000\000\000\000\004\251\000\000\001>\001\031\001.\000\000\001 \001H\000\000\001%\001>\000\000\000\000\005\152\000\000\000\000\000\000\001%\001\"\000\000\001>\005\170\005 \001.\000\000\000\000\001H\001%\000\000\001\031\001\"\005\194\001 \001*\000\000\000\000\001.\005$\000\000\001H\000\000\000\000\000\000\000\000\001.\000\000\000\000\001H\000\000\004\238\000\000\005\254\001\016\005&\001.\000\000\001\"\001H\001\023\005#\000\000\001*\000\000\001\016\001.\000\000\000\000\000\000\000\000\001\023\001$\000\000\000\000\001*\000\000\000\000\000\000\000\000\001\031\000\000\000\000\001 \000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\001*\000\000\000\000\000\000\001\016\000\000\001\"\000\000\000\000\000\000\001\023\001$\005$\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\004\238\000\000\006\024\006P\005&\000\000\001\016\000\000\000\000\000\000\000\000\000\000\001\023\001$\000\000\001.\000\000\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\001*\001.\001%\000\000\001H\000\000\006\165\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\006\169\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\001\016\000\000\001H\001>\000\000\000\000\001\023\001$\000\000\000\000\001%\001.\000\000\000\000\001H\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\001\227\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001>\000\000\000\000\000\000\000\000\000\000\000\000\001%\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\001.\000\000\000\000\003\250"))
and semantic_action =
[|
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3657 "parsing/parser.mly"
+# 3745 "parsing/parser.mly"
( "+" )
-# 1342 "parsing/parser.ml"
+# 1380 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3658 "parsing/parser.mly"
+# 3746 "parsing/parser.mly"
( "+." )
-# 1367 "parsing/parser.ml"
+# 1405 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3214 "parsing/parser.mly"
+# 3298 "parsing/parser.mly"
( _1 )
-# 1392 "parsing/parser.ml"
+# 1430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3217 "parsing/parser.mly"
+# 3301 "parsing/parser.mly"
( Ptyp_alias(ty, tyvar) )
-# 1439 "parsing/parser.ml"
+# 1477 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_tyvar_, _startpos_ty_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1448 "parsing/parser.ml"
+# 1486 "parsing/parser.ml"
in
-# 3219 "parsing/parser.mly"
+# 3303 "parsing/parser.mly"
( _1 )
-# 1454 "parsing/parser.ml"
+# 1492 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
- let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+ let body : (Parsetree.pattern * Parsetree.expression * bool) = Obj.magic body in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (let_binding) = let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 1502 "parsing/parser.ml"
+# 1540 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 1511 "parsing/parser.ml"
+# 1549 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2480 "parsing/parser.mly"
+# 2554 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
mklb ~loc:_sloc false body attrs
)
-# 1523 "parsing/parser.ml"
+# 1561 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3544 "parsing/parser.mly"
+# 3629 "parsing/parser.mly"
( _1 )
-# 1548 "parsing/parser.ml"
+# 1586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3545 "parsing/parser.mly"
+# 3630 "parsing/parser.mly"
( Lident _1 )
-# 1573 "parsing/parser.ml"
+# 1611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 3275 "parsing/parser.mly"
+# 3359 "parsing/parser.mly"
( _2 )
-# 1612 "parsing/parser.ml"
+# 1650 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 1679 "parsing/parser.ml"
+# 1717 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 1689 "parsing/parser.ml"
+# 1727 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 1695 "parsing/parser.ml"
+# 1733 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3277 "parsing/parser.mly"
+# 3361 "parsing/parser.mly"
( wrap_typ_attrs ~loc:_sloc (reloc_typ ~loc:_sloc _4) _3 )
-# 1704 "parsing/parser.ml"
+# 1742 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3280 "parsing/parser.mly"
+# 3364 "parsing/parser.mly"
( Ptyp_var _2 )
-# 1737 "parsing/parser.ml"
+# 1775 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1746 "parsing/parser.ml"
+# 1784 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 1752 "parsing/parser.ml"
+# 1790 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3282 "parsing/parser.mly"
+# 3366 "parsing/parser.mly"
( Ptyp_any )
-# 1778 "parsing/parser.ml"
+# 1816 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1786 "parsing/parser.ml"
+# 1824 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 1792 "parsing/parser.ml"
+# 1830 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1823 "parsing/parser.ml"
+# 1861 "parsing/parser.ml"
in
let tys =
-# 3327 "parsing/parser.mly"
+# 3411 "parsing/parser.mly"
( [] )
-# 1829 "parsing/parser.ml"
+# 1867 "parsing/parser.ml"
in
-# 3285 "parsing/parser.mly"
+# 3369 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1834 "parsing/parser.ml"
+# 1872 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1843 "parsing/parser.ml"
+# 1881 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 1849 "parsing/parser.ml"
+# 1887 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1887 "parsing/parser.ml"
+# 1925 "parsing/parser.ml"
in
let tys =
-# 3329 "parsing/parser.mly"
+# 3413 "parsing/parser.mly"
( [ty] )
-# 1893 "parsing/parser.ml"
+# 1931 "parsing/parser.ml"
in
-# 3285 "parsing/parser.mly"
+# 3369 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1898 "parsing/parser.ml"
+# 1936 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 1908 "parsing/parser.ml"
+# 1946 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 1914 "parsing/parser.ml"
+# 1952 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 1967 "parsing/parser.ml"
+# 2005 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 1975 "parsing/parser.ml"
+# 2013 "parsing/parser.ml"
in
-# 979 "parsing/parser.mly"
+# 1045 "parsing/parser.mly"
( xs )
-# 1980 "parsing/parser.ml"
+# 2018 "parsing/parser.ml"
in
-# 3331 "parsing/parser.mly"
+# 3415 "parsing/parser.mly"
( tys )
-# 1986 "parsing/parser.ml"
+# 2024 "parsing/parser.ml"
in
-# 3285 "parsing/parser.mly"
+# 3369 "parsing/parser.mly"
( Ptyp_constr(tid, tys) )
-# 1992 "parsing/parser.ml"
+# 2030 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2002 "parsing/parser.ml"
+# 2040 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2008 "parsing/parser.ml"
+# 2046 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3287 "parsing/parser.mly"
+# 3371 "parsing/parser.mly"
( let (f, c) = _2 in Ptyp_object (f, c) )
-# 2048 "parsing/parser.ml"
+# 2086 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2057 "parsing/parser.ml"
+# 2095 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2063 "parsing/parser.ml"
+# 2101 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3289 "parsing/parser.mly"
+# 3373 "parsing/parser.mly"
( Ptyp_object ([], Closed) )
-# 2096 "parsing/parser.ml"
+# 2134 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2105 "parsing/parser.ml"
+# 2143 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2111 "parsing/parser.ml"
+# 2149 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2149 "parsing/parser.ml"
+# 2187 "parsing/parser.ml"
in
let tys =
-# 3327 "parsing/parser.mly"
+# 3411 "parsing/parser.mly"
( [] )
-# 2155 "parsing/parser.ml"
+# 2193 "parsing/parser.ml"
in
-# 3293 "parsing/parser.mly"
+# 3377 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2160 "parsing/parser.ml"
+# 2198 "parsing/parser.ml"
in
let _startpos__1_ = _startpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2170 "parsing/parser.ml"
+# 2208 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2176 "parsing/parser.ml"
+# 2214 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2221 "parsing/parser.ml"
+# 2259 "parsing/parser.ml"
in
let tys =
-# 3329 "parsing/parser.mly"
+# 3413 "parsing/parser.mly"
( [ty] )
-# 2227 "parsing/parser.ml"
+# 2265 "parsing/parser.ml"
in
-# 3293 "parsing/parser.mly"
+# 3377 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2232 "parsing/parser.ml"
+# 2270 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_ty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2242 "parsing/parser.ml"
+# 2280 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2248 "parsing/parser.ml"
+# 2286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 2308 "parsing/parser.ml"
+# 2346 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2316 "parsing/parser.ml"
+# 2354 "parsing/parser.ml"
in
-# 979 "parsing/parser.mly"
+# 1045 "parsing/parser.mly"
( xs )
-# 2321 "parsing/parser.ml"
+# 2359 "parsing/parser.ml"
in
-# 3331 "parsing/parser.mly"
+# 3415 "parsing/parser.mly"
( tys )
-# 2327 "parsing/parser.ml"
+# 2365 "parsing/parser.ml"
in
-# 3293 "parsing/parser.mly"
+# 3377 "parsing/parser.mly"
( Ptyp_class(cid, tys) )
-# 2333 "parsing/parser.ml"
+# 2371 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2343 "parsing/parser.ml"
+# 2381 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2349 "parsing/parser.ml"
+# 2387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3296 "parsing/parser.mly"
+# 3380 "parsing/parser.mly"
( Ptyp_variant([_2], Closed, None) )
-# 2389 "parsing/parser.ml"
+# 2427 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2398 "parsing/parser.ml"
+# 2436 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2404 "parsing/parser.ml"
+# 2442 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2454 "parsing/parser.ml"
+# 2492 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 2459 "parsing/parser.ml"
+# 2497 "parsing/parser.ml"
in
-# 3341 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( _1 )
-# 2465 "parsing/parser.ml"
+# 2503 "parsing/parser.ml"
in
-# 3298 "parsing/parser.mly"
+# 3382 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, None) )
-# 2471 "parsing/parser.ml"
+# 2509 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2481 "parsing/parser.ml"
+# 2519 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2487 "parsing/parser.ml"
+# 2525 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2544 "parsing/parser.ml"
+# 2582 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 2549 "parsing/parser.ml"
+# 2587 "parsing/parser.ml"
in
-# 3341 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( _1 )
-# 2555 "parsing/parser.ml"
+# 2593 "parsing/parser.ml"
in
-# 3300 "parsing/parser.mly"
+# 3384 "parsing/parser.mly"
( Ptyp_variant(_2 :: _4, Closed, None) )
-# 2561 "parsing/parser.ml"
+# 2599 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2571 "parsing/parser.ml"
+# 2609 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2577 "parsing/parser.ml"
+# 2615 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2627 "parsing/parser.ml"
+# 2665 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 2632 "parsing/parser.ml"
+# 2670 "parsing/parser.ml"
in
-# 3341 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( _1 )
-# 2638 "parsing/parser.ml"
+# 2676 "parsing/parser.ml"
in
-# 3302 "parsing/parser.mly"
+# 3386 "parsing/parser.mly"
( Ptyp_variant(_3, Open, None) )
-# 2644 "parsing/parser.ml"
+# 2682 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2654 "parsing/parser.ml"
+# 2692 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2660 "parsing/parser.ml"
+# 2698 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3304 "parsing/parser.mly"
+# 3388 "parsing/parser.mly"
( Ptyp_variant([], Open, None) )
-# 2693 "parsing/parser.ml"
+# 2731 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2702 "parsing/parser.ml"
+# 2740 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2708 "parsing/parser.ml"
+# 2746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2758 "parsing/parser.ml"
+# 2796 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 2763 "parsing/parser.ml"
+# 2801 "parsing/parser.ml"
in
-# 3341 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( _1 )
-# 2769 "parsing/parser.ml"
+# 2807 "parsing/parser.ml"
in
-# 3306 "parsing/parser.mly"
+# 3390 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some []) )
-# 2775 "parsing/parser.ml"
+# 2813 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2785 "parsing/parser.ml"
+# 2823 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2791 "parsing/parser.ml"
+# 2829 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2856 "parsing/parser.ml"
+# 2894 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 2861 "parsing/parser.ml"
+# 2899 "parsing/parser.ml"
in
-# 3369 "parsing/parser.mly"
+# 3453 "parsing/parser.mly"
( _1 )
-# 2867 "parsing/parser.ml"
+# 2905 "parsing/parser.ml"
in
let _3 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 2875 "parsing/parser.ml"
+# 2913 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 2880 "parsing/parser.ml"
+# 2918 "parsing/parser.ml"
in
-# 3341 "parsing/parser.mly"
+# 3425 "parsing/parser.mly"
( _1 )
-# 2886 "parsing/parser.ml"
+# 2924 "parsing/parser.ml"
in
-# 3308 "parsing/parser.mly"
+# 3392 "parsing/parser.mly"
( Ptyp_variant(_3, Closed, Some _5) )
-# 2892 "parsing/parser.ml"
+# 2930 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2902 "parsing/parser.ml"
+# 2940 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2908 "parsing/parser.ml"
+# 2946 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 3310 "parsing/parser.mly"
+# 3394 "parsing/parser.mly"
( Ptyp_extension _1 )
-# 2934 "parsing/parser.ml"
+# 2972 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 2942 "parsing/parser.ml"
+# 2980 "parsing/parser.ml"
in
-# 3312 "parsing/parser.mly"
+# 3396 "parsing/parser.mly"
( _1 )
-# 2948 "parsing/parser.ml"
+# 2986 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3724 "parsing/parser.mly"
+# 3812 "parsing/parser.mly"
( _1 )
-# 2974 "parsing/parser.ml"
+# 3012 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 847 "parsing/parser.mly"
+# 913 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 2982 "parsing/parser.ml"
+# 3020 "parsing/parser.ml"
in
-# 3726 "parsing/parser.mly"
+# 3814 "parsing/parser.mly"
( _1 )
-# 2988 "parsing/parser.ml"
+# 3026 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (string Asttypes.loc) = let _1 =
let _1 =
-# 3725 "parsing/parser.mly"
+# 3813 "parsing/parser.mly"
( _1 ^ "." ^ _3.txt )
-# 3028 "parsing/parser.ml"
+# 3066 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 847 "parsing/parser.mly"
+# 913 "parsing/parser.mly"
( mkloc _1 (make_loc _sloc) )
-# 3037 "parsing/parser.ml"
+# 3075 "parsing/parser.ml"
in
-# 3726 "parsing/parser.mly"
+# 3814 "parsing/parser.mly"
( _1 )
-# 3043 "parsing/parser.ml"
+# 3081 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3730 "parsing/parser.mly"
+# 3818 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 3092 "parsing/parser.ml"
+# 3130 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) =
-# 1768 "parsing/parser.mly"
+# 1858 "parsing/parser.mly"
( _1 )
-# 3117 "parsing/parser.ml"
+# 3155 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3158 "parsing/parser.ml"
+# 3196 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1770 "parsing/parser.mly"
+# 1860 "parsing/parser.mly"
( wrap_class_attrs ~loc:_sloc _3 _2 )
-# 3167 "parsing/parser.ml"
+# 3205 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1772 "parsing/parser.mly"
+# 1862 "parsing/parser.mly"
( class_of_let_bindings ~loc:_sloc _1 _3 )
-# 3209 "parsing/parser.ml"
+# 3247 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3274 "parsing/parser.ml"
+# 3312 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3283 "parsing/parser.ml"
+# 3321 "parsing/parser.ml"
in
let _3 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 3289 "parsing/parser.ml"
+# 3327 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1774 "parsing/parser.mly"
+# 1864 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 3299 "parsing/parser.ml"
+# 3337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 3371 "parsing/parser.ml"
+# 3409 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3380 "parsing/parser.ml"
+# 3418 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 3388 "parsing/parser.ml"
+# 3426 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1774 "parsing/parser.mly"
+# 1864 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkclass ~loc:_sloc ~attrs:_4 (Pcl_open(od, _7)) )
-# 3399 "parsing/parser.ml"
+# 3437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1778 "parsing/parser.mly"
+# 1868 "parsing/parser.mly"
( Cl.attr _1 _2 )
-# 3431 "parsing/parser.ml"
+# 3469 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 3466 "parsing/parser.ml"
+# 3504 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 3471 "parsing/parser.ml"
+# 3509 "parsing/parser.ml"
in
-# 1781 "parsing/parser.mly"
+# 1871 "parsing/parser.mly"
( Pcl_apply(_1, _2) )
-# 3477 "parsing/parser.ml"
+# 3515 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3487 "parsing/parser.ml"
+# 3525 "parsing/parser.ml"
in
-# 1784 "parsing/parser.mly"
+# 1874 "parsing/parser.mly"
( _1 )
-# 3493 "parsing/parser.ml"
+# 3531 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1783 "parsing/parser.mly"
+# 1873 "parsing/parser.mly"
( Pcl_extension _1 )
-# 3519 "parsing/parser.ml"
+# 3557 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 3527 "parsing/parser.ml"
+# 3565 "parsing/parser.ml"
in
-# 1784 "parsing/parser.mly"
+# 1874 "parsing/parser.mly"
( _1 )
-# 3533 "parsing/parser.ml"
+# 3571 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3588 "parsing/parser.ml"
+# 3626 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3597 "parsing/parser.ml"
+# 3635 "parsing/parser.ml"
in
let _2 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 3603 "parsing/parser.ml"
+# 3641 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1833 "parsing/parser.mly"
+# 1923 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3612 "parsing/parser.ml"
+# 3650 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _6 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3674 "parsing/parser.ml"
+# 3712 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _3 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3683 "parsing/parser.ml"
+# 3721 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 3691 "parsing/parser.ml"
+# 3729 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1833 "parsing/parser.mly"
+# 1923 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_inherit (_2, _4, self)) ~attrs:(_3@_6) ~docs )
-# 3701 "parsing/parser.ml"
+# 3739 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3744 "parsing/parser.ml"
+# 3782 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1836 "parsing/parser.mly"
+# 1926 "parsing/parser.mly"
( let v, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_val v) ~attrs:(attrs@_3) ~docs )
-# 3756 "parsing/parser.ml"
+# 3794 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _3 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3799 "parsing/parser.ml"
+# 3837 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1840 "parsing/parser.mly"
+# 1930 "parsing/parser.mly"
( let meth, attrs = _2 in
let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_method meth) ~attrs:(attrs@_3) ~docs )
-# 3811 "parsing/parser.ml"
+# 3849 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3859 "parsing/parser.ml"
+# 3897 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3868 "parsing/parser.ml"
+# 3906 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1844 "parsing/parser.mly"
+# 1934 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 3878 "parsing/parser.ml"
+# 3916 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _4 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3926 "parsing/parser.ml"
+# 3964 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 3935 "parsing/parser.ml"
+# 3973 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1847 "parsing/parser.mly"
+# 1937 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_initializer _3) ~attrs:(_2@_4) ~docs )
-# 3945 "parsing/parser.ml"
+# 3983 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field) = let _2 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 3979 "parsing/parser.ml"
+# 4017 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1850 "parsing/parser.mly"
+# 1940 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkcf ~loc:_sloc (Pcf_extension _1) ~attrs:_2 ~docs )
-# 3990 "parsing/parser.ml"
+# 4028 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_field) = let _1 =
let _1 =
-# 1853 "parsing/parser.mly"
+# 1943 "parsing/parser.mly"
( Pcf_attribute _1 )
-# 4016 "parsing/parser.ml"
+# 4054 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 868 "parsing/parser.mly"
+# 934 "parsing/parser.mly"
( mkcf ~loc:_sloc _1 )
-# 4024 "parsing/parser.ml"
+# 4062 "parsing/parser.ml"
in
-# 1854 "parsing/parser.mly"
+# 1944 "parsing/parser.mly"
( _1 )
-# 4030 "parsing/parser.ml"
+# 4068 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) =
-# 1748 "parsing/parser.mly"
+# 1838 "parsing/parser.mly"
( _2 )
-# 4062 "parsing/parser.ml"
+# 4100 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1751 "parsing/parser.mly"
+# 1841 "parsing/parser.mly"
( Pcl_constraint(_4, _2) )
-# 4109 "parsing/parser.ml"
+# 4147 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4118 "parsing/parser.ml"
+# 4156 "parsing/parser.ml"
in
-# 1754 "parsing/parser.mly"
+# 1844 "parsing/parser.mly"
( _1 )
-# 4124 "parsing/parser.ml"
+# 4162 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1753 "parsing/parser.mly"
+# 1843 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, _2) )
-# 4157 "parsing/parser.ml"
+# 4195 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4166 "parsing/parser.ml"
+# 4204 "parsing/parser.ml"
in
-# 1754 "parsing/parser.mly"
+# 1844 "parsing/parser.mly"
( _1 )
-# 4172 "parsing/parser.ml"
+# 4210 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1809 "parsing/parser.mly"
+# 1899 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4212 "parsing/parser.ml"
+# 4250 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4221 "parsing/parser.ml"
+# 4259 "parsing/parser.ml"
in
-# 1810 "parsing/parser.mly"
+# 1900 "parsing/parser.mly"
( _1 )
-# 4227 "parsing/parser.ml"
+# 4265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_e_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1809 "parsing/parser.mly"
+# 1899 "parsing/parser.mly"
( let (l,o,p) = _1 in Pcl_fun(l, o, p, e) )
-# 4260 "parsing/parser.ml"
+# 4298 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_e_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 4269 "parsing/parser.ml"
+# 4307 "parsing/parser.ml"
in
-# 1810 "parsing/parser.mly"
+# 1900 "parsing/parser.mly"
( _1 )
-# 4275 "parsing/parser.ml"
+# 4313 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3535 "parsing/parser.mly"
+# 3619 "parsing/parser.mly"
( _1 )
-# 4300 "parsing/parser.ml"
+# 4338 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1818 "parsing/parser.mly"
+# 1908 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 4342 "parsing/parser.ml"
+# 4380 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 1820 "parsing/parser.mly"
+# 1910 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 4396 "parsing/parser.ml"
+# 4434 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 4405 "parsing/parser.ml"
+# 4443 "parsing/parser.ml"
in
-# 1821 "parsing/parser.mly"
+# 1911 "parsing/parser.mly"
( _1 )
-# 4411 "parsing/parser.ml"
+# 4449 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 1823 "parsing/parser.mly"
+# 1913 "parsing/parser.mly"
( ghpat ~loc:_sloc Ppat_any )
-# 4432 "parsing/parser.ml"
+# 4470 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type) =
-# 1948 "parsing/parser.mly"
+# 2038 "parsing/parser.mly"
( _2 )
-# 4471 "parsing/parser.ml"
+# 4509 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _startpos in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 1949 "parsing/parser.mly"
+# 2039 "parsing/parser.mly"
( Ptyp_any )
-# 4490 "parsing/parser.ml"
+# 4528 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__0_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _endpos in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 4499 "parsing/parser.ml"
+# 4537 "parsing/parser.ml"
in
-# 1950 "parsing/parser.mly"
+# 2040 "parsing/parser.mly"
( _1 )
-# 4505 "parsing/parser.ml"
+# 4543 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 4553 "parsing/parser.ml"
+# 4591 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 4562 "parsing/parser.ml"
+# 4600 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1958 "parsing/parser.mly"
+# 2048 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_inherit _3) ~attrs:(_2@_4) ~docs )
-# 4572 "parsing/parser.ml"
+# 4610 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _3 : unit = Obj.magic _3 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 4632 "parsing/parser.ml"
+# 4670 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let flags : (Asttypes.mutable_flag * Asttypes.virtual_flag) = Obj.magic flags in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 4645 "parsing/parser.ml"
+# 4683 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined3_ in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let label =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 4655 "parsing/parser.ml"
+# 4693 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4663 "parsing/parser.ml"
+# 4701 "parsing/parser.ml"
in
-# 1983 "parsing/parser.mly"
+# 2073 "parsing/parser.mly"
(
let mut, virt = flags in
label, mut, virt, ty
)
-# 4672 "parsing/parser.ml"
+# 4710 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 4680 "parsing/parser.ml"
+# 4718 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1961 "parsing/parser.mly"
+# 2051 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_val _3) ~attrs:(_2@_4) ~docs )
-# 4690 "parsing/parser.ml"
+# 4728 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 4750 "parsing/parser.ml"
+# 4788 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag * Asttypes.virtual_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : (Parsetree.class_type_field) = let _7 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 4763 "parsing/parser.ml"
+# 4801 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _6 =
let _1 = _1_inlined3 in
-# 3180 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _1 )
-# 4772 "parsing/parser.ml"
+# 4810 "parsing/parser.ml"
in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 4780 "parsing/parser.ml"
+# 4818 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4788 "parsing/parser.ml"
+# 4826 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 4796 "parsing/parser.ml"
+# 4834 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1965 "parsing/parser.mly"
+# 2055 "parsing/parser.mly"
( let (p, v) = _3 in
let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_method (_4, p, v, _6)) ~attrs:(_2@_7) ~docs )
-# 4807 "parsing/parser.ml"
+# 4845 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _4 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 4855 "parsing/parser.ml"
+# 4893 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 4864 "parsing/parser.ml"
+# 4902 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1969 "parsing/parser.mly"
+# 2059 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_constraint _3) ~attrs:(_2@_4) ~docs )
-# 4874 "parsing/parser.ml"
+# 4912 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field) = let _2 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 4908 "parsing/parser.ml"
+# 4946 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1972 "parsing/parser.mly"
+# 2062 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mkctf ~loc:_sloc (Pctf_extension _1) ~attrs:_2 ~docs )
-# 4919 "parsing/parser.ml"
+# 4957 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type_field) = let _1 =
let _1 =
-# 1975 "parsing/parser.mly"
+# 2065 "parsing/parser.mly"
( Pctf_attribute _1 )
-# 4945 "parsing/parser.ml"
+# 4983 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 866 "parsing/parser.mly"
+# 932 "parsing/parser.mly"
( mkctf ~loc:_sloc _1 )
-# 4953 "parsing/parser.ml"
+# 4991 "parsing/parser.ml"
in
-# 1976 "parsing/parser.mly"
+# 2066 "parsing/parser.mly"
( _1 )
-# 4959 "parsing/parser.ml"
+# 4997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 4990 "parsing/parser.ml"
+# 5028 "parsing/parser.ml"
in
let tys =
let tys =
-# 1934 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( [] )
-# 4997 "parsing/parser.ml"
+# 5035 "parsing/parser.ml"
in
-# 1940 "parsing/parser.mly"
+# 2030 "parsing/parser.mly"
( tys )
-# 5002 "parsing/parser.ml"
+# 5040 "parsing/parser.ml"
in
-# 1917 "parsing/parser.mly"
+# 2007 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5008 "parsing/parser.ml"
+# 5046 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5017 "parsing/parser.ml"
+# 5055 "parsing/parser.ml"
in
-# 1920 "parsing/parser.mly"
+# 2010 "parsing/parser.mly"
( _1 )
-# 5023 "parsing/parser.ml"
+# 5061 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5076 "parsing/parser.ml"
+# 5114 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5085 "parsing/parser.ml"
+# 5123 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 5090 "parsing/parser.ml"
+# 5128 "parsing/parser.ml"
in
-# 1936 "parsing/parser.mly"
+# 2026 "parsing/parser.mly"
( params )
-# 5096 "parsing/parser.ml"
+# 5134 "parsing/parser.ml"
in
-# 1940 "parsing/parser.mly"
+# 2030 "parsing/parser.mly"
( tys )
-# 5102 "parsing/parser.ml"
+# 5140 "parsing/parser.ml"
in
-# 1917 "parsing/parser.mly"
+# 2007 "parsing/parser.mly"
( Pcty_constr (cid, tys) )
-# 5108 "parsing/parser.ml"
+# 5146 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5118 "parsing/parser.ml"
+# 5156 "parsing/parser.ml"
in
-# 1920 "parsing/parser.mly"
+# 2010 "parsing/parser.mly"
( _1 )
-# 5124 "parsing/parser.ml"
+# 5162 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
-# 1919 "parsing/parser.mly"
+# 2009 "parsing/parser.mly"
( Pcty_extension _1 )
-# 5150 "parsing/parser.ml"
+# 5188 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 5158 "parsing/parser.ml"
+# 5196 "parsing/parser.ml"
in
-# 1920 "parsing/parser.mly"
+# 2010 "parsing/parser.mly"
( _1 )
-# 5164 "parsing/parser.ml"
+# 5202 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5221 "parsing/parser.ml"
+# 5259 "parsing/parser.ml"
in
-# 1954 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( _1 )
-# 5226 "parsing/parser.ml"
+# 5264 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 812 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5235 "parsing/parser.ml"
+# 5273 "parsing/parser.ml"
in
-# 1944 "parsing/parser.mly"
+# 2034 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5241 "parsing/parser.ml"
+# 5279 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 5249 "parsing/parser.ml"
+# 5287 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1922 "parsing/parser.mly"
+# 2012 "parsing/parser.mly"
( mkcty ~loc:_sloc ~attrs:_2 (Pcty_signature _3) )
-# 5258 "parsing/parser.ml"
+# 5296 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5315 "parsing/parser.ml"
+# 5353 "parsing/parser.ml"
in
-# 1954 "parsing/parser.mly"
+# 2044 "parsing/parser.mly"
( _1 )
-# 5320 "parsing/parser.ml"
+# 5358 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 812 "parsing/parser.mly"
+# 878 "parsing/parser.mly"
( extra_csig _startpos _endpos _1 )
-# 5329 "parsing/parser.ml"
+# 5367 "parsing/parser.ml"
in
-# 1944 "parsing/parser.mly"
+# 2034 "parsing/parser.mly"
( Csig.mk _1 _2 )
-# 5335 "parsing/parser.ml"
+# 5373 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 5343 "parsing/parser.ml"
+# 5381 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1924 "parsing/parser.mly"
+# 2014 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5351 "parsing/parser.ml"
+# 5389 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.class_type) =
-# 1926 "parsing/parser.mly"
+# 2016 "parsing/parser.mly"
( Cty.attr _1 _2 )
-# 5383 "parsing/parser.ml"
+# 5421 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5448 "parsing/parser.ml"
+# 5486 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _4 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 5457 "parsing/parser.ml"
+# 5495 "parsing/parser.ml"
in
let _3 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 5463 "parsing/parser.ml"
+# 5501 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1928 "parsing/parser.mly"
+# 2018 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5473 "parsing/parser.ml"
+# 5511 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5545 "parsing/parser.ml"
+# 5583 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 5554 "parsing/parser.ml"
+# 5592 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 5562 "parsing/parser.ml"
+# 5600 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1928 "parsing/parser.mly"
+# 2018 "parsing/parser.mly"
( let loc = (_startpos__2_, _endpos__5_) in
let od = Opn.mk ~override:_3 ~loc:(make_loc loc) _5 in
mkcty ~loc:_sloc ~attrs:_4 (Pcty_open(od, _7)) )
-# 5573 "parsing/parser.ml"
+# 5611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.class_expr) =
-# 1788 "parsing/parser.mly"
+# 1878 "parsing/parser.mly"
( _2 )
-# 5612 "parsing/parser.ml"
+# 5650 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1790 "parsing/parser.mly"
+# 1880 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 5653 "parsing/parser.ml"
+# 5691 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5684 "parsing/parser.ml"
+# 5722 "parsing/parser.ml"
in
let tys =
let tys =
-# 1934 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( [] )
-# 5691 "parsing/parser.ml"
+# 5729 "parsing/parser.ml"
in
-# 1940 "parsing/parser.mly"
+# 2030 "parsing/parser.mly"
( tys )
-# 5696 "parsing/parser.ml"
+# 5734 "parsing/parser.ml"
in
-# 1793 "parsing/parser.mly"
+# 1883 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5702 "parsing/parser.ml"
+# 5740 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5711 "parsing/parser.ml"
+# 5749 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1890 "parsing/parser.mly"
( _1 )
-# 5717 "parsing/parser.ml"
+# 5755 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 5770 "parsing/parser.ml"
+# 5808 "parsing/parser.ml"
in
let tys =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 5779 "parsing/parser.ml"
+# 5817 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 5784 "parsing/parser.ml"
+# 5822 "parsing/parser.ml"
in
-# 1936 "parsing/parser.mly"
+# 2026 "parsing/parser.mly"
( params )
-# 5790 "parsing/parser.ml"
+# 5828 "parsing/parser.ml"
in
-# 1940 "parsing/parser.mly"
+# 2030 "parsing/parser.mly"
( tys )
-# 5796 "parsing/parser.ml"
+# 5834 "parsing/parser.ml"
in
-# 1793 "parsing/parser.mly"
+# 1883 "parsing/parser.mly"
( Pcl_constr(cid, tys) )
-# 5802 "parsing/parser.ml"
+# 5840 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5812 "parsing/parser.ml"
+# 5850 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1890 "parsing/parser.mly"
( _1 )
-# 5818 "parsing/parser.ml"
+# 5856 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 5877 "parsing/parser.ml"
+# 5915 "parsing/parser.ml"
in
-# 1827 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( _1 )
-# 5882 "parsing/parser.ml"
+# 5920 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 811 "parsing/parser.mly"
+# 877 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 5891 "parsing/parser.ml"
+# 5929 "parsing/parser.ml"
in
-# 1814 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 5897 "parsing/parser.ml"
+# 5935 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 5905 "parsing/parser.ml"
+# 5943 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1795 "parsing/parser.mly"
+# 1885 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 5913 "parsing/parser.ml"
+# 5951 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5923 "parsing/parser.ml"
+# 5961 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1890 "parsing/parser.mly"
( _1 )
-# 5929 "parsing/parser.ml"
+# 5967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.class_expr) = let _1 =
let _1 =
-# 1797 "parsing/parser.mly"
+# 1887 "parsing/parser.mly"
( Pcl_constraint(_2, _4) )
-# 5983 "parsing/parser.ml"
+# 6021 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 5992 "parsing/parser.ml"
+# 6030 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1890 "parsing/parser.mly"
( _1 )
-# 5998 "parsing/parser.ml"
+# 6036 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1799 "parsing/parser.mly"
+# 1889 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 6055 "parsing/parser.ml"
+# 6093 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 870 "parsing/parser.mly"
+# 936 "parsing/parser.mly"
( mkclass ~loc:_sloc _1 )
-# 6065 "parsing/parser.ml"
+# 6103 "parsing/parser.ml"
in
-# 1800 "parsing/parser.mly"
+# 1890 "parsing/parser.mly"
( _1 )
-# 6071 "parsing/parser.ml"
+# 6109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 6128 "parsing/parser.ml"
+# 6166 "parsing/parser.ml"
in
-# 1827 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( _1 )
-# 6133 "parsing/parser.ml"
+# 6171 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 811 "parsing/parser.mly"
+# 877 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 6142 "parsing/parser.ml"
+# 6180 "parsing/parser.ml"
in
-# 1814 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 6148 "parsing/parser.ml"
+# 6186 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 6156 "parsing/parser.ml"
+# 6194 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1802 "parsing/parser.mly"
+# 1892 "parsing/parser.mly"
( mkclass ~loc:_sloc ~attrs:_2 (Pcl_structure _3) )
-# 6165 "parsing/parser.ml"
+# 6203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.class_type) =
-# 1905 "parsing/parser.mly"
+# 1995 "parsing/parser.mly"
( _1 )
-# 6190 "parsing/parser.ml"
+# 6228 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3243 "parsing/parser.mly"
+# 3327 "parsing/parser.mly"
( Optional label )
-# 6238 "parsing/parser.ml"
+# 6276 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 2001 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6243 "parsing/parser.ml"
+# 6281 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6253 "parsing/parser.ml"
+# 6291 "parsing/parser.ml"
in
-# 1912 "parsing/parser.mly"
+# 2002 "parsing/parser.mly"
( _1 )
-# 6259 "parsing/parser.ml"
+# 6297 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let domain : (Parsetree.core_type) = Obj.magic domain in
let _2 : unit = Obj.magic _2 in
let label : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 6308 "parsing/parser.ml"
+# 6346 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3245 "parsing/parser.mly"
+# 3329 "parsing/parser.mly"
( Labelled label )
-# 6318 "parsing/parser.ml"
+# 6356 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 2001 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6323 "parsing/parser.ml"
+# 6361 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6333 "parsing/parser.ml"
+# 6371 "parsing/parser.ml"
in
-# 1912 "parsing/parser.mly"
+# 2002 "parsing/parser.mly"
( _1 )
-# 6339 "parsing/parser.ml"
+# 6377 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type) = let _1 =
let _1 =
let label =
-# 3247 "parsing/parser.mly"
+# 3331 "parsing/parser.mly"
( Nolabel )
-# 6380 "parsing/parser.ml"
+# 6418 "parsing/parser.ml"
in
-# 1911 "parsing/parser.mly"
+# 2001 "parsing/parser.mly"
( Pcty_arrow(label, domain, codomain) )
-# 6385 "parsing/parser.ml"
+# 6423 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_domain_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 864 "parsing/parser.mly"
+# 930 "parsing/parser.mly"
( mkcty ~loc:_sloc _1 )
-# 6395 "parsing/parser.ml"
+# 6433 "parsing/parser.ml"
in
-# 1912 "parsing/parser.mly"
+# 2002 "parsing/parser.mly"
( _1 )
-# 6401 "parsing/parser.ml"
+# 6439 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _8 : unit = Obj.magic _8 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 6486 "parsing/parser.ml"
+# 6524 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 6504 "parsing/parser.ml"
+# 6542 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 6516 "parsing/parser.ml"
+# 6554 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 6524 "parsing/parser.ml"
+# 6562 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2050 "parsing/parser.mly"
+# 2140 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id csig ~virt ~params ~attrs ~loc ~docs
)
-# 6539 "parsing/parser.ml"
+# 6577 "parsing/parser.ml"
in
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 6545 "parsing/parser.ml"
+# 6583 "parsing/parser.ml"
in
-# 2038 "parsing/parser.mly"
+# 2128 "parsing/parser.mly"
( _1 )
-# 6551 "parsing/parser.ml"
+# 6589 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3532 "parsing/parser.mly"
+# 3616 "parsing/parser.mly"
( _1 )
-# 6576 "parsing/parser.ml"
+# 6614 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 637 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * char option)
-# 6597 "parsing/parser.ml"
+# 6635 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3415 "parsing/parser.mly"
+# 3499 "parsing/parser.mly"
( let (n, m) = _1 in Pconst_integer (n, m) )
-# 6605 "parsing/parser.ml"
+# 6643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 596 "parsing/parser.mly"
+# 650 "parsing/parser.mly"
(char)
-# 6626 "parsing/parser.ml"
+# 6664 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3416 "parsing/parser.mly"
+# 3500 "parsing/parser.mly"
( Pconst_char _1 )
-# 6634 "parsing/parser.ml"
+# 6672 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 689 "parsing/parser.mly"
+# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 6655 "parsing/parser.ml"
+# 6693 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3417 "parsing/parser.mly"
+# 3501 "parsing/parser.mly"
( let (s, strloc, d) = _1 in Pconst_string (s, strloc, d) )
-# 6663 "parsing/parser.ml"
+# 6701 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 616 "parsing/parser.mly"
+# 670 "parsing/parser.mly"
(string * char option)
-# 6684 "parsing/parser.ml"
+# 6722 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3418 "parsing/parser.mly"
+# 3502 "parsing/parser.mly"
( let (f, m) = _1 in Pconst_float (f, m) )
-# 6692 "parsing/parser.ml"
+# 6730 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3489 "parsing/parser.mly"
+# 3573 "parsing/parser.mly"
( "[]" )
-# 6724 "parsing/parser.ml"
+# 6762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3490 "parsing/parser.mly"
+# 3574 "parsing/parser.mly"
( "()" )
-# 6756 "parsing/parser.ml"
+# 6794 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3491 "parsing/parser.mly"
+# 3575 "parsing/parser.mly"
( "false" )
-# 6781 "parsing/parser.ml"
+# 6819 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3492 "parsing/parser.mly"
+# 3576 "parsing/parser.mly"
( "true" )
-# 6806 "parsing/parser.ml"
+# 6844 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 6827 "parsing/parser.ml"
+# 6865 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3495 "parsing/parser.mly"
+# 3579 "parsing/parser.mly"
( _1 )
-# 6835 "parsing/parser.ml"
+# 6873 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) = let _1 =
-# 3486 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( "::" )
-# 6874 "parsing/parser.ml"
+# 6912 "parsing/parser.ml"
in
-# 3496 "parsing/parser.mly"
+# 3580 "parsing/parser.mly"
( _1 )
-# 6879 "parsing/parser.ml"
+# 6917 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3497 "parsing/parser.mly"
+# 3581 "parsing/parser.mly"
( _1 )
-# 6904 "parsing/parser.ml"
+# 6942 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3500 "parsing/parser.mly"
+# 3584 "parsing/parser.mly"
( _1 )
-# 6929 "parsing/parser.ml"
+# 6967 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
-# 3486 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( "::" )
-# 6984 "parsing/parser.ml"
+# 7022 "parsing/parser.ml"
in
-# 3501 "parsing/parser.mly"
+# 3585 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 6990 "parsing/parser.ml"
+# 7028 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
-# 3486 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( "::" )
-# 7029 "parsing/parser.ml"
+# 7067 "parsing/parser.ml"
in
-# 3502 "parsing/parser.mly"
+# 3586 "parsing/parser.mly"
( Lident _1 )
-# 7034 "parsing/parser.ml"
+# 7072 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3503 "parsing/parser.mly"
+# 3587 "parsing/parser.mly"
( Lident _1 )
-# 7059 "parsing/parser.ml"
+# 7097 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.core_type * Parsetree.core_type) =
-# 1994 "parsing/parser.mly"
+# 2084 "parsing/parser.mly"
( _1, _3 )
-# 7098 "parsing/parser.ml"
+# 7136 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 7125 "parsing/parser.ml"
+# 7163 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7130 "parsing/parser.ml"
+# 7168 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 7136 "parsing/parser.ml"
+# 7174 "parsing/parser.ml"
in
-# 3050 "parsing/parser.mly"
+# 3130 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7142 "parsing/parser.ml"
+# 7180 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.constructor_arguments) = let tys =
let xs =
let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 7183 "parsing/parser.ml"
+# 7221 "parsing/parser.ml"
in
# 253 "<standard.mly>"
( List.rev xs )
-# 7188 "parsing/parser.ml"
+# 7226 "parsing/parser.ml"
in
-# 955 "parsing/parser.mly"
+# 1021 "parsing/parser.mly"
( xs )
-# 7194 "parsing/parser.ml"
+# 7232 "parsing/parser.ml"
in
-# 3050 "parsing/parser.mly"
+# 3130 "parsing/parser.mly"
( Pcstr_tuple tys )
-# 7200 "parsing/parser.ml"
+# 7238 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.constructor_arguments) =
-# 3052 "parsing/parser.mly"
+# 3132 "parsing/parser.mly"
( Pcstr_record _2 )
-# 7239 "parsing/parser.ml"
+# 7277 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constructor_declaration list) =
-# 2971 "parsing/parser.mly"
+# 3051 "parsing/parser.mly"
( [] )
-# 7264 "parsing/parser.ml"
+# 7302 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.constructor_declaration list) = let cs =
-# 1040 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( List.rev xs )
-# 7289 "parsing/parser.ml"
+# 7327 "parsing/parser.ml"
in
-# 2973 "parsing/parser.mly"
+# 3053 "parsing/parser.mly"
( cs )
-# 7294 "parsing/parser.ml"
+# 7332 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 7319 "parsing/parser.ml"
+# 7357 "parsing/parser.ml"
in
-# 3195 "parsing/parser.mly"
+# 3279 "parsing/parser.mly"
( _1 )
-# 7324 "parsing/parser.ml"
+# 7362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type) =
-# 3197 "parsing/parser.mly"
+# 3281 "parsing/parser.mly"
( Typ.attr _1 _2 )
-# 7356 "parsing/parser.ml"
+# 7394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3594 "parsing/parser.mly"
+# 3682 "parsing/parser.mly"
( Upto )
-# 7381 "parsing/parser.ml"
+# 7419 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.direction_flag) =
-# 3595 "parsing/parser.mly"
+# 3683 "parsing/parser.mly"
( Downto )
-# 7406 "parsing/parser.ml"
+# 7444 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2141 "parsing/parser.mly"
+# 2251 "parsing/parser.mly"
( _1 )
-# 7431 "parsing/parser.ml"
+# 7469 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7511 "parsing/parser.ml"
+# 7549 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7521 "parsing/parser.ml"
+# 7559 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 7527 "parsing/parser.ml"
+# 7565 "parsing/parser.ml"
in
-# 2189 "parsing/parser.mly"
+# 2284 "parsing/parser.mly"
( Pexp_letmodule(_4, _5, _7), _3 )
-# 7533 "parsing/parser.ml"
+# 7571 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7544 "parsing/parser.ml"
+# 7582 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7630 "parsing/parser.ml"
+# 7668 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 7641 "parsing/parser.ml"
+# 7679 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3035 "parsing/parser.mly"
+# 3115 "parsing/parser.mly"
( let args, res = _2 in
Te.decl _1 ~args ?res ~attrs:_3 ~loc:(make_loc _sloc) )
-# 7651 "parsing/parser.ml"
+# 7689 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7661 "parsing/parser.ml"
+# 7699 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 7667 "parsing/parser.ml"
+# 7705 "parsing/parser.ml"
in
-# 2191 "parsing/parser.mly"
+# 2286 "parsing/parser.mly"
( Pexp_letexception(_4, _6), _3 )
-# 7673 "parsing/parser.ml"
+# 7711 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7684 "parsing/parser.ml"
+# 7722 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7756 "parsing/parser.ml"
+# 7794 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 7762 "parsing/parser.ml"
+# 7800 "parsing/parser.ml"
in
let _3 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 7768 "parsing/parser.ml"
+# 7806 "parsing/parser.ml"
in
-# 2193 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, _7), _4 )
-# 7775 "parsing/parser.ml"
+# 7813 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7786 "parsing/parser.ml"
+# 7824 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7865 "parsing/parser.ml"
+# 7903 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 7871 "parsing/parser.ml"
+# 7909 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 7879 "parsing/parser.ml"
+# 7917 "parsing/parser.ml"
in
-# 2193 "parsing/parser.mly"
+# 2288 "parsing/parser.mly"
( let open_loc = make_loc (_startpos__2_, _endpos__5_) in
let od = Opn.mk _5 ~override:_3 ~loc:open_loc in
Pexp_open(od, _7), _4 )
-# 7887 "parsing/parser.ml"
+# 7925 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7898 "parsing/parser.ml"
+# 7936 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 7947 "parsing/parser.ml"
+# 7985 "parsing/parser.ml"
in
-# 1012 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
( xs )
-# 7952 "parsing/parser.ml"
+# 7990 "parsing/parser.ml"
in
-# 2521 "parsing/parser.mly"
+# 2598 "parsing/parser.mly"
( xs )
-# 7958 "parsing/parser.ml"
+# 7996 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 7968 "parsing/parser.ml"
+# 8006 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 7974 "parsing/parser.ml"
+# 8012 "parsing/parser.ml"
in
-# 2197 "parsing/parser.mly"
+# 2292 "parsing/parser.mly"
( Pexp_function _3, _2 )
-# 7980 "parsing/parser.ml"
+# 8018 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 7991 "parsing/parser.ml"
+# 8029 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8049 "parsing/parser.ml"
+# 8087 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8055 "parsing/parser.ml"
+# 8093 "parsing/parser.ml"
in
-# 2199 "parsing/parser.mly"
+# 2294 "parsing/parser.mly"
( let (l,o,p) = _3 in
Pexp_fun(l, o, p, _4), _2 )
-# 8062 "parsing/parser.ml"
+# 8100 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8073 "parsing/parser.ml"
+# 8111 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__7_ in
let _v : (Parsetree.expression) = let _1 =
let _5 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 8148 "parsing/parser.ml"
+# 8186 "parsing/parser.ml"
in
let _2 =
let (_1_inlined1, _1) = (_1_inlined2, _1_inlined1) in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8157 "parsing/parser.ml"
+# 8195 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8163 "parsing/parser.ml"
+# 8201 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2202 "parsing/parser.mly"
+# 2297 "parsing/parser.mly"
( (mk_newtypes ~loc:_sloc _5 _7).pexp_desc, _2 )
-# 8172 "parsing/parser.ml"
+# 8210 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8183 "parsing/parser.ml"
+# 8221 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8246 "parsing/parser.ml"
+# 8284 "parsing/parser.ml"
in
-# 1012 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
( xs )
-# 8251 "parsing/parser.ml"
+# 8289 "parsing/parser.ml"
in
-# 2521 "parsing/parser.mly"
+# 2598 "parsing/parser.mly"
( xs )
-# 8257 "parsing/parser.ml"
+# 8295 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8267 "parsing/parser.ml"
+# 8305 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8273 "parsing/parser.ml"
+# 8311 "parsing/parser.ml"
in
-# 2204 "parsing/parser.mly"
+# 2299 "parsing/parser.mly"
( Pexp_match(_3, _5), _2 )
-# 8279 "parsing/parser.ml"
+# 8317 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8290 "parsing/parser.ml"
+# 8328 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 8353 "parsing/parser.ml"
+# 8391 "parsing/parser.ml"
in
-# 1012 "parsing/parser.mly"
+# 1078 "parsing/parser.mly"
( xs )
-# 8358 "parsing/parser.ml"
+# 8396 "parsing/parser.ml"
in
-# 2521 "parsing/parser.mly"
+# 2598 "parsing/parser.mly"
( xs )
-# 8364 "parsing/parser.ml"
+# 8402 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8374 "parsing/parser.ml"
+# 8412 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8380 "parsing/parser.ml"
+# 8418 "parsing/parser.ml"
in
-# 2206 "parsing/parser.mly"
+# 2301 "parsing/parser.mly"
( Pexp_try(_3, _5), _2 )
-# 8386 "parsing/parser.ml"
+# 8424 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8397 "parsing/parser.ml"
+# 8435 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8462 "parsing/parser.ml"
+# 8500 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8468 "parsing/parser.ml"
+# 8506 "parsing/parser.ml"
in
-# 2208 "parsing/parser.mly"
+# 2303 "parsing/parser.mly"
( syntax_error() )
-# 8474 "parsing/parser.ml"
+# 8512 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8485 "parsing/parser.ml"
+# 8523 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8564 "parsing/parser.ml"
+# 8602 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8570 "parsing/parser.ml"
+# 8608 "parsing/parser.ml"
in
-# 2210 "parsing/parser.mly"
+# 2305 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, Some _7), _2 )
-# 8576 "parsing/parser.ml"
+# 8614 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8587 "parsing/parser.ml"
+# 8625 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8652 "parsing/parser.ml"
+# 8690 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8658 "parsing/parser.ml"
+# 8696 "parsing/parser.ml"
in
-# 2212 "parsing/parser.mly"
+# 2307 "parsing/parser.mly"
( Pexp_ifthenelse(_3, _5, None), _2 )
-# 8664 "parsing/parser.ml"
+# 8702 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8675 "parsing/parser.ml"
+# 8713 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8747 "parsing/parser.ml"
+# 8785 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8753 "parsing/parser.ml"
+# 8791 "parsing/parser.ml"
in
-# 2214 "parsing/parser.mly"
+# 2309 "parsing/parser.mly"
( Pexp_while(_3, _5), _2 )
-# 8759 "parsing/parser.ml"
+# 8797 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8770 "parsing/parser.ml"
+# 8808 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8870 "parsing/parser.ml"
+# 8908 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8876 "parsing/parser.ml"
+# 8914 "parsing/parser.ml"
in
-# 2217 "parsing/parser.mly"
+# 2312 "parsing/parser.mly"
( Pexp_for(_3, _5, _7, _6, _9), _2 )
-# 8882 "parsing/parser.ml"
+# 8920 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__10_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8893 "parsing/parser.ml"
+# 8931 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 8944 "parsing/parser.ml"
+# 8982 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 8950 "parsing/parser.ml"
+# 8988 "parsing/parser.ml"
in
-# 2219 "parsing/parser.mly"
+# 2314 "parsing/parser.mly"
( Pexp_assert _3, _2 )
-# 8956 "parsing/parser.ml"
+# 8994 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 8967 "parsing/parser.ml"
+# 9005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 9018 "parsing/parser.ml"
+# 9056 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 9024 "parsing/parser.ml"
+# 9062 "parsing/parser.ml"
in
-# 2221 "parsing/parser.mly"
+# 2316 "parsing/parser.mly"
( Pexp_lazy _3, _2 )
-# 9030 "parsing/parser.ml"
+# 9068 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9041 "parsing/parser.ml"
+# 9079 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 9106 "parsing/parser.ml"
+# 9144 "parsing/parser.ml"
in
-# 1827 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( _1 )
-# 9111 "parsing/parser.ml"
+# 9149 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 811 "parsing/parser.mly"
+# 877 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9120 "parsing/parser.ml"
+# 9158 "parsing/parser.ml"
in
-# 1814 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9126 "parsing/parser.ml"
+# 9164 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 9136 "parsing/parser.ml"
+# 9174 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 9142 "parsing/parser.ml"
+# 9180 "parsing/parser.ml"
in
-# 2223 "parsing/parser.mly"
+# 2318 "parsing/parser.mly"
( Pexp_object _3, _2 )
-# 9148 "parsing/parser.ml"
+# 9186 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9159 "parsing/parser.ml"
+# 9197 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 9224 "parsing/parser.ml"
+# 9262 "parsing/parser.ml"
in
-# 1827 "parsing/parser.mly"
+# 1917 "parsing/parser.mly"
( _1 )
-# 9229 "parsing/parser.ml"
+# 9267 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 811 "parsing/parser.mly"
+# 877 "parsing/parser.mly"
( extra_cstr _startpos _endpos _1 )
-# 9238 "parsing/parser.ml"
+# 9276 "parsing/parser.ml"
in
-# 1814 "parsing/parser.mly"
+# 1904 "parsing/parser.mly"
( Cstr.mk _1 _2 )
-# 9244 "parsing/parser.ml"
+# 9282 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 9254 "parsing/parser.ml"
+# 9292 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 9260 "parsing/parser.ml"
+# 9298 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2225 "parsing/parser.mly"
+# 2320 "parsing/parser.mly"
( unclosed "object" _loc__1_ "end" _loc__4_ )
-# 9268 "parsing/parser.ml"
+# 9306 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2143 "parsing/parser.mly"
+# 2253 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 9279 "parsing/parser.ml"
+# 9317 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9314 "parsing/parser.ml"
+# 9352 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 9319 "parsing/parser.ml"
+# 9357 "parsing/parser.ml"
in
-# 2229 "parsing/parser.mly"
+# 2324 "parsing/parser.mly"
( Pexp_apply(_1, _2) )
-# 9325 "parsing/parser.ml"
+# 9363 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9335 "parsing/parser.ml"
+# 9373 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9341 "parsing/parser.ml"
+# 9379 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 9370 "parsing/parser.ml"
+# 9408 "parsing/parser.ml"
in
-# 979 "parsing/parser.mly"
+# 1045 "parsing/parser.mly"
( xs )
-# 9375 "parsing/parser.ml"
+# 9413 "parsing/parser.ml"
in
-# 2548 "parsing/parser.mly"
+# 2625 "parsing/parser.mly"
( es )
-# 9381 "parsing/parser.ml"
+# 9419 "parsing/parser.ml"
in
-# 2231 "parsing/parser.mly"
+# 2326 "parsing/parser.mly"
( Pexp_tuple(_1) )
-# 9387 "parsing/parser.ml"
+# 9425 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9397 "parsing/parser.ml"
+# 9435 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9403 "parsing/parser.ml"
+# 9441 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 9441 "parsing/parser.ml"
+# 9479 "parsing/parser.ml"
in
-# 2233 "parsing/parser.mly"
+# 2328 "parsing/parser.mly"
( Pexp_construct(_1, Some _2) )
-# 9447 "parsing/parser.ml"
+# 9485 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9457 "parsing/parser.ml"
+# 9495 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9463 "parsing/parser.ml"
+# 9501 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2235 "parsing/parser.mly"
+# 2330 "parsing/parser.mly"
( Pexp_variant(_1, Some _2) )
-# 9496 "parsing/parser.ml"
+# 9534 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9505 "parsing/parser.ml"
+# 9543 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9511 "parsing/parser.ml"
+# 9549 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 627 "parsing/parser.mly"
+# 681 "parsing/parser.mly"
(string)
-# 9545 "parsing/parser.ml"
+# 9583 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3459 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( op )
-# 9557 "parsing/parser.ml"
+# 9595 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9566 "parsing/parser.ml"
+# 9604 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9572 "parsing/parser.ml"
+# 9610 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9582 "parsing/parser.ml"
+# 9620 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9588 "parsing/parser.ml"
+# 9626 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 628 "parsing/parser.mly"
+# 682 "parsing/parser.mly"
(string)
-# 9622 "parsing/parser.ml"
+# 9660 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3460 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( op )
-# 9634 "parsing/parser.ml"
+# 9672 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9643 "parsing/parser.ml"
+# 9681 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9649 "parsing/parser.ml"
+# 9687 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9659 "parsing/parser.ml"
+# 9697 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9665 "parsing/parser.ml"
+# 9703 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 629 "parsing/parser.mly"
+# 683 "parsing/parser.mly"
(string)
-# 9699 "parsing/parser.ml"
+# 9737 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3461 "parsing/parser.mly"
+# 3545 "parsing/parser.mly"
( op )
-# 9711 "parsing/parser.ml"
+# 9749 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9720 "parsing/parser.ml"
+# 9758 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9726 "parsing/parser.ml"
+# 9764 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9736 "parsing/parser.ml"
+# 9774 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9742 "parsing/parser.ml"
+# 9780 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 630 "parsing/parser.mly"
+# 684 "parsing/parser.mly"
(string)
-# 9776 "parsing/parser.ml"
+# 9814 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3462 "parsing/parser.mly"
+# 3546 "parsing/parser.mly"
( op )
-# 9788 "parsing/parser.ml"
+# 9826 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9797 "parsing/parser.ml"
+# 9835 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9803 "parsing/parser.ml"
+# 9841 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9813 "parsing/parser.ml"
+# 9851 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9819 "parsing/parser.ml"
+# 9857 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let e2 : (Parsetree.expression) = Obj.magic e2 in
let op : (
-# 631 "parsing/parser.mly"
+# 685 "parsing/parser.mly"
(string)
-# 9853 "parsing/parser.ml"
+# 9891 "parsing/parser.ml"
) = Obj.magic op in
let e1 : (Parsetree.expression) = Obj.magic e1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _1 =
let op =
let _1 =
-# 3463 "parsing/parser.mly"
+# 3547 "parsing/parser.mly"
( op )
-# 9865 "parsing/parser.ml"
+# 9903 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_op_, _startpos_op_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9874 "parsing/parser.ml"
+# 9912 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9880 "parsing/parser.ml"
+# 9918 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9890 "parsing/parser.ml"
+# 9928 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9896 "parsing/parser.ml"
+# 9934 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3464 "parsing/parser.mly"
+# 3548 "parsing/parser.mly"
("+")
-# 9938 "parsing/parser.ml"
+# 9976 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 9946 "parsing/parser.ml"
+# 9984 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 9952 "parsing/parser.ml"
+# 9990 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 9962 "parsing/parser.ml"
+# 10000 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 9968 "parsing/parser.ml"
+# 10006 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3465 "parsing/parser.mly"
+# 3549 "parsing/parser.mly"
("+.")
-# 10010 "parsing/parser.ml"
+# 10048 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10018 "parsing/parser.ml"
+# 10056 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10024 "parsing/parser.ml"
+# 10062 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10034 "parsing/parser.ml"
+# 10072 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10040 "parsing/parser.ml"
+# 10078 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3466 "parsing/parser.mly"
+# 3550 "parsing/parser.mly"
("+=")
-# 10082 "parsing/parser.ml"
+# 10120 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10090 "parsing/parser.ml"
+# 10128 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10096 "parsing/parser.ml"
+# 10134 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10106 "parsing/parser.ml"
+# 10144 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10112 "parsing/parser.ml"
+# 10150 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3467 "parsing/parser.mly"
+# 3551 "parsing/parser.mly"
("-")
-# 10154 "parsing/parser.ml"
+# 10192 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10162 "parsing/parser.ml"
+# 10200 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10168 "parsing/parser.ml"
+# 10206 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10178 "parsing/parser.ml"
+# 10216 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10184 "parsing/parser.ml"
+# 10222 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3468 "parsing/parser.mly"
+# 3552 "parsing/parser.mly"
("-.")
-# 10226 "parsing/parser.ml"
+# 10264 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10234 "parsing/parser.ml"
+# 10272 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10240 "parsing/parser.ml"
+# 10278 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10250 "parsing/parser.ml"
+# 10288 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10256 "parsing/parser.ml"
+# 10294 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3469 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
("*")
-# 10298 "parsing/parser.ml"
+# 10336 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10306 "parsing/parser.ml"
+# 10344 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10312 "parsing/parser.ml"
+# 10350 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10322 "parsing/parser.ml"
+# 10360 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10328 "parsing/parser.ml"
+# 10366 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3470 "parsing/parser.mly"
+# 3554 "parsing/parser.mly"
("%")
-# 10370 "parsing/parser.ml"
+# 10408 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10378 "parsing/parser.ml"
+# 10416 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10384 "parsing/parser.ml"
+# 10422 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10394 "parsing/parser.ml"
+# 10432 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10400 "parsing/parser.ml"
+# 10438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3471 "parsing/parser.mly"
+# 3555 "parsing/parser.mly"
("=")
-# 10442 "parsing/parser.ml"
+# 10480 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10450 "parsing/parser.ml"
+# 10488 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10456 "parsing/parser.ml"
+# 10494 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10466 "parsing/parser.ml"
+# 10504 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10472 "parsing/parser.ml"
+# 10510 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3472 "parsing/parser.mly"
+# 3556 "parsing/parser.mly"
("<")
-# 10514 "parsing/parser.ml"
+# 10552 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10522 "parsing/parser.ml"
+# 10560 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10528 "parsing/parser.ml"
+# 10566 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10538 "parsing/parser.ml"
+# 10576 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10544 "parsing/parser.ml"
+# 10582 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3473 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
(">")
-# 10586 "parsing/parser.ml"
+# 10624 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10594 "parsing/parser.ml"
+# 10632 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10600 "parsing/parser.ml"
+# 10638 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10610 "parsing/parser.ml"
+# 10648 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10616 "parsing/parser.ml"
+# 10654 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3474 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
("or")
-# 10658 "parsing/parser.ml"
+# 10696 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10666 "parsing/parser.ml"
+# 10704 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10672 "parsing/parser.ml"
+# 10710 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10682 "parsing/parser.ml"
+# 10720 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10688 "parsing/parser.ml"
+# 10726 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3475 "parsing/parser.mly"
+# 3559 "parsing/parser.mly"
("||")
-# 10730 "parsing/parser.ml"
+# 10768 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10738 "parsing/parser.ml"
+# 10776 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10744 "parsing/parser.ml"
+# 10782 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10754 "parsing/parser.ml"
+# 10792 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10760 "parsing/parser.ml"
+# 10798 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3476 "parsing/parser.mly"
+# 3560 "parsing/parser.mly"
("&")
-# 10802 "parsing/parser.ml"
+# 10840 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10810 "parsing/parser.ml"
+# 10848 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10816 "parsing/parser.ml"
+# 10854 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10826 "parsing/parser.ml"
+# 10864 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10832 "parsing/parser.ml"
+# 10870 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3477 "parsing/parser.mly"
+# 3561 "parsing/parser.mly"
("&&")
-# 10874 "parsing/parser.ml"
+# 10912 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10882 "parsing/parser.ml"
+# 10920 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10888 "parsing/parser.ml"
+# 10926 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10898 "parsing/parser.ml"
+# 10936 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10904 "parsing/parser.ml"
+# 10942 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let op =
let _1 =
-# 3478 "parsing/parser.mly"
+# 3562 "parsing/parser.mly"
(":=")
-# 10946 "parsing/parser.ml"
+# 10984 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 10954 "parsing/parser.ml"
+# 10992 "parsing/parser.ml"
in
-# 2237 "parsing/parser.mly"
+# 2332 "parsing/parser.mly"
( mkinfix e1 op e2 )
-# 10960 "parsing/parser.ml"
+# 10998 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_e2_, _startpos_e1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 10970 "parsing/parser.ml"
+# 11008 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 10976 "parsing/parser.ml"
+# 11014 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2239 "parsing/parser.mly"
+# 2334 "parsing/parser.mly"
( mkuminus ~oploc:_loc__1_ _1 _2 )
-# 11011 "parsing/parser.ml"
+# 11049 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11021 "parsing/parser.ml"
+# 11059 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 11027 "parsing/parser.ml"
+# 11065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2241 "parsing/parser.mly"
+# 2336 "parsing/parser.mly"
( mkuplus ~oploc:_loc__1_ _1 _2 )
-# 11062 "parsing/parser.ml"
+# 11100 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 11072 "parsing/parser.ml"
+# 11110 "parsing/parser.ml"
in
-# 2146 "parsing/parser.mly"
+# 2256 "parsing/parser.mly"
( _1 )
-# 11078 "parsing/parser.ml"
+# 11116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2148 "parsing/parser.mly"
+# 2258 "parsing/parser.mly"
( expr_of_let_bindings ~loc:_sloc _1 _3 )
-# 11120 "parsing/parser.ml"
+# 11158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : unit = Obj.magic _3 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _1 : (
-# 633 "parsing/parser.mly"
+# 687 "parsing/parser.mly"
(string)
-# 11162 "parsing/parser.ml"
+# 11200 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11174 "parsing/parser.ml"
+# 11212 "parsing/parser.ml"
in
let _startpos_pbop_op_ = _startpos__1_ in
let _symbolstartpos = _startpos_pbop_op_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2150 "parsing/parser.mly"
+# 2260 "parsing/parser.mly"
( let (pbop_pat, pbop_exp, rev_ands) = bindings in
let ands = List.rev rev_ands in
let pbop_loc = make_loc _sloc in
let let_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
mkexp ~loc:_sloc (Pexp_letop{ let_; ands; body}) )
-# 11188 "parsing/parser.ml"
+# 11226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2156 "parsing/parser.mly"
+# 2266 "parsing/parser.mly"
( mkexp_cons ~loc:_sloc _loc__2_ (ghexp ~loc:_sloc (Pexp_tuple[_1;_3])) )
-# 11231 "parsing/parser.ml"
+# 11269 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 11266 "parsing/parser.ml"
+# 11304 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 11275 "parsing/parser.ml"
+# 11313 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11283 "parsing/parser.ml"
+# 11321 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2158 "parsing/parser.mly"
+# 2268 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setinstvar(_1, _3)) )
-# 11292 "parsing/parser.ml"
+# 11330 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 11350 "parsing/parser.ml"
+# 11388 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2160 "parsing/parser.mly"
+# 2270 "parsing/parser.mly"
( mkexp ~loc:_sloc (Pexp_setfield(_1, _3, _5)) )
-# 11359 "parsing/parser.ml"
+# 11397 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let i : (Parsetree.expression) = Obj.magic i in
let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2271 "parsing/parser.mly"
+ (Some v)
+# 11465 "parsing/parser.ml"
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 11470 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2162 "parsing/parser.mly"
- ( array_set ~loc:_sloc _1 _4 _7 )
-# 11429 "parsing/parser.ml"
+# 2272 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 11480 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
+ let _5 : unit = Obj.magic _5 in
+ let i : (Parsetree.expression) = Obj.magic i in
+ let _3 : unit = Obj.magic _3 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2271 "parsing/parser.mly"
+ (Some v)
+# 11548 "parsing/parser.ml"
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 11553 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 2272 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 11563 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
+ let _5 : unit = Obj.magic _5 in
+ let i : (Parsetree.expression) = Obj.magic i in
+ let _3 : unit = Obj.magic _3 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2271 "parsing/parser.mly"
+ (Some v)
+# 11631 "parsing/parser.ml"
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 11636 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 2272 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 11646 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _2 : (
+# 686 "parsing/parser.mly"
+ (string)
+# 11708 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 11718 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
+ ( es )
+# 11723 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 11729 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 11734 "parsing/parser.ml"
+
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 11740 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2164 "parsing/parser.mly"
- ( string_set ~loc:_sloc _1 _4 _7 )
-# 11499 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 11750 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.startp = _startpos__2_;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _2 : (
+# 686 "parsing/parser.mly"
+ (string)
+# 11824 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__7_ in
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+ let _1 = _1_inlined1 in
+
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 11838 "parsing/parser.ml"
+
+ in
+ let i =
+# 2665 "parsing/parser.mly"
+ ( es )
+# 11844 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 11852 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 11857 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 11863 "parsing/parser.ml"
+
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 11869 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2166 "parsing/parser.mly"
- ( bigarray_set ~loc:_sloc _1 _4 _7 )
-# 11569 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 11879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
let _5 : unit = Obj.magic _5 in
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 11631 "parsing/parser.ml"
+# 11941 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 11951 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 11640 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
+# 11956 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 11962 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 11967 "parsing/parser.ml"
+
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 11973 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2168 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc lident bracket _2 _1 _4 _7 )
-# 11648 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 11983 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.startp = _startpos__2_;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _5 : unit = Obj.magic _5 in
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 11710 "parsing/parser.ml"
+# 12057 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+ let _1 = _1_inlined1 in
+
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 12071 "parsing/parser.ml"
+
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 11719 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
+# 12077 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 12085 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 12090 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 12096 "parsing/parser.ml"
+
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 12102 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2170 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc lident paren _2 _1 _4 _7 )
-# 11727 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 12112 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _6;
- MenhirLib.EngineTypes.startp = _startpos__6_;
- MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _5;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : (Parsetree.expression) = Obj.magic _7 in
- let _6 : unit = Obj.magic _6 in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1 : unit = Obj.magic _1 in
let _5 : unit = Obj.magic _5 in
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 11789 "parsing/parser.ml"
+# 12174 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
- ( es )
-# 11798 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 2172 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc lident brace _2 _1 _4 _7 )
-# 11806 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _9;
- MenhirLib.EngineTypes.startp = _startpos__9_;
- MenhirLib.EngineTypes.endp = _endpos__9_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _8;
- MenhirLib.EngineTypes.startp = _startpos__8_;
- MenhirLib.EngineTypes.endp = _endpos__8_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = es;
- MenhirLib.EngineTypes.startp = _startpos_es_;
- MenhirLib.EngineTypes.endp = _endpos_es_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- };
- };
- };
- };
- } = _menhir_stack in
- let _9 : (Parsetree.expression) = Obj.magic _9 in
- let _8 : unit = Obj.magic _8 in
- let _7 : unit = Obj.magic _7 in
- let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
- (string)
-# 11880 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 12184 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 11891 "parsing/parser.ml"
- in
- let _endpos = _endpos__9_ in
+# 12189 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 12195 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 12200 "parsing/parser.ml"
+
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 12206 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2175 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (ldot _3) bracket _4 _1 _6 _9 )
-# 11899 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 12216 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _9;
- MenhirLib.EngineTypes.startp = _startpos__9_;
- MenhirLib.EngineTypes.endp = _endpos__9_;
+ MenhirLib.EngineTypes.semv = v;
+ MenhirLib.EngineTypes.startp = _startpos_v_;
+ MenhirLib.EngineTypes.endp = _endpos_v_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _8;
- MenhirLib.EngineTypes.startp = _startpos__8_;
- MenhirLib.EngineTypes.endp = _endpos__8_;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _9 : (Parsetree.expression) = Obj.magic _9 in
- let _8 : unit = Obj.magic _8 in
- let _7 : unit = Obj.magic _7 in
- let es : (Parsetree.expression list) = Obj.magic es in
+ let v : (Parsetree.expression) = Obj.magic v in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
- (string)
-# 11973 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
- ( es )
-# 11984 "parsing/parser.ml"
- in
- let _endpos = _endpos__9_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
-
-# 2178 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (ldot _3) paren _4 _1 _6 _9 )
-# 11992 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _9;
- MenhirLib.EngineTypes.startp = _startpos__9_;
- MenhirLib.EngineTypes.endp = _endpos__9_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _8;
- MenhirLib.EngineTypes.startp = _startpos__8_;
- MenhirLib.EngineTypes.endp = _endpos__8_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = es;
- MenhirLib.EngineTypes.startp = _startpos_es_;
- MenhirLib.EngineTypes.endp = _endpos_es_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- };
- };
- };
- };
- } = _menhir_stack in
- let _9 : (Parsetree.expression) = Obj.magic _9 in
- let _8 : unit = Obj.magic _8 in
- let _7 : unit = Obj.magic _7 in
let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let _3 : unit = Obj.magic _3 in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 12066 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+# 12290 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__9_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos_v_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+ let _1 = _1_inlined1 in
+
+# 2273 "parsing/parser.mly"
+ (Some v)
+# 12304 "parsing/parser.ml"
+
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 12077 "parsing/parser.ml"
- in
- let _endpos = _endpos__9_ in
+# 12310 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 12318 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 12323 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 12329 "parsing/parser.ml"
+
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 12335 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos_v_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2181 "parsing/parser.mly"
- ( dotop_set ~loc:_sloc (ldot _3) brace _4 _1 _6 _9 )
-# 12085 "parsing/parser.ml"
+# 2274 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 12345 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2183 "parsing/parser.mly"
+# 2276 "parsing/parser.mly"
( Exp.attr _1 _2 )
-# 12117 "parsing/parser.ml"
+# 12377 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2185 "parsing/parser.mly"
+# 2279 "parsing/parser.mly"
( not_expecting _loc__1_ "wildcard \"_\"" )
-# 12143 "parsing/parser.ml"
+# 12403 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string Asttypes.loc option) =
-# 3750 "parsing/parser.mly"
+# 3838 "parsing/parser.mly"
( None )
-# 12161 "parsing/parser.ml"
+# 12421 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string Asttypes.loc option) =
-# 3751 "parsing/parser.mly"
+# 3839 "parsing/parser.mly"
( Some _2 )
-# 12193 "parsing/parser.ml"
+# 12453 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3761 "parsing/parser.mly"
+# 3851 "parsing/parser.mly"
( (_2, _3) )
-# 12239 "parsing/parser.ml"
+# 12499 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 691 "parsing/parser.mly"
- (string * Location.t * string * Location.t * string option)
-# 12260 "parsing/parser.ml"
+# 745 "parsing/parser.mly"
+ (string * Location.t * string * Location.t * string option)
+# 12520 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3763 "parsing/parser.mly"
+# 3853 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 12271 "parsing/parser.ml"
+# 12531 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 12326 "parsing/parser.ml"
+# 12586 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12338 "parsing/parser.ml"
+# 12598 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12349 "parsing/parser.ml"
+# 12609 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3119 "parsing/parser.mly"
+# 3199 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12359 "parsing/parser.ml"
+# 12619 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.extension_constructor) = let attrs =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 12407 "parsing/parser.ml"
+# 12667 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12419 "parsing/parser.ml"
+# 12679 "parsing/parser.ml"
in
let cid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 12429 "parsing/parser.ml"
+# 12689 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3570 "parsing/parser.mly"
+# 3656 "parsing/parser.mly"
( () )
-# 12436 "parsing/parser.ml"
+# 12696 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3119 "parsing/parser.mly"
+# 3199 "parsing/parser.mly"
( let info = symbol_info _endpos in
Te.rebind cid lid ~attrs ~loc:(make_loc _sloc) ~info )
-# 12445 "parsing/parser.ml"
+# 12705 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3738 "parsing/parser.mly"
+# 3826 "parsing/parser.mly"
( mark_symbol_docs _sloc;
Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 12495 "parsing/parser.ml"
+# 12755 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let params =
-# 1934 "parsing/parser.mly"
+# 2024 "parsing/parser.mly"
( [] )
-# 12513 "parsing/parser.ml"
+# 12773 "parsing/parser.ml"
in
-# 1759 "parsing/parser.mly"
+# 1849 "parsing/parser.mly"
( params )
-# 12518 "parsing/parser.ml"
+# 12778 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 12559 "parsing/parser.ml"
+# 12819 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 12564 "parsing/parser.ml"
+# 12824 "parsing/parser.ml"
in
-# 1936 "parsing/parser.mly"
+# 2026 "parsing/parser.mly"
( params )
-# 12570 "parsing/parser.ml"
+# 12830 "parsing/parser.ml"
in
-# 1759 "parsing/parser.mly"
+# 1849 "parsing/parser.mly"
( params )
-# 12576 "parsing/parser.ml"
+# 12836 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2507 "parsing/parser.mly"
+# 2584 "parsing/parser.mly"
( _1 )
-# 12601 "parsing/parser.ml"
+# 12861 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2509 "parsing/parser.mly"
+# 2586 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _3 _1 )
-# 12643 "parsing/parser.ml"
+# 12903 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2533 "parsing/parser.mly"
+# 2610 "parsing/parser.mly"
( _2 )
-# 12675 "parsing/parser.ml"
+# 12935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__4_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2535 "parsing/parser.mly"
+# 2612 "parsing/parser.mly"
( Pexp_constraint (_4, _2) )
-# 12722 "parsing/parser.ml"
+# 12982 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 12731 "parsing/parser.ml"
+# 12991 "parsing/parser.ml"
in
-# 2536 "parsing/parser.mly"
+# 2613 "parsing/parser.mly"
( _1 )
-# 12737 "parsing/parser.ml"
+# 12997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2539 "parsing/parser.mly"
+# 2616 "parsing/parser.mly"
(
let (l,o,p) = _1 in
ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2))
)
-# 12775 "parsing/parser.ml"
+# 13035 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 12828 "parsing/parser.ml"
+# 13088 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2544 "parsing/parser.mly"
+# 2621 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 12836 "parsing/parser.ml"
+# 13096 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3231 "parsing/parser.mly"
+# 3315 "parsing/parser.mly"
( ty )
-# 12861 "parsing/parser.ml"
+# 13121 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 815 "parsing/parser.mly"
+# 881 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 12909 "parsing/parser.ml"
+# 13169 "parsing/parser.ml"
in
let label =
-# 3243 "parsing/parser.mly"
+# 3327 "parsing/parser.mly"
( Optional label )
-# 12914 "parsing/parser.ml"
+# 13174 "parsing/parser.ml"
in
-# 3237 "parsing/parser.mly"
+# 3321 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 12919 "parsing/parser.ml"
+# 13179 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 12929 "parsing/parser.ml"
+# 13189 "parsing/parser.ml"
in
-# 3239 "parsing/parser.mly"
+# 3323 "parsing/parser.mly"
( _1 )
-# 12935 "parsing/parser.ml"
+# 13195 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 : (Parsetree.core_type) = Obj.magic _1 in
let _2 : unit = Obj.magic _2 in
let label : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 12984 "parsing/parser.ml"
+# 13244 "parsing/parser.ml"
) = Obj.magic label in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_label_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 815 "parsing/parser.mly"
+# 881 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 12994 "parsing/parser.ml"
+# 13254 "parsing/parser.ml"
in
let label =
-# 3245 "parsing/parser.mly"
+# 3329 "parsing/parser.mly"
( Labelled label )
-# 12999 "parsing/parser.ml"
+# 13259 "parsing/parser.ml"
in
-# 3237 "parsing/parser.mly"
+# 3321 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13004 "parsing/parser.ml"
+# 13264 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_codomain_, _startpos_label_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13014 "parsing/parser.ml"
+# 13274 "parsing/parser.ml"
in
-# 3239 "parsing/parser.mly"
+# 3323 "parsing/parser.mly"
( _1 )
-# 13020 "parsing/parser.ml"
+# 13280 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let domain =
-# 815 "parsing/parser.mly"
+# 881 "parsing/parser.mly"
( extra_rhs_core_type _1 ~pos:_endpos__1_ )
-# 13061 "parsing/parser.ml"
+# 13321 "parsing/parser.ml"
in
let label =
-# 3247 "parsing/parser.mly"
+# 3331 "parsing/parser.mly"
( Nolabel )
-# 13066 "parsing/parser.ml"
+# 13326 "parsing/parser.ml"
in
-# 3237 "parsing/parser.mly"
+# 3321 "parsing/parser.mly"
( Ptyp_arrow(label, domain, codomain) )
-# 13071 "parsing/parser.ml"
+# 13331 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_codomain_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 13081 "parsing/parser.ml"
+# 13341 "parsing/parser.ml"
in
-# 3239 "parsing/parser.mly"
+# 3323 "parsing/parser.mly"
( _1 )
-# 13087 "parsing/parser.ml"
+# 13347 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Lexing.position * Parsetree.functor_parameter) = let _startpos = _startpos__1_ in
-# 1190 "parsing/parser.mly"
+# 1261 "parsing/parser.mly"
( _startpos, Unit )
-# 13120 "parsing/parser.ml"
+# 13380 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13178 "parsing/parser.ml"
+# 13438 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 1193 "parsing/parser.mly"
+# 1264 "parsing/parser.mly"
( _startpos, Named (x, mty) )
-# 13185 "parsing/parser.ml"
+# 13445 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3039 "parsing/parser.mly"
+# 3119 "parsing/parser.mly"
( (Pcstr_tuple [],None) )
-# 13203 "parsing/parser.ml"
+# 13463 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3040 "parsing/parser.mly"
+# 3120 "parsing/parser.mly"
( (_2,None) )
-# 13235 "parsing/parser.ml"
+# 13495 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3042 "parsing/parser.mly"
+# 3122 "parsing/parser.mly"
( (_2,Some _4) )
-# 13281 "parsing/parser.ml"
+# 13541 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constructor_arguments * Parsetree.core_type option) =
-# 3044 "parsing/parser.mly"
+# 3124 "parsing/parser.mly"
( (Pcstr_tuple [],Some _2) )
-# 13313 "parsing/parser.ml"
+# 13573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 13363 "parsing/parser.ml"
+# 13623 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13375 "parsing/parser.ml"
+# 13635 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2987 "parsing/parser.mly"
+# 3067 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13389 "parsing/parser.ml"
+# 13649 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
Docstrings.info) = let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 13432 "parsing/parser.ml"
+# 13692 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13443 "parsing/parser.ml"
+# 13703 "parsing/parser.ml"
in
let _startpos_cid_ = _startpos__1_ in
let _1 =
-# 3570 "parsing/parser.mly"
+# 3656 "parsing/parser.mly"
( () )
-# 13450 "parsing/parser.ml"
+# 13710 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos_cid_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2987 "parsing/parser.mly"
+# 3067 "parsing/parser.mly"
(
let args, res = args_res in
let info = symbol_info _endpos in
let loc = make_loc _sloc in
cid, args, res, attrs, loc, info
)
-# 13463 "parsing/parser.ml"
+# 13723 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 13536 "parsing/parser.ml"
+# 13796 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 13551 "parsing/parser.ml"
+# 13811 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13560 "parsing/parser.ml"
+# 13820 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 13565 "parsing/parser.ml"
+# 13825 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 13571 "parsing/parser.ml"
+# 13831 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2927 "parsing/parser.mly"
+# 3007 "parsing/parser.mly"
( _2 )
-# 13579 "parsing/parser.ml"
+# 13839 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13590 "parsing/parser.ml"
+# 13850 "parsing/parser.ml"
in
let flag =
-# 3590 "parsing/parser.mly"
+# 3676 "parsing/parser.mly"
( Recursive )
-# 13596 "parsing/parser.ml"
+# 13856 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 13603 "parsing/parser.ml"
+# 13863 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2864 "parsing/parser.mly"
+# 2944 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13619 "parsing/parser.ml"
+# 13879 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined4 : unit = Obj.magic _1_inlined4 in
let _1_inlined3 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 13698 "parsing/parser.ml"
+# 13958 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined5 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 13714 "parsing/parser.ml"
+# 13974 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined5_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13723 "parsing/parser.ml"
+# 13983 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 13728 "parsing/parser.ml"
+# 13988 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 13734 "parsing/parser.ml"
+# 13994 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined4 in
-# 2927 "parsing/parser.mly"
+# 3007 "parsing/parser.mly"
( _2 )
-# 13742 "parsing/parser.ml"
+# 14002 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13753 "parsing/parser.ml"
+# 14013 "parsing/parser.ml"
in
let flag =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3591 "parsing/parser.mly"
+# 3678 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 13764 "parsing/parser.ml"
+# 14024 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 13772 "parsing/parser.ml"
+# 14032 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2864 "parsing/parser.mly"
+# 2944 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13788 "parsing/parser.ml"
+# 14048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 13854 "parsing/parser.ml"
+# 14114 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 13869 "parsing/parser.ml"
+# 14129 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 13878 "parsing/parser.ml"
+# 14138 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 13883 "parsing/parser.ml"
+# 14143 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 13889 "parsing/parser.ml"
+# 14149 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 13900 "parsing/parser.ml"
+# 14160 "parsing/parser.ml"
in
let flag =
-# 3586 "parsing/parser.mly"
+# 3672 "parsing/parser.mly"
( Recursive )
-# 13906 "parsing/parser.ml"
+# 14166 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 13913 "parsing/parser.ml"
+# 14173 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2864 "parsing/parser.mly"
+# 2944 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 13929 "parsing/parser.ml"
+# 14189 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined3 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14001 "parsing/parser.ml"
+# 14261 "parsing/parser.ml"
) = Obj.magic _1_inlined3 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined2 : unit = Obj.magic _1_inlined2 in
Parsetree.type_declaration) = let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 14017 "parsing/parser.ml"
+# 14277 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 14026 "parsing/parser.ml"
+# 14286 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 14031 "parsing/parser.ml"
+# 14291 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 14037 "parsing/parser.ml"
+# 14297 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14048 "parsing/parser.ml"
+# 14308 "parsing/parser.ml"
in
let flag =
let _1 = _1_inlined2 in
-# 3587 "parsing/parser.mly"
+# 3673 "parsing/parser.mly"
( Nonrecursive )
-# 14056 "parsing/parser.ml"
+# 14316 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 14064 "parsing/parser.ml"
+# 14324 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2864 "parsing/parser.mly"
+# 2944 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
(flag, ext),
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs
)
-# 14080 "parsing/parser.ml"
+# 14340 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 14101 "parsing/parser.ml"
+# 14361 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3431 "parsing/parser.mly"
+# 3515 "parsing/parser.mly"
( _1 )
-# 14109 "parsing/parser.ml"
+# 14369 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14130 "parsing/parser.ml"
+# 14390 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3432 "parsing/parser.mly"
+# 3516 "parsing/parser.mly"
( _1 )
-# 14138 "parsing/parser.ml"
+# 14398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 781 "parsing/parser.mly"
- (Parsetree.structure)
-# 14170 "parsing/parser.ml"
- ) =
-# 1072 "parsing/parser.mly"
+ let _v : (Parsetree.structure) =
+# 1138 "parsing/parser.mly"
( _1 )
-# 14174 "parsing/parser.ml"
+# 14430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (string) =
-# 3481 "parsing/parser.mly"
+# 3565 "parsing/parser.mly"
( "" )
-# 14192 "parsing/parser.ml"
+# 14448 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (string) =
-# 3482 "parsing/parser.mly"
+# 3566 "parsing/parser.mly"
( ";.." )
-# 14224 "parsing/parser.ml"
+# 14480 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 783 "parsing/parser.mly"
- (Parsetree.signature)
-# 14256 "parsing/parser.ml"
- ) =
-# 1078 "parsing/parser.mly"
+ let _v : (Parsetree.signature) =
+# 1145 "parsing/parser.mly"
( _1 )
-# 14260 "parsing/parser.ml"
+# 14512 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.extension) =
-# 3766 "parsing/parser.mly"
+# 3856 "parsing/parser.mly"
( (_2, _3) )
-# 14306 "parsing/parser.ml"
+# 14558 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 693 "parsing/parser.mly"
- (string * Location.t * string * Location.t * string option)
-# 14327 "parsing/parser.ml"
+# 747 "parsing/parser.mly"
+ (string * Location.t * string * Location.t * string option)
+# 14579 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3768 "parsing/parser.mly"
+# 3858 "parsing/parser.mly"
( mk_quotedext ~loc:_sloc _1 )
-# 14338 "parsing/parser.ml"
+# 14590 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14386 "parsing/parser.ml"
+# 14638 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.label_declaration) = let _5 =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 14397 "parsing/parser.ml"
+# 14649 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3184 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 14406 "parsing/parser.ml"
+# 14658 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 14414 "parsing/parser.ml"
+# 14666 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14422 "parsing/parser.ml"
+# 14674 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3061 "parsing/parser.mly"
+# 3141 "parsing/parser.mly"
( let info = symbol_info _endpos in
Type.field _2 _4 ~mut:_1 ~attrs:_5 ~loc:(make_loc _sloc) ~info )
-# 14436 "parsing/parser.ml"
+# 14688 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _3 : unit = Obj.magic _3 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14498 "parsing/parser.ml"
+# 14750 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Asttypes.mutable_flag) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _v : (Parsetree.label_declaration) = let _7 =
let _1 = _1_inlined4 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 14509 "parsing/parser.ml"
+# 14761 "parsing/parser.ml"
in
let _endpos__7_ = _endpos__1_inlined4_ in
let _5 =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 14518 "parsing/parser.ml"
+# 14770 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3184 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 14527 "parsing/parser.ml"
+# 14779 "parsing/parser.ml"
in
let _2 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 14535 "parsing/parser.ml"
+# 14787 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14543 "parsing/parser.ml"
+# 14795 "parsing/parser.ml"
in
let _startpos__2_ = _startpos__1_inlined1_ in
_startpos__2_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3066 "parsing/parser.mly"
+# 3146 "parsing/parser.mly"
( let info =
match rhs_info _endpos__5_ with
| Some _ as info_before_semi -> info_before_semi
| None -> symbol_info _endpos
in
Type.field _2 _4 ~mut:_1 ~attrs:(_5 @ _7) ~loc:(make_loc _sloc) ~info )
-# 14561 "parsing/parser.ml"
+# 14813 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3055 "parsing/parser.mly"
+# 3135 "parsing/parser.mly"
( [_1] )
-# 14586 "parsing/parser.ml"
+# 14838 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.label_declaration list) =
-# 3056 "parsing/parser.mly"
+# 3136 "parsing/parser.mly"
( [_1] )
-# 14611 "parsing/parser.ml"
+# 14863 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.label_declaration list) =
-# 3057 "parsing/parser.mly"
+# 3137 "parsing/parser.mly"
( _1 :: _2 )
-# 14643 "parsing/parser.ml"
+# 14895 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14664 "parsing/parser.ml"
+# 14916 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14677 "parsing/parser.ml"
+# 14929 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2129 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14686 "parsing/parser.ml"
+# 14938 "parsing/parser.ml"
in
-# 2121 "parsing/parser.mly"
+# 2211 "parsing/parser.mly"
( x )
-# 14692 "parsing/parser.ml"
+# 14944 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.core_type) = Obj.magic cty in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14727 "parsing/parser.ml"
+# 14979 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 14740 "parsing/parser.ml"
+# 14992 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2129 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 14749 "parsing/parser.ml"
+# 15001 "parsing/parser.ml"
in
let _startpos_x_ = _startpos__1_ in
let _symbolstartpos = _startpos_x_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2123 "parsing/parser.mly"
+# 2213 "parsing/parser.mly"
( let lab, pat = x in
lab,
mkpat ~loc:_sloc (Ppat_constraint (pat, cty)) )
-# 14761 "parsing/parser.ml"
+# 15013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3513 "parsing/parser.mly"
+# 3597 "parsing/parser.mly"
( _1 )
-# 14786 "parsing/parser.ml"
+# 15038 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2402 "parsing/parser.mly"
+# 2464 "parsing/parser.mly"
( (Nolabel, _1) )
-# 14811 "parsing/parser.ml"
+# 15063 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 638 "parsing/parser.mly"
+# 692 "parsing/parser.mly"
(string)
-# 14839 "parsing/parser.ml"
+# 15091 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2404 "parsing/parser.mly"
+# 2466 "parsing/parser.mly"
( (Labelled _1, _2) )
-# 14847 "parsing/parser.ml"
+# 15099 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14874 "parsing/parser.ml"
+# 15126 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2406 "parsing/parser.mly"
+# 2468 "parsing/parser.mly"
( let loc = _loc_label_ in
(Labelled label, mkexpvar ~loc label) )
-# 14885 "parsing/parser.ml"
+# 15137 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let label : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 14912 "parsing/parser.ml"
+# 15164 "parsing/parser.ml"
) = Obj.magic label in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _endpos_label_ in
let _v : (Asttypes.arg_label * Parsetree.expression) = let _loc_label_ = (_startpos_label_, _endpos_label_) in
-# 2409 "parsing/parser.mly"
+# 2471 "parsing/parser.mly"
( let loc = _loc_label_ in
(Optional label, mkexpvar ~loc label) )
-# 14923 "parsing/parser.ml"
+# 15175 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 668 "parsing/parser.mly"
+# 722 "parsing/parser.mly"
(string)
-# 14951 "parsing/parser.ml"
+# 15203 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression) =
-# 2412 "parsing/parser.mly"
+# 2474 "parsing/parser.mly"
( (Optional _1, _2) )
-# 14959 "parsing/parser.ml"
+# 15211 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2117 "parsing/parser.mly"
+# 2207 "parsing/parser.mly"
( _1 )
-# 15014 "parsing/parser.ml"
+# 15266 "parsing/parser.ml"
in
-# 2091 "parsing/parser.mly"
+# 2181 "parsing/parser.mly"
( (Optional (fst _3), _4, snd _3) )
-# 15020 "parsing/parser.ml"
+# 15272 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 15047 "parsing/parser.ml"
+# 15299 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15062 "parsing/parser.ml"
+# 15314 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2129 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15071 "parsing/parser.ml"
+# 15323 "parsing/parser.ml"
in
-# 2093 "parsing/parser.mly"
+# 2183 "parsing/parser.mly"
( (Optional (fst _2), None, snd _2) )
-# 15077 "parsing/parser.ml"
+# 15329 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (Parsetree.pattern) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 668 "parsing/parser.mly"
+# 722 "parsing/parser.mly"
(string)
-# 15126 "parsing/parser.ml"
+# 15378 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) = let _4 =
let _1 = _1_inlined1 in
-# 2117 "parsing/parser.mly"
+# 2207 "parsing/parser.mly"
( _1 )
-# 15136 "parsing/parser.ml"
+# 15388 "parsing/parser.ml"
in
-# 2095 "parsing/parser.mly"
+# 2185 "parsing/parser.mly"
( (Optional _1, _4, _3) )
-# 15142 "parsing/parser.ml"
+# 15394 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 668 "parsing/parser.mly"
+# 722 "parsing/parser.mly"
(string)
-# 15170 "parsing/parser.ml"
+# 15422 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2097 "parsing/parser.mly"
+# 2187 "parsing/parser.mly"
( (Optional _1, None, _2) )
-# 15178 "parsing/parser.ml"
+# 15430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2099 "parsing/parser.mly"
+# 2189 "parsing/parser.mly"
( (Labelled (fst _3), None, snd _3) )
-# 15224 "parsing/parser.ml"
+# 15476 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 15251 "parsing/parser.ml"
+# 15503 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 15266 "parsing/parser.ml"
+# 15518 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2129 "parsing/parser.mly"
+# 2219 "parsing/parser.mly"
( (_1.Location.txt, mkpat ~loc:_sloc (Ppat_var _1)) )
-# 15275 "parsing/parser.ml"
+# 15527 "parsing/parser.ml"
in
-# 2101 "parsing/parser.mly"
+# 2191 "parsing/parser.mly"
( (Labelled (fst _2), None, snd _2) )
-# 15281 "parsing/parser.ml"
+# 15533 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.pattern) = Obj.magic _2 in
let _1 : (
-# 638 "parsing/parser.mly"
+# 692 "parsing/parser.mly"
(string)
-# 15309 "parsing/parser.ml"
+# 15561 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2103 "parsing/parser.mly"
+# 2193 "parsing/parser.mly"
( (Labelled _1, None, _2) )
-# 15317 "parsing/parser.ml"
+# 15569 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.arg_label * Parsetree.expression option * Parsetree.pattern) =
-# 2105 "parsing/parser.mly"
+# 2195 "parsing/parser.mly"
( (Nolabel, None, _1) )
-# 15342 "parsing/parser.ml"
+# 15594 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : (Parsetree.pattern * Parsetree.expression) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Parsetree.pattern * Parsetree.expression * bool) =
+# 2521 "parsing/parser.mly"
+ ( let p,e = _1 in (p,e,false) )
+# 15619 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : (Asttypes.label) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Parsetree.pattern * Parsetree.expression * bool) = let _endpos = _endpos__1_ in
+ let _startpos = _startpos__1_ in
+ let _loc = (_startpos, _endpos) in
+
+# 2524 "parsing/parser.mly"
+ ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1, true) )
+# 15647 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2419 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15378 "parsing/parser.ml"
+# 15683 "parsing/parser.ml"
in
-# 2423 "parsing/parser.mly"
+# 2485 "parsing/parser.mly"
( (_1, _2) )
-# 15384 "parsing/parser.ml"
+# 15689 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2419 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15434 "parsing/parser.ml"
+# 15739 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2425 "parsing/parser.mly"
+# 2487 "parsing/parser.mly"
( let v = _1 in (* PR#7344 *)
let t =
match _2 with
let patloc = (_startpos__1_, _endpos__2_) in
(ghpat ~loc:patloc (Ppat_constraint(v, typ)),
mkexp_constraint ~loc:_sloc _4 _2) )
-# 15454 "parsing/parser.ml"
+# 15759 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 15523 "parsing/parser.ml"
+# 15828 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 15528 "parsing/parser.ml"
+# 15833 "parsing/parser.ml"
in
-# 3166 "parsing/parser.mly"
+# 3250 "parsing/parser.mly"
( _1 )
-# 15534 "parsing/parser.ml"
+# 15839 "parsing/parser.ml"
in
let _startpos__3_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2419 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15545 "parsing/parser.ml"
+# 15850 "parsing/parser.ml"
in
-# 2441 "parsing/parser.mly"
+# 2503 "parsing/parser.mly"
( let typloc = (_startpos__3_, _endpos__5_) in
let patloc = (_startpos__1_, _endpos__5_) in
(ghpat ~loc:patloc
(Ppat_constraint(_1, ghtyp ~loc:typloc (Ptyp_poly(_3,_5)))),
_7) )
-# 15555 "parsing/parser.ml"
+# 15860 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__8_ in
let _v : (Parsetree.pattern * Parsetree.expression) = let _4 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 15629 "parsing/parser.ml"
+# 15934 "parsing/parser.ml"
in
let _1 =
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2419 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 15638 "parsing/parser.ml"
+# 15943 "parsing/parser.ml"
in
let _endpos = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2447 "parsing/parser.mly"
+# 2509 "parsing/parser.mly"
( let exp, poly =
wrap_type_annotation ~loc:_sloc _4 _6 _8 in
let loc = (_startpos__1_, _endpos__6_) in
(ghpat ~loc (Ppat_constraint(_1, poly)), exp) )
-# 15650 "parsing/parser.ml"
+# 15955 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2452 "parsing/parser.mly"
+# 2514 "parsing/parser.mly"
( (_1, _3) )
-# 15689 "parsing/parser.ml"
+# 15994 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2454 "parsing/parser.mly"
+# 2516 "parsing/parser.mly"
( let loc = (_startpos__1_, _endpos__3_) in
(ghpat ~loc (Ppat_constraint(_1, _3)), _5) )
-# 15743 "parsing/parser.ml"
+# 16048 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
- let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+ let body : (Parsetree.pattern * Parsetree.expression * bool) = Obj.magic body in
let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 15806 "parsing/parser.ml"
+# 16111 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 15815 "parsing/parser.ml"
+# 16120 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2470 "parsing/parser.mly"
+# 2544 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
- mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+ mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15827 "parsing/parser.ml"
+# 16132 "parsing/parser.ml"
in
-# 2460 "parsing/parser.mly"
+# 2534 "parsing/parser.mly"
( _1 )
-# 15833 "parsing/parser.ml"
+# 16138 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2461 "parsing/parser.mly"
+# 2535 "parsing/parser.mly"
( addlb _1 _2 )
-# 15865 "parsing/parser.ml"
+# 16170 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
- let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+ let body : (Parsetree.pattern * Parsetree.expression * bool) = Obj.magic body in
let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 15921 "parsing/parser.ml"
+# 16226 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 15930 "parsing/parser.ml"
+# 16235 "parsing/parser.ml"
in
let ext =
-# 3754 "parsing/parser.mly"
+# 3842 "parsing/parser.mly"
( None )
-# 15936 "parsing/parser.ml"
+# 16241 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2470 "parsing/parser.mly"
+# 2544 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
- mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+ mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 15947 "parsing/parser.ml"
+# 16252 "parsing/parser.ml"
in
-# 2460 "parsing/parser.mly"
+# 2534 "parsing/parser.mly"
( _1 )
-# 15953 "parsing/parser.ml"
+# 16258 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
- let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
+ let body : (Parsetree.pattern * Parsetree.expression * bool) = Obj.magic body in
let rec_flag : (Asttypes.rec_flag) = Obj.magic rec_flag in
let _1_inlined2 : (Parsetree.attributes) = Obj.magic _1_inlined2 in
let _2 : (string Asttypes.loc) = Obj.magic _2 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 16023 "parsing/parser.ml"
+# 16328 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 16032 "parsing/parser.ml"
+# 16337 "parsing/parser.ml"
in
let ext =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3755 "parsing/parser.mly"
+# 3844 "parsing/parser.mly"
( not_expecting _loc "extension" )
-# 16043 "parsing/parser.ml"
+# 16348 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2470 "parsing/parser.mly"
+# 2544 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
- mklbs ~loc:_sloc ext rec_flag (mklb ~loc:_sloc true body attrs)
+ mklbs ext rec_flag (mklb ~loc:_sloc true body attrs)
)
-# 16055 "parsing/parser.ml"
+# 16360 "parsing/parser.ml"
in
-# 2460 "parsing/parser.mly"
+# 2534 "parsing/parser.mly"
( _1 )
-# 16061 "parsing/parser.ml"
+# 16366 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (let_bindings) =
-# 2461 "parsing/parser.mly"
+# 2535 "parsing/parser.mly"
( addlb _1 _2 )
-# 16093 "parsing/parser.ml"
+# 16398 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2133 "parsing/parser.mly"
+# 2223 "parsing/parser.mly"
( _1 )
-# 16118 "parsing/parser.ml"
+# 16423 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2135 "parsing/parser.mly"
+# 2225 "parsing/parser.mly"
( Ppat_constraint(_1, _3) )
-# 16158 "parsing/parser.ml"
+# 16463 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 16167 "parsing/parser.ml"
+# 16472 "parsing/parser.ml"
in
-# 2136 "parsing/parser.mly"
+# 2226 "parsing/parser.mly"
( _1 )
-# 16173 "parsing/parser.ml"
+# 16478 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2419 "parsing/parser.mly"
+# 2481 "parsing/parser.mly"
( mkpatvar ~loc:_sloc _1 )
-# 16209 "parsing/parser.ml"
+# 16514 "parsing/parser.ml"
in
-# 2487 "parsing/parser.mly"
+# 2561 "parsing/parser.mly"
( (pat, exp) )
-# 16215 "parsing/parser.ml"
+# 16520 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : (Asttypes.label) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Parsetree.pattern * Parsetree.expression) = let _endpos = _endpos__1_ in
+ let _startpos = _startpos__1_ in
+ let _loc = (_startpos, _endpos) in
+
+# 2564 "parsing/parser.mly"
+ ( (mkpatvar ~loc:_loc _1, mkexpvar ~loc:_loc _1) )
+# 16548 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2489 "parsing/parser.mly"
+# 2566 "parsing/parser.mly"
( let loc = (_startpos_pat_, _endpos_typ_) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) )
-# 16269 "parsing/parser.ml"
+# 16602 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_pat_ in
let _endpos = _endpos_exp_ in
let _v : (Parsetree.pattern * Parsetree.expression) =
-# 2492 "parsing/parser.mly"
+# 2569 "parsing/parser.mly"
( (pat, exp) )
-# 16308 "parsing/parser.ml"
+# 16641 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_body_ in
let _endpos = _endpos_body_ in
let _v : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) =
-# 2496 "parsing/parser.mly"
+# 2573 "parsing/parser.mly"
( let let_pat, let_exp = body in
let_pat, let_exp, [] )
-# 16334 "parsing/parser.ml"
+# 16667 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let body : (Parsetree.pattern * Parsetree.expression) = Obj.magic body in
let _1 : (
-# 634 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 16368 "parsing/parser.ml"
+# 16701 "parsing/parser.ml"
) = Obj.magic _1 in
let bindings : (Parsetree.pattern * Parsetree.expression * Parsetree.binding_op list) = Obj.magic bindings in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16381 "parsing/parser.ml"
+# 16714 "parsing/parser.ml"
in
let _endpos = _endpos_body_ in
let _symbolstartpos = _startpos_bindings_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2499 "parsing/parser.mly"
+# 2576 "parsing/parser.mly"
( let let_pat, let_exp, rev_ands = bindings in
let pbop_pat, pbop_exp = body in
let pbop_loc = make_loc _sloc in
let and_ = {pbop_op; pbop_pat; pbop_exp; pbop_loc} in
let_pat, let_exp, and_ :: rev_ands )
-# 16394 "parsing/parser.ml"
+# 16727 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16412 "parsing/parser.ml"
+# 16745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 16478 "parsing/parser.ml"
+# 16811 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 16493 "parsing/parser.ml"
+# 16826 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16505 "parsing/parser.ml"
+# 16838 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 16513 "parsing/parser.ml"
+# 16846 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1737 "parsing/parser.mly"
+# 1827 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id body ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16528 "parsing/parser.ml"
+# 16861 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16534 "parsing/parser.ml"
+# 16867 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_description list) =
# 211 "<standard.mly>"
( [] )
-# 16552 "parsing/parser.ml"
+# 16885 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 16625 "parsing/parser.ml"
+# 16958 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 16640 "parsing/parser.ml"
+# 16973 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16652 "parsing/parser.ml"
+# 16985 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 16660 "parsing/parser.ml"
+# 16993 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2028 "parsing/parser.mly"
+# 2118 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id cty ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16675 "parsing/parser.ml"
+# 17008 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16681 "parsing/parser.ml"
+# 17014 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16699 "parsing/parser.ml"
+# 17032 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let csig : (Parsetree.class_type) = Obj.magic csig in
let _6 : unit = Obj.magic _6 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 16772 "parsing/parser.ml"
+# 17105 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 16787 "parsing/parser.ml"
+# 17120 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16799 "parsing/parser.ml"
+# 17132 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 16807 "parsing/parser.ml"
+# 17140 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2067 "parsing/parser.mly"
+# 2157 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let text = symbol_text _symbolstartpos in
Ci.mk id csig ~virt ~params ~attrs ~loc ~text ~docs
)
-# 16822 "parsing/parser.ml"
+# 17155 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16828 "parsing/parser.ml"
+# 17161 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_binding list) =
# 211 "<standard.mly>"
( [] )
-# 16846 "parsing/parser.ml"
+# 17179 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 16909 "parsing/parser.ml"
+# 17242 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 16921 "parsing/parser.ml"
+# 17254 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 16929 "parsing/parser.ml"
+# 17262 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1418 "parsing/parser.mly"
+# 1489 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let text = symbol_text _symbolstartpos in
Mb.mk name body ~attrs ~loc ~text ~docs
)
-# 16944 "parsing/parser.ml"
+# 17277 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 16950 "parsing/parser.ml"
+# 17283 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 16968 "parsing/parser.ml"
+# 17301 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 17038 "parsing/parser.ml"
+# 17371 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17050 "parsing/parser.ml"
+# 17383 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 17058 "parsing/parser.ml"
+# 17391 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1695 "parsing/parser.mly"
+# 1768 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Md.mk name mty ~attrs ~loc ~text ~docs
)
-# 17073 "parsing/parser.ml"
+# 17406 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17079 "parsing/parser.ml"
+# 17412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17097 "parsing/parser.ml"
+# 17430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17129 "parsing/parser.ml"
+# 17462 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17147 "parsing/parser.ml"
+# 17480 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs_inlined1 : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) = Obj.magic xs_inlined1 in
let kind_priv_manifest : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic kind_priv_manifest in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 17214 "parsing/parser.ml"
+# 17547 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 17229 "parsing/parser.ml"
+# 17562 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17238 "parsing/parser.ml"
+# 17571 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 17243 "parsing/parser.ml"
+# 17576 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 17249 "parsing/parser.ml"
+# 17582 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17260 "parsing/parser.ml"
+# 17593 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 17268 "parsing/parser.ml"
+# 17601 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2881 "parsing/parser.mly"
+# 2961 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17284 "parsing/parser.ml"
+# 17617 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17290 "parsing/parser.ml"
+# 17623 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_declaration list) =
# 211 "<standard.mly>"
( [] )
-# 17308 "parsing/parser.ml"
+# 17641 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = Obj.magic _2 in
let _1_inlined3 : unit = Obj.magic _1_inlined3 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 17382 "parsing/parser.ml"
+# 17715 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 17397 "parsing/parser.ml"
+# 17730 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 17406 "parsing/parser.ml"
+# 17739 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 17411 "parsing/parser.ml"
+# 17744 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 17417 "parsing/parser.ml"
+# 17750 "parsing/parser.ml"
in
let kind_priv_manifest =
let _1 = _1_inlined3 in
-# 2927 "parsing/parser.mly"
+# 3007 "parsing/parser.mly"
( _2 )
-# 17425 "parsing/parser.ml"
+# 17758 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 17436 "parsing/parser.ml"
+# 17769 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 17444 "parsing/parser.ml"
+# 17777 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2881 "parsing/parser.mly"
+# 2961 "parsing/parser.mly"
(
let (kind, priv, manifest) = kind_priv_manifest in
let docs = symbol_docs _sloc in
let text = symbol_text _symbolstartpos in
Type.mk id ~params ~cstrs ~kind ~priv ?manifest ~attrs ~loc ~docs ~text
)
-# 17460 "parsing/parser.ml"
+# 17793 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17466 "parsing/parser.ml"
+# 17799 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 211 "<standard.mly>"
( [] )
-# 17484 "parsing/parser.ml"
+# 17817 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.attributes) =
# 213 "<standard.mly>"
( x :: xs )
-# 17516 "parsing/parser.ml"
+# 17849 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17534 "parsing/parser.ml"
+# 17867 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 827 "parsing/parser.mly"
+# 893 "parsing/parser.mly"
( text_sig _startpos )
-# 17569 "parsing/parser.ml"
+# 17902 "parsing/parser.ml"
in
-# 1556 "parsing/parser.mly"
+# 1627 "parsing/parser.mly"
( _1 )
-# 17575 "parsing/parser.ml"
+# 17908 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17581 "parsing/parser.ml"
+# 17914 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 825 "parsing/parser.mly"
+# 891 "parsing/parser.mly"
( text_sig _startpos @ [_1] )
-# 17616 "parsing/parser.ml"
+# 17949 "parsing/parser.ml"
in
-# 1556 "parsing/parser.mly"
+# 1627 "parsing/parser.mly"
( _1 )
-# 17622 "parsing/parser.ml"
+# 17955 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17628 "parsing/parser.ml"
+# 17961 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 17646 "parsing/parser.ml"
+# 17979 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let ys =
let items =
-# 887 "parsing/parser.mly"
+# 953 "parsing/parser.mly"
( [] )
-# 17681 "parsing/parser.ml"
+# 18014 "parsing/parser.ml"
in
-# 1301 "parsing/parser.mly"
+# 1372 "parsing/parser.mly"
( items )
-# 17686 "parsing/parser.ml"
+# 18019 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 823 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( text_str _startpos )
-# 17694 "parsing/parser.ml"
+# 18027 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 17700 "parsing/parser.ml"
+# 18033 "parsing/parser.ml"
in
-# 1317 "parsing/parser.mly"
+# 1388 "parsing/parser.mly"
( _1 )
-# 17706 "parsing/parser.ml"
+# 18039 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17712 "parsing/parser.ml"
+# 18045 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 17766 "parsing/parser.ml"
+# 18099 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( mkstrexp e attrs )
-# 17771 "parsing/parser.ml"
+# 18104 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17779 "parsing/parser.ml"
+# 18112 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 840 "parsing/parser.mly"
+# 906 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 17789 "parsing/parser.ml"
+# 18122 "parsing/parser.ml"
in
-# 889 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( x )
-# 17795 "parsing/parser.ml"
+# 18128 "parsing/parser.ml"
in
-# 1301 "parsing/parser.mly"
+# 1372 "parsing/parser.mly"
( items )
-# 17801 "parsing/parser.ml"
+# 18134 "parsing/parser.ml"
in
let xs =
let _startpos = _startpos__1_ in
-# 823 "parsing/parser.mly"
+# 889 "parsing/parser.mly"
( text_str _startpos )
-# 17809 "parsing/parser.ml"
+# 18142 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 17815 "parsing/parser.ml"
+# 18148 "parsing/parser.ml"
in
-# 1317 "parsing/parser.mly"
+# 1388 "parsing/parser.mly"
( _1 )
-# 17821 "parsing/parser.ml"
+# 18154 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17827 "parsing/parser.ml"
+# 18160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 17862 "parsing/parser.ml"
+# 18195 "parsing/parser.ml"
in
-# 1317 "parsing/parser.mly"
+# 1388 "parsing/parser.mly"
( _1 )
-# 17868 "parsing/parser.ml"
+# 18201 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17874 "parsing/parser.ml"
+# 18207 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) =
# 211 "<standard.mly>"
( [] )
-# 17892 "parsing/parser.ml"
+# 18225 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_type_field list list) = let x =
let _startpos = _startpos__1_ in
-# 835 "parsing/parser.mly"
+# 901 "parsing/parser.mly"
( text_csig _startpos @ [_1] )
-# 17926 "parsing/parser.ml"
+# 18259 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17932 "parsing/parser.ml"
+# 18265 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) =
# 211 "<standard.mly>"
( [] )
-# 17950 "parsing/parser.ml"
+# 18283 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.class_field list list) = let x =
let _startpos = _startpos__1_ in
-# 833 "parsing/parser.mly"
+# 899 "parsing/parser.mly"
( text_cstr _startpos @ [_1] )
-# 17984 "parsing/parser.ml"
+# 18317 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 17990 "parsing/parser.ml"
+# 18323 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) =
# 211 "<standard.mly>"
( [] )
-# 18008 "parsing/parser.ml"
+# 18341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.structure_item list list) = let x =
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 18042 "parsing/parser.ml"
+# 18375 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18048 "parsing/parser.ml"
+# 18381 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) =
# 211 "<standard.mly>"
( [] )
-# 18066 "parsing/parser.ml"
+# 18399 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let x =
let _1 =
-# 887 "parsing/parser.mly"
+# 953 "parsing/parser.mly"
( [] )
-# 18101 "parsing/parser.ml"
+# 18434 "parsing/parser.ml"
in
-# 1117 "parsing/parser.mly"
+# 1185 "parsing/parser.mly"
( _1 )
-# 18106 "parsing/parser.ml"
+# 18439 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18112 "parsing/parser.ml"
+# 18445 "parsing/parser.ml"
in
-# 1129 "parsing/parser.mly"
+# 1197 "parsing/parser.mly"
( _1 )
-# 18118 "parsing/parser.ml"
+# 18451 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18124 "parsing/parser.ml"
+# 18457 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let attrs =
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 18178 "parsing/parser.ml"
+# 18511 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( mkstrexp e attrs )
-# 18183 "parsing/parser.ml"
+# 18516 "parsing/parser.ml"
in
-# 831 "parsing/parser.mly"
+# 897 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18189 "parsing/parser.ml"
+# 18522 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 829 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18197 "parsing/parser.ml"
+# 18530 "parsing/parser.ml"
in
-# 889 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( x )
-# 18203 "parsing/parser.ml"
+# 18536 "parsing/parser.ml"
in
-# 1117 "parsing/parser.mly"
+# 1185 "parsing/parser.mly"
( _1 )
-# 18209 "parsing/parser.ml"
+# 18542 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 18215 "parsing/parser.ml"
+# 18548 "parsing/parser.ml"
in
-# 1129 "parsing/parser.mly"
+# 1197 "parsing/parser.mly"
( _1 )
-# 18221 "parsing/parser.ml"
+# 18554 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18227 "parsing/parser.ml"
+# 18560 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase list list) = let x =
let _1 =
let _1 =
-# 831 "parsing/parser.mly"
+# 897 "parsing/parser.mly"
( Ptop_def [_1] )
-# 18261 "parsing/parser.ml"
+# 18594 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 829 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18267 "parsing/parser.ml"
+# 18600 "parsing/parser.ml"
in
-# 1129 "parsing/parser.mly"
+# 1197 "parsing/parser.mly"
( _1 )
-# 18273 "parsing/parser.ml"
+# 18606 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18279 "parsing/parser.ml"
+# 18612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 840 "parsing/parser.mly"
+# 906 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 18317 "parsing/parser.ml"
+# 18650 "parsing/parser.ml"
in
let _startpos = _startpos__1_ in
-# 829 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 18324 "parsing/parser.ml"
+# 18657 "parsing/parser.ml"
in
-# 1129 "parsing/parser.mly"
+# 1197 "parsing/parser.mly"
( _1 )
-# 18330 "parsing/parser.ml"
+# 18663 "parsing/parser.ml"
in
# 213 "<standard.mly>"
( x :: xs )
-# 18336 "parsing/parser.ml"
+# 18669 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 124 "<standard.mly>"
( None )
-# 18375 "parsing/parser.ml"
+# 18708 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18385 "parsing/parser.ml"
+# 18718 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2767 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( let label, pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18407 "parsing/parser.ml"
+# 18740 "parsing/parser.ml"
in
-# 1056 "parsing/parser.mly"
+# 1122 "parsing/parser.mly"
( [x], None )
-# 18413 "parsing/parser.ml"
+# 18746 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.pattern) list * unit option) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 18459 "parsing/parser.ml"
+# 18792 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18469 "parsing/parser.ml"
+# 18802 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2767 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( let label, pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18491 "parsing/parser.ml"
+# 18824 "parsing/parser.ml"
in
-# 1056 "parsing/parser.mly"
+# 1122 "parsing/parser.mly"
( [x], None )
-# 18497 "parsing/parser.ml"
+# 18830 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18562 "parsing/parser.ml"
+# 18895 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2767 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( let label, pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18584 "parsing/parser.ml"
+# 18917 "parsing/parser.ml"
in
-# 1058 "parsing/parser.mly"
+# 1124 "parsing/parser.mly"
( [x], Some y )
-# 18590 "parsing/parser.ml"
+# 18923 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18648 "parsing/parser.ml"
+# 18981 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2767 "parsing/parser.mly"
+# 2847 "parsing/parser.mly"
( let label, pat =
match opat with
| None ->
in
label, mkpat_opt_constraint ~loc:_sloc pat octy
)
-# 18670 "parsing/parser.ml"
+# 19003 "parsing/parser.ml"
in
-# 1062 "parsing/parser.mly"
+# 1128 "parsing/parser.mly"
( let xs, y = tail in
x :: xs, y )
-# 18677 "parsing/parser.ml"
+# 19010 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) =
-# 2525 "parsing/parser.mly"
+# 2602 "parsing/parser.mly"
( Exp.case _1 _3 )
-# 18716 "parsing/parser.ml"
+# 19049 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.case) =
-# 2527 "parsing/parser.mly"
+# 2604 "parsing/parser.mly"
( Exp.case _1 ~guard:_3 _5 )
-# 18769 "parsing/parser.ml"
+# 19102 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.case) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2529 "parsing/parser.mly"
+# 2606 "parsing/parser.mly"
( Exp.case _1 (Exp.unreachable ~loc:(make_loc _loc__3_) ()) )
-# 18809 "parsing/parser.ml"
+# 19142 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 18872 "parsing/parser.ml"
+# 19205 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 18883 "parsing/parser.ml"
+# 19216 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 18892 "parsing/parser.ml"
+# 19225 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3184 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 18901 "parsing/parser.ml"
+# 19234 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 18908 "parsing/parser.ml"
+# 19241 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 18916 "parsing/parser.ml"
+# 19249 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3394 "parsing/parser.mly"
+# 3478 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 18931 "parsing/parser.ml"
+# 19264 "parsing/parser.ml"
in
-# 3375 "parsing/parser.mly"
+# 3459 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 18937 "parsing/parser.ml"
+# 19270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3405 "parsing/parser.mly"
+# 3489 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 18980 "parsing/parser.ml"
+# 19313 "parsing/parser.ml"
in
-# 3375 "parsing/parser.mly"
+# 3459 "parsing/parser.mly"
( let (f, c) = tail in (head :: f, c) )
-# 18986 "parsing/parser.ml"
+# 19319 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19042 "parsing/parser.ml"
+# 19375 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _6 =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19053 "parsing/parser.ml"
+# 19386 "parsing/parser.ml"
in
let _endpos__6_ = _endpos__1_inlined3_ in
let _4 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19062 "parsing/parser.ml"
+# 19395 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3184 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 19071 "parsing/parser.ml"
+# 19404 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19078 "parsing/parser.ml"
+# 19411 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19086 "parsing/parser.ml"
+# 19419 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3394 "parsing/parser.mly"
+# 3478 "parsing/parser.mly"
( let info =
match rhs_info _endpos__4_ with
| Some _ as info_before_semi -> info_before_semi
in
let attrs = add_info_attrs info (_4 @ _6) in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19101 "parsing/parser.ml"
+# 19434 "parsing/parser.ml"
in
-# 3378 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( [head], Closed )
-# 19107 "parsing/parser.ml"
+# 19440 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3405 "parsing/parser.mly"
+# 3489 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19143 "parsing/parser.ml"
+# 19476 "parsing/parser.ml"
in
-# 3378 "parsing/parser.mly"
+# 3462 "parsing/parser.mly"
( [head], Closed )
-# 19149 "parsing/parser.ml"
+# 19482 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined1 : (Parsetree.core_type) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19191 "parsing/parser.ml"
+# 19524 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _4 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19202 "parsing/parser.ml"
+# 19535 "parsing/parser.ml"
in
let _endpos__4_ = _endpos__1_inlined2_ in
let _3 =
let _1 = _1_inlined1 in
-# 3184 "parsing/parser.mly"
+# 3268 "parsing/parser.mly"
( _1 )
-# 19211 "parsing/parser.ml"
+# 19544 "parsing/parser.ml"
in
let _1 =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19218 "parsing/parser.ml"
+# 19551 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19226 "parsing/parser.ml"
+# 19559 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3387 "parsing/parser.mly"
+# 3471 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _4 in
Of.tag ~loc:(make_loc _sloc) ~attrs _1 _3 )
-# 19237 "parsing/parser.ml"
+# 19570 "parsing/parser.ml"
in
-# 3381 "parsing/parser.mly"
+# 3465 "parsing/parser.mly"
( [head], Closed )
-# 19243 "parsing/parser.ml"
+# 19576 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_ty_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3405 "parsing/parser.mly"
+# 3489 "parsing/parser.mly"
( Of.inherit_ ~loc:(make_loc _sloc) ty )
-# 19272 "parsing/parser.ml"
+# 19605 "parsing/parser.ml"
in
-# 3381 "parsing/parser.mly"
+# 3465 "parsing/parser.mly"
( [head], Closed )
-# 19278 "parsing/parser.ml"
+# 19611 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.object_field list * Asttypes.closed_flag) =
-# 3383 "parsing/parser.mly"
+# 3467 "parsing/parser.mly"
( [], Open )
-# 19303 "parsing/parser.ml"
+# 19636 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19350 "parsing/parser.ml"
+# 19683 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let private_ : (Asttypes.private_flag) = Obj.magic private_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let ty =
let _1 = _1_inlined2 in
-# 3180 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _1 )
-# 19364 "parsing/parser.ml"
+# 19697 "parsing/parser.ml"
in
let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19372 "parsing/parser.ml"
+# 19705 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19380 "parsing/parser.ml"
+# 19713 "parsing/parser.ml"
in
let attrs =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19386 "parsing/parser.ml"
+# 19719 "parsing/parser.ml"
in
let _1 =
-# 3646 "parsing/parser.mly"
+# 3734 "parsing/parser.mly"
( Fresh )
-# 19391 "parsing/parser.ml"
+# 19724 "parsing/parser.ml"
in
-# 1875 "parsing/parser.mly"
+# 1965 "parsing/parser.mly"
( (label, private_, Cfk_virtual ty), attrs )
-# 19396 "parsing/parser.ml"
+# 19729 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19436 "parsing/parser.ml"
+# 19769 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19450 "parsing/parser.ml"
+# 19783 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19458 "parsing/parser.ml"
+# 19791 "parsing/parser.ml"
in
let _2 =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19464 "parsing/parser.ml"
+# 19797 "parsing/parser.ml"
in
let _1 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 19469 "parsing/parser.ml"
+# 19802 "parsing/parser.ml"
in
-# 1877 "parsing/parser.mly"
+# 1967 "parsing/parser.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 19477 "parsing/parser.ml"
+# 19810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _5 : (Parsetree.expression) = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19523 "parsing/parser.ml"
+# 19856 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19538 "parsing/parser.ml"
+# 19871 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19546 "parsing/parser.ml"
+# 19879 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19554 "parsing/parser.ml"
+# 19887 "parsing/parser.ml"
in
let _1 =
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 19560 "parsing/parser.ml"
+# 19893 "parsing/parser.ml"
in
-# 1877 "parsing/parser.mly"
+# 1967 "parsing/parser.mly"
( let e = _5 in
let loc = Location.(e.pexp_loc.loc_start, e.pexp_loc.loc_end) in
(_4, _3,
Cfk_concrete (_1, ghexp ~loc (Pexp_poly (e, None)))), _2 )
-# 19568 "parsing/parser.ml"
+# 19901 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined2 : (Parsetree.core_type) = Obj.magic _1_inlined2 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19629 "parsing/parser.ml"
+# 19962 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _6 =
let _1 = _1_inlined2 in
-# 3180 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _1 )
-# 19643 "parsing/parser.ml"
+# 19976 "parsing/parser.ml"
in
let _startpos__6_ = _startpos__1_inlined2_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19652 "parsing/parser.ml"
+# 19985 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19660 "parsing/parser.ml"
+# 19993 "parsing/parser.ml"
in
let _2 =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19666 "parsing/parser.ml"
+# 19999 "parsing/parser.ml"
in
let _1 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 19671 "parsing/parser.ml"
+# 20004 "parsing/parser.ml"
in
-# 1883 "parsing/parser.mly"
+# 1973 "parsing/parser.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 19679 "parsing/parser.ml"
+# 20012 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.core_type) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19746 "parsing/parser.ml"
+# 20079 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _6 =
let _1 = _1_inlined3 in
-# 3180 "parsing/parser.mly"
+# 3264 "parsing/parser.mly"
( _1 )
-# 19761 "parsing/parser.ml"
+# 20094 "parsing/parser.ml"
in
let _startpos__6_ = _startpos__1_inlined3_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19770 "parsing/parser.ml"
+# 20103 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19778 "parsing/parser.ml"
+# 20111 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19786 "parsing/parser.ml"
+# 20119 "parsing/parser.ml"
in
let _1 =
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 19792 "parsing/parser.ml"
+# 20125 "parsing/parser.ml"
in
-# 1883 "parsing/parser.mly"
+# 1973 "parsing/parser.mly"
( let poly_exp =
let loc = (_startpos__6_, _endpos__8_) in
ghexp ~loc (Pexp_poly(_8, Some _6)) in
(_4, _3, Cfk_concrete (_1, poly_exp)), _2 )
-# 19800 "parsing/parser.ml"
+# 20133 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 19882 "parsing/parser.ml"
+# 20215 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 19894 "parsing/parser.ml"
+# 20227 "parsing/parser.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 19902 "parsing/parser.ml"
+# 20235 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 19910 "parsing/parser.ml"
+# 20243 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 19917 "parsing/parser.ml"
+# 20250 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 19923 "parsing/parser.ml"
+# 20256 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__11_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1889 "parsing/parser.mly"
+# 1979 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 19950 "parsing/parser.ml"
+# 20283 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 20038 "parsing/parser.ml"
+# 20371 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.private_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _v : ((Asttypes.label Asttypes.loc * Asttypes.private_flag *
Parsetree.class_field_kind) *
Parsetree.attributes) = let _7 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 20051 "parsing/parser.ml"
+# 20384 "parsing/parser.ml"
in
let _startpos__7_ = _startpos_xs_ in
let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 20059 "parsing/parser.ml"
+# 20392 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 20067 "parsing/parser.ml"
+# 20400 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 20076 "parsing/parser.ml"
+# 20409 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 20083 "parsing/parser.ml"
+# 20416 "parsing/parser.ml"
in
let _endpos = _endpos__11_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1889 "parsing/parser.mly"
+# 1979 "parsing/parser.mly"
( let poly_exp_loc = (_startpos__7_, _endpos__11_) in
let poly_exp =
let exp, poly =
ghexp ~loc:poly_exp_loc (Pexp_poly(exp, Some poly)) in
(_4, _3,
Cfk_concrete (_1, poly_exp)), _2 )
-# 20109 "parsing/parser.ml"
+# 20442 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 20130 "parsing/parser.ml"
+# 20463 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20138 "parsing/parser.ml"
+# 20471 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 20171 "parsing/parser.ml"
+# 20504 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20181 "parsing/parser.ml"
+# 20514 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 20202 "parsing/parser.ml"
+# 20535 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20210 "parsing/parser.ml"
+# 20543 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 20243 "parsing/parser.ml"
+# 20576 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20253 "parsing/parser.ml"
+# 20586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20278 "parsing/parser.ml"
+# 20611 "parsing/parser.ml"
in
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20283 "parsing/parser.ml"
+# 20616 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _1 =
let _1 =
-# 3486 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( "::" )
-# 20323 "parsing/parser.ml"
+# 20656 "parsing/parser.ml"
in
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20328 "parsing/parser.ml"
+# 20661 "parsing/parser.ml"
in
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20334 "parsing/parser.ml"
+# 20667 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) = let _1 =
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20359 "parsing/parser.ml"
+# 20692 "parsing/parser.ml"
in
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20364 "parsing/parser.ml"
+# 20697 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20405 "parsing/parser.ml"
+# 20738 "parsing/parser.ml"
in
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20411 "parsing/parser.ml"
+# 20744 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let (_2, _1) = (_2_inlined1, _1_inlined1) in
let _1 =
-# 3486 "parsing/parser.mly"
+# 3570 "parsing/parser.mly"
( "::" )
-# 20466 "parsing/parser.ml"
+# 20799 "parsing/parser.ml"
in
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20471 "parsing/parser.ml"
+# 20804 "parsing/parser.ml"
in
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20477 "parsing/parser.ml"
+# 20810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Longident.t) = let _3 =
let _1 = _1_inlined1 in
-# 3543 "parsing/parser.mly"
+# 3628 "parsing/parser.mly"
( _1 )
-# 20518 "parsing/parser.ml"
+# 20851 "parsing/parser.ml"
in
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20524 "parsing/parser.ml"
+# 20857 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20549 "parsing/parser.ml"
+# 20882 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20588 "parsing/parser.ml"
+# 20921 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 20609 "parsing/parser.ml"
+# 20942 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20617 "parsing/parser.ml"
+# 20950 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 20650 "parsing/parser.ml"
+# 20983 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20660 "parsing/parser.ml"
+# 20993 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 20681 "parsing/parser.ml"
+# 21014 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20689 "parsing/parser.ml"
+# 21022 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _3 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 20722 "parsing/parser.ml"
+# 21055 "parsing/parser.ml"
) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (Longident.t) = Obj.magic _1 in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20732 "parsing/parser.ml"
+# 21065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3506 "parsing/parser.mly"
+# 3590 "parsing/parser.mly"
( Lident _1 )
-# 20757 "parsing/parser.ml"
+# 21090 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Longident.t) =
-# 3507 "parsing/parser.mly"
+# 3591 "parsing/parser.mly"
( Ldot(_1,_3) )
-# 20796 "parsing/parser.ml"
+# 21129 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3522 "parsing/parser.mly"
+# 3606 "parsing/parser.mly"
( _1 )
-# 20821 "parsing/parser.ml"
+# 21154 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3524 "parsing/parser.mly"
+# 3608 "parsing/parser.mly"
( lapply ~loc:_sloc _1 _3 )
-# 20870 "parsing/parser.ml"
+# 21203 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Longident.t) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3526 "parsing/parser.mly"
+# 3610 "parsing/parser.mly"
( expecting _loc__3_ "module path" )
-# 20910 "parsing/parser.ml"
+# 21243 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3519 "parsing/parser.mly"
+# 3603 "parsing/parser.mly"
( _1 )
-# 20935 "parsing/parser.ml"
+# 21268 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1377 "parsing/parser.mly"
+# 1448 "parsing/parser.mly"
( me )
-# 20967 "parsing/parser.ml"
+# 21300 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1380 "parsing/parser.mly"
+# 1451 "parsing/parser.mly"
( Pmod_constraint(me, mty) )
-# 21014 "parsing/parser.ml"
+# 21347 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_me_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21023 "parsing/parser.ml"
+# 21356 "parsing/parser.ml"
in
-# 1384 "parsing/parser.mly"
+# 1455 "parsing/parser.mly"
( _1 )
-# 21029 "parsing/parser.ml"
+# 21362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1382 "parsing/parser.mly"
+# 1453 "parsing/parser.mly"
( let (_, arg) = arg_and_pos in
Pmod_functor(arg, body) )
-# 21063 "parsing/parser.ml"
+# 21396 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21072 "parsing/parser.ml"
+# 21405 "parsing/parser.ml"
in
-# 1384 "parsing/parser.mly"
+# 1455 "parsing/parser.mly"
( _1 )
-# 21078 "parsing/parser.ml"
+# 21411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_mty_ in
let _v : (Parsetree.module_type) =
-# 1621 "parsing/parser.mly"
+# 1694 "parsing/parser.mly"
( mty )
-# 21110 "parsing/parser.ml"
+# 21443 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_body_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1624 "parsing/parser.mly"
+# 1697 "parsing/parser.mly"
( let (_, arg) = arg_and_pos in
Pmty_functor(arg, body) )
-# 21144 "parsing/parser.ml"
+# 21477 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_body_, _startpos_arg_and_pos_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 21153 "parsing/parser.ml"
+# 21486 "parsing/parser.ml"
in
-# 1627 "parsing/parser.mly"
+# 1700 "parsing/parser.mly"
( _1 )
-# 21159 "parsing/parser.ml"
+# 21492 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21207 "parsing/parser.ml"
+# 21540 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1216 "parsing/parser.mly"
+# 1287 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_structure s) )
-# 21216 "parsing/parser.ml"
+# 21549 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21264 "parsing/parser.ml"
+# 21597 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1218 "parsing/parser.mly"
+# 1289 "parsing/parser.mly"
( unclosed "struct" _loc__1_ "end" _loc__4_ )
-# 21272 "parsing/parser.ml"
+# 21605 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let args =
let _1 = _1_inlined2 in
-# 1182 "parsing/parser.mly"
+# 1253 "parsing/parser.mly"
( _1 )
-# 21327 "parsing/parser.ml"
+# 21660 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21335 "parsing/parser.ml"
+# 21668 "parsing/parser.ml"
in
let _endpos = _endpos_me_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1220 "parsing/parser.mly"
+# 1291 "parsing/parser.mly"
( wrap_mod_attrs ~loc:_sloc attrs (
List.fold_left (fun acc (startpos, arg) ->
mkmod ~loc:(startpos, _endpos) (Pmod_functor (arg, acc))
) me args
) )
-# 21348 "parsing/parser.ml"
+# 21681 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_me_ in
let _v : (Parsetree.module_expr) =
-# 1226 "parsing/parser.mly"
+# 1297 "parsing/parser.mly"
( me )
-# 21373 "parsing/parser.ml"
+# 21706 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_me_ in
let _endpos = _endpos_attr_ in
let _v : (Parsetree.module_expr) =
-# 1228 "parsing/parser.mly"
+# 1299 "parsing/parser.mly"
( Mod.attr me attr )
-# 21405 "parsing/parser.ml"
+# 21738 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21436 "parsing/parser.ml"
+# 21769 "parsing/parser.ml"
in
-# 1232 "parsing/parser.mly"
+# 1303 "parsing/parser.mly"
( Pmod_ident x )
-# 21442 "parsing/parser.ml"
+# 21775 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21451 "parsing/parser.ml"
+# 21784 "parsing/parser.ml"
in
-# 1244 "parsing/parser.mly"
+# 1315 "parsing/parser.mly"
( _1 )
-# 21457 "parsing/parser.ml"
+# 21790 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_me2_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1235 "parsing/parser.mly"
+# 1306 "parsing/parser.mly"
( Pmod_apply(me1, me2) )
-# 21490 "parsing/parser.ml"
+# 21823 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_me2_, _startpos_me1_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21499 "parsing/parser.ml"
+# 21832 "parsing/parser.ml"
in
-# 1244 "parsing/parser.mly"
+# 1315 "parsing/parser.mly"
( _1 )
-# 21505 "parsing/parser.ml"
+# 21838 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos_me1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1238 "parsing/parser.mly"
+# 1309 "parsing/parser.mly"
( (* TODO review mkmod location *)
Pmod_apply(me1, mkmod ~loc:_sloc (Pmod_structure [])) )
-# 21550 "parsing/parser.ml"
+# 21883 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_me1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21560 "parsing/parser.ml"
+# 21893 "parsing/parser.ml"
in
-# 1244 "parsing/parser.mly"
+# 1315 "parsing/parser.mly"
( _1 )
-# 21566 "parsing/parser.ml"
+# 21899 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_ex_ in
let _v : (Parsetree.module_expr) = let _1 =
let _1 =
-# 1242 "parsing/parser.mly"
+# 1313 "parsing/parser.mly"
( Pmod_extension ex )
-# 21592 "parsing/parser.ml"
+# 21925 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_ex_, _startpos_ex_) in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 860 "parsing/parser.mly"
+# 926 "parsing/parser.mly"
( mkmod ~loc:_sloc _1 )
-# 21601 "parsing/parser.ml"
+# 21934 "parsing/parser.ml"
in
-# 1244 "parsing/parser.mly"
+# 1315 "parsing/parser.mly"
( _1 )
-# 21607 "parsing/parser.ml"
+# 21940 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let x : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 21628 "parsing/parser.ml"
+# 21961 "parsing/parser.ml"
) = Obj.magic x in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (string option) =
-# 1199 "parsing/parser.mly"
+# 1270 "parsing/parser.mly"
( Some x )
-# 21636 "parsing/parser.ml"
+# 21969 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string option) =
-# 1202 "parsing/parser.mly"
+# 1273 "parsing/parser.mly"
( None )
-# 21661 "parsing/parser.ml"
+# 21994 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Longident.t) = Obj.magic _1_inlined3 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 21721 "parsing/parser.ml"
+# 22054 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let ext : (string Asttypes.loc option) = Obj.magic ext in
let _v : (Parsetree.module_substitution * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 21734 "parsing/parser.ml"
+# 22067 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21746 "parsing/parser.ml"
+# 22079 "parsing/parser.ml"
in
let uid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21757 "parsing/parser.ml"
+# 22090 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21765 "parsing/parser.ml"
+# 22098 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1657 "parsing/parser.mly"
+# 1730 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Ms.mk uid body ~attrs ~loc ~docs, ext
)
-# 21779 "parsing/parser.ml"
+# 22112 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 21832 "parsing/parser.ml"
+# 22165 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
let _2 : (string Asttypes.loc option) = Obj.magic _2 in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 21848 "parsing/parser.ml"
+# 22181 "parsing/parser.ml"
in
let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21856 "parsing/parser.ml"
+# 22189 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
-# 1664 "parsing/parser.mly"
+# 1737 "parsing/parser.mly"
( expecting _loc__6_ "module path" )
-# 21863 "parsing/parser.ml"
+# 22196 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21911 "parsing/parser.ml"
+# 22244 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1509 "parsing/parser.mly"
+# 1580 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs (Pmty_signature s) )
-# 21920 "parsing/parser.ml"
+# 22253 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 21968 "parsing/parser.ml"
+# 22301 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1511 "parsing/parser.mly"
+# 1582 "parsing/parser.mly"
( unclosed "sig" _loc__1_ "end" _loc__4_ )
-# 21976 "parsing/parser.ml"
+# 22309 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let args =
let _1 = _1_inlined2 in
-# 1182 "parsing/parser.mly"
+# 1253 "parsing/parser.mly"
( _1 )
-# 22031 "parsing/parser.ml"
+# 22364 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 22039 "parsing/parser.ml"
+# 22372 "parsing/parser.ml"
in
let _endpos = _endpos_mty_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1515 "parsing/parser.mly"
+# 1586 "parsing/parser.mly"
( wrap_mty_attrs ~loc:_sloc attrs (
List.fold_left (fun acc (startpos, arg) ->
mkmty ~loc:(startpos, _endpos) (Pmty_functor (arg, acc))
) mty args
) )
-# 22052 "parsing/parser.ml"
+# 22385 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _4 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 22107 "parsing/parser.ml"
+# 22440 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1521 "parsing/parser.mly"
+# 1592 "parsing/parser.mly"
( mkmty ~loc:_sloc ~attrs:_4 (Pmty_typeof _5) )
-# 22116 "parsing/parser.ml"
+# 22449 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) =
-# 1523 "parsing/parser.mly"
+# 1594 "parsing/parser.mly"
( _2 )
-# 22155 "parsing/parser.ml"
+# 22488 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1525 "parsing/parser.mly"
+# 1596 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 22196 "parsing/parser.ml"
+# 22529 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.module_type) =
-# 1527 "parsing/parser.mly"
+# 1598 "parsing/parser.mly"
( Mty.attr _1 _2 )
-# 22228 "parsing/parser.ml"
+# 22561 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22259 "parsing/parser.ml"
+# 22592 "parsing/parser.ml"
in
-# 1530 "parsing/parser.mly"
+# 1601 "parsing/parser.mly"
( Pmty_ident _1 )
-# 22265 "parsing/parser.ml"
+# 22598 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22274 "parsing/parser.ml"
+# 22607 "parsing/parser.ml"
in
-# 1541 "parsing/parser.mly"
+# 1612 "parsing/parser.mly"
( _1 )
-# 22280 "parsing/parser.ml"
+# 22613 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1533 "parsing/parser.mly"
+# 1604 "parsing/parser.mly"
( Pmty_functor(Named (mknoloc None, _1), _3) )
-# 22320 "parsing/parser.ml"
+# 22653 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22329 "parsing/parser.ml"
+# 22662 "parsing/parser.ml"
in
-# 1541 "parsing/parser.mly"
+# 1612 "parsing/parser.mly"
( _1 )
-# 22335 "parsing/parser.ml"
+# 22668 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 22377 "parsing/parser.ml"
+# 22710 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 22382 "parsing/parser.ml"
+# 22715 "parsing/parser.ml"
in
-# 1535 "parsing/parser.mly"
+# 1606 "parsing/parser.mly"
( Pmty_with(_1, _3) )
-# 22388 "parsing/parser.ml"
+# 22721 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22398 "parsing/parser.ml"
+# 22731 "parsing/parser.ml"
in
-# 1541 "parsing/parser.mly"
+# 1612 "parsing/parser.mly"
( _1 )
-# 22404 "parsing/parser.ml"
+# 22737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.module_type) = let _1 =
let _1 =
-# 1539 "parsing/parser.mly"
+# 1610 "parsing/parser.mly"
( Pmty_extension _1 )
-# 22430 "parsing/parser.ml"
+# 22763 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 862 "parsing/parser.mly"
+# 928 "parsing/parser.mly"
( mkmty ~loc:_sloc _1 )
-# 22438 "parsing/parser.ml"
+# 22771 "parsing/parser.ml"
in
-# 1541 "parsing/parser.mly"
+# 1612 "parsing/parser.mly"
( _1 )
-# 22444 "parsing/parser.ml"
+# 22777 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 22513 "parsing/parser.ml"
+# 22846 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22525 "parsing/parser.ml"
+# 22858 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 22533 "parsing/parser.ml"
+# 22866 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1455 "parsing/parser.mly"
+# 1526 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Mtd.mk id ?typ ~attrs ~loc ~docs, ext
)
-# 22547 "parsing/parser.ml"
+# 22880 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined3;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined3_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = typ;
+ MenhirLib.EngineTypes.startp = _startpos_typ_;
+ MenhirLib.EngineTypes.endp = _endpos_typ_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _6;
+ MenhirLib.EngineTypes.startp = _startpos__6_;
+ MenhirLib.EngineTypes.endp = _endpos__6_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined2;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined2_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = ext;
+ MenhirLib.EngineTypes.startp = _startpos_ext_;
+ MenhirLib.EngineTypes.endp = _endpos_ext_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
+ let typ : (Parsetree.module_type) = Obj.magic typ in
+ let _6 : unit = Obj.magic _6 in
+ let _1_inlined2 : (Asttypes.label) = Obj.magic _1_inlined2 in
+ let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
+ let ext : (string Asttypes.loc option) = Obj.magic ext in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_inlined3_ in
+ let _v : (Parsetree.module_type_declaration * string Asttypes.loc option) = let attrs2 =
+ let _1 = _1_inlined3 in
+
+# 3831 "parsing/parser.mly"
+ ( _1 )
+# 22956 "parsing/parser.ml"
+
+ in
+ let _endpos_attrs2_ = _endpos__1_inlined3_ in
+ let id =
+ let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 883 "parsing/parser.mly"
+ ( mkrhs _1 _sloc )
+# 22968 "parsing/parser.ml"
+
+ in
+ let attrs1 =
+ let _1 = _1_inlined1 in
+
+# 3835 "parsing/parser.mly"
+ ( _1 )
+# 22976 "parsing/parser.ml"
+
+ in
+ let _endpos = _endpos_attrs2_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 1786 "parsing/parser.mly"
+ (
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc _sloc in
+ let docs = symbol_docs _sloc in
+ Mtd.mk id ~typ ~attrs ~loc ~docs, ext
+ )
+# 22990 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3529 "parsing/parser.mly"
+# 3613 "parsing/parser.mly"
( _1 )
-# 22572 "parsing/parser.ml"
+# 23015 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag) =
-# 3606 "parsing/parser.mly"
+# 3694 "parsing/parser.mly"
( Immutable )
-# 22590 "parsing/parser.ml"
+# 23033 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3607 "parsing/parser.mly"
+# 3695 "parsing/parser.mly"
( Mutable )
-# 22615 "parsing/parser.ml"
+# 23058 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3615 "parsing/parser.mly"
+# 3703 "parsing/parser.mly"
( Immutable, Concrete )
-# 22633 "parsing/parser.ml"
+# 23076 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3617 "parsing/parser.mly"
+# 3705 "parsing/parser.mly"
( Mutable, Concrete )
-# 22658 "parsing/parser.ml"
+# 23101 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3619 "parsing/parser.mly"
+# 3707 "parsing/parser.mly"
( Immutable, Virtual )
-# 22683 "parsing/parser.ml"
+# 23126 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3622 "parsing/parser.mly"
+# 3710 "parsing/parser.mly"
( Mutable, Virtual )
-# 22715 "parsing/parser.ml"
+# 23158 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag * Asttypes.virtual_flag) =
-# 3622 "parsing/parser.mly"
+# 3710 "parsing/parser.mly"
( Mutable, Virtual )
-# 22747 "parsing/parser.ml"
+# 23190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) =
-# 3579 "parsing/parser.mly"
+# 3665 "parsing/parser.mly"
( _2 )
-# 22779 "parsing/parser.ml"
+# 23222 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 22800 "parsing/parser.ml"
+# 23243 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22812 "parsing/parser.ml"
+# 23255 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 22818 "parsing/parser.ml"
+# 23261 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string Asttypes.loc list) = Obj.magic xs in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 22846 "parsing/parser.ml"
+# 23289 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 22858 "parsing/parser.ml"
+# 23301 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 22864 "parsing/parser.ml"
+# 23307 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let s : (
-# 689 "parsing/parser.mly"
+# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 22885 "parsing/parser.ml"
+# 23328 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_s_ in
let _v : (string list) = let x =
-# 3575 "parsing/parser.mly"
+# 3661 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 22893 "parsing/parser.ml"
+# 23336 "parsing/parser.ml"
in
# 221 "<standard.mly>"
( [ x ] )
-# 22898 "parsing/parser.ml"
+# 23341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let xs : (string list) = Obj.magic xs in
let s : (
-# 689 "parsing/parser.mly"
+# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 22926 "parsing/parser.ml"
+# 23369 "parsing/parser.ml"
) = Obj.magic s in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_s_ in
let _endpos = _endpos_xs_ in
let _v : (string list) = let x =
-# 3575 "parsing/parser.mly"
+# 3661 "parsing/parser.mly"
( let body, _, _ = s in body )
-# 22934 "parsing/parser.ml"
+# 23377 "parsing/parser.ml"
in
# 223 "<standard.mly>"
( x :: xs )
-# 22939 "parsing/parser.ml"
+# 23382 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 22964 "parsing/parser.ml"
+# 23407 "parsing/parser.ml"
in
-# 2901 "parsing/parser.mly"
+# 2981 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 22969 "parsing/parser.ml"
+# 23412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23001 "parsing/parser.ml"
+# 23444 "parsing/parser.ml"
in
-# 2901 "parsing/parser.mly"
+# 2981 "parsing/parser.mly"
( (Ptype_abstract, priv, Some ty) )
-# 23006 "parsing/parser.ml"
+# 23449 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_cs_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23031 "parsing/parser.ml"
+# 23474 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23037 "parsing/parser.ml"
+# 23480 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23042 "parsing/parser.ml"
+# 23485 "parsing/parser.ml"
in
-# 2905 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23048 "parsing/parser.ml"
+# 23491 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23080 "parsing/parser.ml"
+# 23523 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23086 "parsing/parser.ml"
+# 23529 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23091 "parsing/parser.ml"
+# 23534 "parsing/parser.ml"
in
-# 2905 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23097 "parsing/parser.ml"
+# 23540 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23136 "parsing/parser.ml"
+# 23579 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23143 "parsing/parser.ml"
+# 23586 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23148 "parsing/parser.ml"
+# 23591 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23154 "parsing/parser.ml"
+# 23597 "parsing/parser.ml"
in
-# 2905 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23160 "parsing/parser.ml"
+# 23603 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_cs_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23206 "parsing/parser.ml"
+# 23649 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23213 "parsing/parser.ml"
+# 23656 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23218 "parsing/parser.ml"
+# 23661 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23224 "parsing/parser.ml"
+# 23667 "parsing/parser.ml"
in
-# 2905 "parsing/parser.mly"
+# 2985 "parsing/parser.mly"
( (Ptype_variant cs, priv, oty) )
-# 23230 "parsing/parser.ml"
+# 23673 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23255 "parsing/parser.ml"
+# 23698 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23261 "parsing/parser.ml"
+# 23704 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23266 "parsing/parser.ml"
+# 23709 "parsing/parser.ml"
in
-# 2909 "parsing/parser.mly"
+# 2989 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23272 "parsing/parser.ml"
+# 23715 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23304 "parsing/parser.ml"
+# 23747 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23310 "parsing/parser.ml"
+# 23753 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23315 "parsing/parser.ml"
+# 23758 "parsing/parser.ml"
in
-# 2909 "parsing/parser.mly"
+# 2989 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23321 "parsing/parser.ml"
+# 23764 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23360 "parsing/parser.ml"
+# 23803 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23367 "parsing/parser.ml"
+# 23810 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23372 "parsing/parser.ml"
+# 23815 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23378 "parsing/parser.ml"
+# 23821 "parsing/parser.ml"
in
-# 2909 "parsing/parser.mly"
+# 2989 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23384 "parsing/parser.ml"
+# 23827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23430 "parsing/parser.ml"
+# 23873 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23437 "parsing/parser.ml"
+# 23880 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23442 "parsing/parser.ml"
+# 23885 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23448 "parsing/parser.ml"
+# 23891 "parsing/parser.ml"
in
-# 2909 "parsing/parser.mly"
+# 2989 "parsing/parser.mly"
( (Ptype_open, priv, oty) )
-# 23454 "parsing/parser.ml"
+# 23897 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__3_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23493 "parsing/parser.ml"
+# 23936 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23499 "parsing/parser.ml"
+# 23942 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23504 "parsing/parser.ml"
+# 23947 "parsing/parser.ml"
in
-# 2913 "parsing/parser.mly"
+# 2993 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23510 "parsing/parser.ml"
+# 23953 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23556 "parsing/parser.ml"
+# 23999 "parsing/parser.ml"
in
let oty =
let _1 =
# 124 "<standard.mly>"
( None )
-# 23562 "parsing/parser.ml"
+# 24005 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23567 "parsing/parser.ml"
+# 24010 "parsing/parser.ml"
in
-# 2913 "parsing/parser.mly"
+# 2993 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23573 "parsing/parser.ml"
+# 24016 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 23626 "parsing/parser.ml"
+# 24069 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23633 "parsing/parser.ml"
+# 24076 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23638 "parsing/parser.ml"
+# 24081 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23644 "parsing/parser.ml"
+# 24087 "parsing/parser.ml"
in
-# 2913 "parsing/parser.mly"
+# 2993 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23650 "parsing/parser.ml"
+# 24093 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) = let priv =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 23710 "parsing/parser.ml"
+# 24153 "parsing/parser.ml"
in
let oty =
let _1 =
let x =
# 191 "<standard.mly>"
( x )
-# 23717 "parsing/parser.ml"
+# 24160 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 23722 "parsing/parser.ml"
+# 24165 "parsing/parser.ml"
in
-# 2917 "parsing/parser.mly"
+# 2997 "parsing/parser.mly"
( _1 )
-# 23728 "parsing/parser.ml"
+# 24171 "parsing/parser.ml"
in
-# 2913 "parsing/parser.mly"
+# 2993 "parsing/parser.mly"
( (Ptype_record ls, priv, oty) )
-# 23734 "parsing/parser.ml"
+# 24177 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 23789 "parsing/parser.ml"
+# 24232 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 23798 "parsing/parser.ml"
+# 24241 "parsing/parser.ml"
in
let override =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 23804 "parsing/parser.ml"
+# 24247 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1474 "parsing/parser.mly"
+# 1545 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 23817 "parsing/parser.ml"
+# 24260 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_declaration * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 23879 "parsing/parser.ml"
+# 24322 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let attrs1 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 23888 "parsing/parser.ml"
+# 24331 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 23896 "parsing/parser.ml"
+# 24339 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1474 "parsing/parser.mly"
+# 1545 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk me ~override ~attrs ~loc ~docs, ext
)
-# 23910 "parsing/parser.ml"
+# 24353 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 23965 "parsing/parser.ml"
+# 24408 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 23977 "parsing/parser.ml"
+# 24420 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 23985 "parsing/parser.ml"
+# 24428 "parsing/parser.ml"
in
let override =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 23991 "parsing/parser.ml"
+# 24434 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1489 "parsing/parser.mly"
+# 1560 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 24004 "parsing/parser.ml"
+# 24447 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.open_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 24066 "parsing/parser.ml"
+# 24509 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 24078 "parsing/parser.ml"
+# 24521 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined2 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 24086 "parsing/parser.ml"
+# 24529 "parsing/parser.ml"
in
let override =
let _1 = _1_inlined1 in
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 24094 "parsing/parser.ml"
+# 24537 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1489 "parsing/parser.mly"
+# 1560 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Opn.mk id ~override ~attrs ~loc ~docs, ext
)
-# 24108 "parsing/parser.ml"
+# 24551 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 675 "parsing/parser.mly"
+# 729 "parsing/parser.mly"
(string)
-# 24129 "parsing/parser.ml"
+# 24572 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3445 "parsing/parser.mly"
+# 3529 "parsing/parser.mly"
( _1 )
-# 24137 "parsing/parser.ml"
+# 24580 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 633 "parsing/parser.mly"
+# 687 "parsing/parser.mly"
(string)
-# 24158 "parsing/parser.ml"
+# 24601 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3446 "parsing/parser.mly"
+# 3530 "parsing/parser.mly"
( _1 )
-# 24166 "parsing/parser.ml"
+# 24609 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 634 "parsing/parser.mly"
+# 688 "parsing/parser.mly"
(string)
-# 24187 "parsing/parser.ml"
+# 24630 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3447 "parsing/parser.mly"
+# 3531 "parsing/parser.mly"
( _1 )
-# 24195 "parsing/parser.ml"
+# 24638 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24237 "parsing/parser.ml"
+# 24680 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.label) =
-# 3448 "parsing/parser.mly"
+# 3532 "parsing/parser.mly"
( "."^ _1 ^"(" ^ _3 ^ ")" )
-# 24245 "parsing/parser.ml"
+# 24688 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24294 "parsing/parser.ml"
+# 24737 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Asttypes.label) =
-# 3449 "parsing/parser.mly"
+# 3533 "parsing/parser.mly"
( "."^ _1 ^ "(" ^ _3 ^ ")<-" )
-# 24302 "parsing/parser.ml"
+# 24745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24344 "parsing/parser.ml"
+# 24787 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.label) =
-# 3450 "parsing/parser.mly"
+# 3534 "parsing/parser.mly"
( "."^ _1 ^"[" ^ _3 ^ "]" )
-# 24352 "parsing/parser.ml"
+# 24795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24401 "parsing/parser.ml"
+# 24844 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Asttypes.label) =
-# 3451 "parsing/parser.mly"
+# 3535 "parsing/parser.mly"
( "."^ _1 ^ "[" ^ _3 ^ "]<-" )
-# 24409 "parsing/parser.ml"
+# 24852 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24451 "parsing/parser.ml"
+# 24894 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Asttypes.label) =
-# 3452 "parsing/parser.mly"
+# 3536 "parsing/parser.mly"
( "."^ _1 ^"{" ^ _3 ^ "}" )
-# 24459 "parsing/parser.ml"
+# 24902 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 : (string) = Obj.magic _3 in
let _2 : unit = Obj.magic _2 in
let _1 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 24508 "parsing/parser.ml"
+# 24951 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Asttypes.label) =
-# 3453 "parsing/parser.mly"
+# 3537 "parsing/parser.mly"
( "."^ _1 ^ "{" ^ _3 ^ "}<-" )
-# 24516 "parsing/parser.ml"
+# 24959 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 686 "parsing/parser.mly"
+# 740 "parsing/parser.mly"
(string)
-# 24537 "parsing/parser.ml"
+# 24980 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3454 "parsing/parser.mly"
+# 3538 "parsing/parser.mly"
( _1 )
-# 24545 "parsing/parser.ml"
+# 24988 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3455 "parsing/parser.mly"
+# 3539 "parsing/parser.mly"
( "!" )
-# 24570 "parsing/parser.ml"
+# 25013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 627 "parsing/parser.mly"
+# 681 "parsing/parser.mly"
(string)
-# 24591 "parsing/parser.ml"
+# 25034 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (Asttypes.label) = let _1 =
-# 3459 "parsing/parser.mly"
+# 3543 "parsing/parser.mly"
( op )
-# 24599 "parsing/parser.ml"
+# 25042 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24604 "parsing/parser.ml"
+# 25047 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 628 "parsing/parser.mly"
+# 682 "parsing/parser.mly"
(string)
-# 24625 "parsing/parser.ml"
+# 25068 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (Asttypes.label) = let _1 =
-# 3460 "parsing/parser.mly"
+# 3544 "parsing/parser.mly"
( op )
-# 24633 "parsing/parser.ml"
+# 25076 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24638 "parsing/parser.ml"
+# 25081 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 629 "parsing/parser.mly"
+# 683 "parsing/parser.mly"
(string)
-# 24659 "parsing/parser.ml"
+# 25102 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (Asttypes.label) = let _1 =
-# 3461 "parsing/parser.mly"
+# 3545 "parsing/parser.mly"
( op )
-# 24667 "parsing/parser.ml"
+# 25110 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24672 "parsing/parser.ml"
+# 25115 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 630 "parsing/parser.mly"
+# 684 "parsing/parser.mly"
(string)
-# 24693 "parsing/parser.ml"
+# 25136 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (Asttypes.label) = let _1 =
-# 3462 "parsing/parser.mly"
+# 3546 "parsing/parser.mly"
( op )
-# 24701 "parsing/parser.ml"
+# 25144 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24706 "parsing/parser.ml"
+# 25149 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let op : (
-# 631 "parsing/parser.mly"
+# 685 "parsing/parser.mly"
(string)
-# 24727 "parsing/parser.ml"
+# 25170 "parsing/parser.ml"
) = Obj.magic op in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_op_ in
let _endpos = _endpos_op_ in
let _v : (Asttypes.label) = let _1 =
-# 3463 "parsing/parser.mly"
+# 3547 "parsing/parser.mly"
( op )
-# 24735 "parsing/parser.ml"
+# 25178 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24740 "parsing/parser.ml"
+# 25183 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3464 "parsing/parser.mly"
+# 3548 "parsing/parser.mly"
("+")
-# 24765 "parsing/parser.ml"
+# 25208 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24770 "parsing/parser.ml"
+# 25213 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3465 "parsing/parser.mly"
+# 3549 "parsing/parser.mly"
("+.")
-# 24795 "parsing/parser.ml"
+# 25238 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24800 "parsing/parser.ml"
+# 25243 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3466 "parsing/parser.mly"
+# 3550 "parsing/parser.mly"
("+=")
-# 24825 "parsing/parser.ml"
+# 25268 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24830 "parsing/parser.ml"
+# 25273 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3467 "parsing/parser.mly"
+# 3551 "parsing/parser.mly"
("-")
-# 24855 "parsing/parser.ml"
+# 25298 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24860 "parsing/parser.ml"
+# 25303 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3468 "parsing/parser.mly"
+# 3552 "parsing/parser.mly"
("-.")
-# 24885 "parsing/parser.ml"
+# 25328 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24890 "parsing/parser.ml"
+# 25333 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3469 "parsing/parser.mly"
+# 3553 "parsing/parser.mly"
("*")
-# 24915 "parsing/parser.ml"
+# 25358 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24920 "parsing/parser.ml"
+# 25363 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3470 "parsing/parser.mly"
+# 3554 "parsing/parser.mly"
("%")
-# 24945 "parsing/parser.ml"
+# 25388 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24950 "parsing/parser.ml"
+# 25393 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3471 "parsing/parser.mly"
+# 3555 "parsing/parser.mly"
("=")
-# 24975 "parsing/parser.ml"
+# 25418 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 24980 "parsing/parser.ml"
+# 25423 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3472 "parsing/parser.mly"
+# 3556 "parsing/parser.mly"
("<")
-# 25005 "parsing/parser.ml"
+# 25448 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25010 "parsing/parser.ml"
+# 25453 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3473 "parsing/parser.mly"
+# 3557 "parsing/parser.mly"
(">")
-# 25035 "parsing/parser.ml"
+# 25478 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25040 "parsing/parser.ml"
+# 25483 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3474 "parsing/parser.mly"
+# 3558 "parsing/parser.mly"
("or")
-# 25065 "parsing/parser.ml"
+# 25508 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25070 "parsing/parser.ml"
+# 25513 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3475 "parsing/parser.mly"
+# 3559 "parsing/parser.mly"
("||")
-# 25095 "parsing/parser.ml"
+# 25538 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25100 "parsing/parser.ml"
+# 25543 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3476 "parsing/parser.mly"
+# 3560 "parsing/parser.mly"
("&")
-# 25125 "parsing/parser.ml"
+# 25568 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25130 "parsing/parser.ml"
+# 25573 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3477 "parsing/parser.mly"
+# 3561 "parsing/parser.mly"
("&&")
-# 25155 "parsing/parser.ml"
+# 25598 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25160 "parsing/parser.ml"
+# 25603 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) = let _1 =
-# 3478 "parsing/parser.mly"
+# 3562 "parsing/parser.mly"
(":=")
-# 25185 "parsing/parser.ml"
+# 25628 "parsing/parser.ml"
in
-# 3456 "parsing/parser.mly"
+# 3540 "parsing/parser.mly"
( _1 )
-# 25190 "parsing/parser.ml"
+# 25633 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (bool) =
-# 3360 "parsing/parser.mly"
+# 3444 "parsing/parser.mly"
( true )
-# 25215 "parsing/parser.ml"
+# 25658 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (bool) =
-# 3361 "parsing/parser.mly"
+# 3445 "parsing/parser.mly"
( false )
-# 25233 "parsing/parser.ml"
+# 25676 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25251 "parsing/parser.ml"
+# 25694 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25276 "parsing/parser.ml"
+# 25719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 114 "<standard.mly>"
( None )
-# 25294 "parsing/parser.ml"
+# 25737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (unit option) =
# 116 "<standard.mly>"
( Some x )
-# 25319 "parsing/parser.ml"
+# 25762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (string Asttypes.loc option) =
# 114 "<standard.mly>"
( None )
-# 25337 "parsing/parser.ml"
+# 25780 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 25364 "parsing/parser.ml"
+# 25807 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 25379 "parsing/parser.ml"
+# 25822 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 25385 "parsing/parser.ml"
+# 25828 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25391 "parsing/parser.ml"
+# 25834 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) =
# 114 "<standard.mly>"
( None )
-# 25409 "parsing/parser.ml"
+# 25852 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25441 "parsing/parser.ml"
+# 25884 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25446 "parsing/parser.ml"
+# 25889 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 25464 "parsing/parser.ml"
+# 25907 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 25496 "parsing/parser.ml"
+# 25939 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25501 "parsing/parser.ml"
+# 25944 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) =
# 114 "<standard.mly>"
( None )
-# 25519 "parsing/parser.ml"
+# 25962 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_type option) = let x =
# 183 "<standard.mly>"
( x )
-# 25551 "parsing/parser.ml"
+# 25994 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25556 "parsing/parser.ml"
+# 25999 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) =
# 114 "<standard.mly>"
( None )
-# 25574 "parsing/parser.ml"
+# 26017 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern option) = let x =
# 183 "<standard.mly>"
( x )
-# 25606 "parsing/parser.ml"
+# 26049 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25611 "parsing/parser.ml"
+# 26054 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) =
# 114 "<standard.mly>"
( None )
-# 25629 "parsing/parser.ml"
+# 26072 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression option) = let x =
# 183 "<standard.mly>"
( x )
-# 25661 "parsing/parser.ml"
+# 26104 "parsing/parser.ml"
in
# 116 "<standard.mly>"
( Some x )
-# 25666 "parsing/parser.ml"
+# 26109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 114 "<standard.mly>"
( None )
-# 25684 "parsing/parser.ml"
+# 26127 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Parsetree.core_type option * Parsetree.core_type option) option) =
# 116 "<standard.mly>"
( Some x )
-# 25709 "parsing/parser.ml"
+# 26152 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 668 "parsing/parser.mly"
+# 722 "parsing/parser.mly"
(string)
-# 25730 "parsing/parser.ml"
+# 26173 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3661 "parsing/parser.mly"
+# 3749 "parsing/parser.mly"
( _1 )
-# 25738 "parsing/parser.ml"
+# 26181 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 25772 "parsing/parser.ml"
+# 26215 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (string) =
-# 3662 "parsing/parser.mly"
+# 3750 "parsing/parser.mly"
( _2 )
-# 25781 "parsing/parser.ml"
+# 26224 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1253 "parsing/parser.mly"
+# 1324 "parsing/parser.mly"
( mkmod ~loc:_sloc (Pmod_constraint(me, mty)) )
-# 25837 "parsing/parser.ml"
+# 26280 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1255 "parsing/parser.mly"
+# 1326 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 25892 "parsing/parser.ml"
+# 26335 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.module_expr) =
-# 1258 "parsing/parser.mly"
+# 1329 "parsing/parser.mly"
( me (* TODO consider reloc *) )
-# 25931 "parsing/parser.ml"
+# 26374 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1260 "parsing/parser.mly"
+# 1331 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 25972 "parsing/parser.ml"
+# 26415 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.module_expr) = let e =
-# 1277 "parsing/parser.mly"
+# 1348 "parsing/parser.mly"
( e )
-# 26025 "parsing/parser.ml"
+# 26468 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26032 "parsing/parser.ml"
+# 26475 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1264 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26041 "parsing/parser.ml"
+# 26484 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26116 "parsing/parser.ml"
+# 26559 "parsing/parser.ml"
in
let _endpos_ty_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1279 "parsing/parser.mly"
+# 1350 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_constraint (e, ty)) )
-# 26126 "parsing/parser.ml"
+# 26569 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26134 "parsing/parser.ml"
+# 26577 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1264 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26143 "parsing/parser.ml"
+# 26586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26233 "parsing/parser.ml"
+# 26676 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26246 "parsing/parser.ml"
+# 26689 "parsing/parser.ml"
in
let _endpos = _endpos_ty2_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1281 "parsing/parser.mly"
+# 1352 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, Some ty1, ty2)) )
-# 26255 "parsing/parser.ml"
+# 26698 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26263 "parsing/parser.ml"
+# 26706 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1264 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26272 "parsing/parser.ml"
+# 26715 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 26347 "parsing/parser.ml"
+# 26790 "parsing/parser.ml"
in
let _endpos_ty2_ = _endpos__1_ in
let _startpos = _startpos_e_ in
let _loc = (_startpos, _endpos) in
-# 1283 "parsing/parser.mly"
+# 1354 "parsing/parser.mly"
( ghexp ~loc:_loc (Pexp_coerce (e, None, ty2)) )
-# 26357 "parsing/parser.ml"
+# 26800 "parsing/parser.ml"
in
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26365 "parsing/parser.ml"
+# 26808 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1264 "parsing/parser.mly"
+# 1335 "parsing/parser.mly"
( mkmod ~loc:_sloc ~attrs (Pmod_unpack e) )
-# 26374 "parsing/parser.ml"
+# 26817 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26436 "parsing/parser.ml"
+# 26879 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1266 "parsing/parser.mly"
+# 1337 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26444 "parsing/parser.ml"
+# 26887 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26506 "parsing/parser.ml"
+# 26949 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1268 "parsing/parser.mly"
+# 1339 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 26514 "parsing/parser.ml"
+# 26957 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.module_expr) = let _3 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 26569 "parsing/parser.ml"
+# 27012 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1270 "parsing/parser.mly"
+# 1341 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 26577 "parsing/parser.ml"
+# 27020 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 805 "parsing/parser.mly"
- (Longident.t)
-# 26609 "parsing/parser.ml"
- ) =
-# 1174 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1243 "parsing/parser.mly"
( _1 )
-# 26613 "parsing/parser.ml"
+# 27052 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 795 "parsing/parser.mly"
- (Longident.t)
-# 26645 "parsing/parser.ml"
- ) =
-# 1159 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1228 "parsing/parser.mly"
( _1 )
-# 26649 "parsing/parser.ml"
+# 27084 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 789 "parsing/parser.mly"
- (Parsetree.core_type)
-# 26681 "parsing/parser.ml"
- ) =
-# 1134 "parsing/parser.mly"
+ let _v : (Parsetree.core_type) =
+# 1203 "parsing/parser.mly"
( _1 )
-# 26685 "parsing/parser.ml"
+# 27116 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 791 "parsing/parser.mly"
- (Parsetree.expression)
-# 26717 "parsing/parser.ml"
- ) =
-# 1139 "parsing/parser.mly"
+ let _v : (Parsetree.expression) =
+# 1208 "parsing/parser.mly"
( _1 )
-# 26721 "parsing/parser.ml"
+# 27148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 801 "parsing/parser.mly"
- (Longident.t)
-# 26753 "parsing/parser.ml"
- ) =
-# 1164 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1233 "parsing/parser.mly"
( _1 )
-# 26757 "parsing/parser.ml"
+# 27180 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 803 "parsing/parser.mly"
- (Longident.t)
-# 26789 "parsing/parser.ml"
- ) =
-# 1169 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1238 "parsing/parser.mly"
( _1 )
-# 26793 "parsing/parser.ml"
+# 27212 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 799 "parsing/parser.mly"
- (Longident.t)
-# 26825 "parsing/parser.ml"
- ) =
-# 1149 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1218 "parsing/parser.mly"
( _1 )
-# 26829 "parsing/parser.ml"
+# 27244 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 793 "parsing/parser.mly"
- (Parsetree.pattern)
-# 26861 "parsing/parser.ml"
- ) =
-# 1144 "parsing/parser.mly"
+ let _v : (Parsetree.pattern) =
+# 1213 "parsing/parser.mly"
( _1 )
-# 26865 "parsing/parser.ml"
+# 27276 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 797 "parsing/parser.mly"
- (Longident.t)
-# 26897 "parsing/parser.ml"
- ) =
-# 1154 "parsing/parser.mly"
+ let _v : (Longident.t) =
+# 1223 "parsing/parser.mly"
( _1 )
-# 26901 "parsing/parser.ml"
+# 27308 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2633 "parsing/parser.mly"
+# 2710 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 26945 "parsing/parser.ml"
+# 27352 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 26951 "parsing/parser.ml"
+# 27358 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2635 "parsing/parser.mly"
+# 2712 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 26983 "parsing/parser.ml"
+# 27390 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 26988 "parsing/parser.ml"
+# 27395 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2637 "parsing/parser.mly"
+# 2714 "parsing/parser.mly"
( _1 )
-# 27013 "parsing/parser.ml"
+# 27420 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27018 "parsing/parser.ml"
+# 27425 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27065 "parsing/parser.ml"
+# 27472 "parsing/parser.ml"
in
-# 2640 "parsing/parser.mly"
+# 2717 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 27071 "parsing/parser.ml"
+# 27478 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27081 "parsing/parser.ml"
+# 27488 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27087 "parsing/parser.ml"
+# 27494 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27093 "parsing/parser.ml"
+# 27500 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2642 "parsing/parser.mly"
+# 2719 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 27136 "parsing/parser.ml"
+# 27543 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27146 "parsing/parser.ml"
+# 27553 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27152 "parsing/parser.ml"
+# 27559 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27158 "parsing/parser.ml"
+# 27565 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2644 "parsing/parser.mly"
+# 2721 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 27185 "parsing/parser.ml"
+# 27592 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27193 "parsing/parser.ml"
+# 27600 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27199 "parsing/parser.ml"
+# 27606 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27205 "parsing/parser.ml"
+# 27612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2646 "parsing/parser.mly"
+# 2723 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27248 "parsing/parser.ml"
+# 27655 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27258 "parsing/parser.ml"
+# 27665 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27264 "parsing/parser.ml"
+# 27671 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27270 "parsing/parser.ml"
+# 27677 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2648 "parsing/parser.mly"
+# 2725 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 27311 "parsing/parser.ml"
+# 27718 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27320 "parsing/parser.ml"
+# 27727 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27326 "parsing/parser.ml"
+# 27733 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27332 "parsing/parser.ml"
+# 27739 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2650 "parsing/parser.mly"
+# 2727 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27375 "parsing/parser.ml"
+# 27782 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27385 "parsing/parser.ml"
+# 27792 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 27391 "parsing/parser.ml"
+# 27798 "parsing/parser.ml"
in
-# 2621 "parsing/parser.mly"
+# 2698 "parsing/parser.mly"
( _1 )
-# 27397 "parsing/parser.ml"
+# 27804 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 27447 "parsing/parser.ml"
+# 27854 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 27453 "parsing/parser.ml"
+# 27860 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2623 "parsing/parser.mly"
+# 2700 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_exception _3) _2)
-# 27462 "parsing/parser.ml"
+# 27869 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2747 "parsing/parser.mly"
+# 2827 "parsing/parser.mly"
( _3 :: _1 )
-# 27501 "parsing/parser.ml"
+# 27908 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2748 "parsing/parser.mly"
+# 2828 "parsing/parser.mly"
( [_3; _1] )
-# 27540 "parsing/parser.ml"
+# 27947 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2749 "parsing/parser.mly"
+# 2829 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27580 "parsing/parser.ml"
+# 27987 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2747 "parsing/parser.mly"
+# 2827 "parsing/parser.mly"
( _3 :: _1 )
-# 27619 "parsing/parser.ml"
+# 28026 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) =
-# 2748 "parsing/parser.mly"
+# 2828 "parsing/parser.mly"
( [_3; _1] )
-# 27658 "parsing/parser.ml"
+# 28065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern list) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2749 "parsing/parser.mly"
+# 2829 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 27698 "parsing/parser.ml"
+# 28105 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2656 "parsing/parser.mly"
+# 2733 "parsing/parser.mly"
( _1 )
-# 27723 "parsing/parser.ml"
+# 28130 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 27761 "parsing/parser.ml"
+# 28168 "parsing/parser.ml"
in
-# 2659 "parsing/parser.mly"
- ( Ppat_construct(_1, Some _2) )
-# 27767 "parsing/parser.ml"
+# 2736 "parsing/parser.mly"
+ ( Ppat_construct(_1, Some ([], _2)) )
+# 28174 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27777 "parsing/parser.ml"
+# 28184 "parsing/parser.ml"
in
-# 2662 "parsing/parser.mly"
+# 2742 "parsing/parser.mly"
( _1 )
-# 27783 "parsing/parser.ml"
+# 28190 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = pat;
+ MenhirLib.EngineTypes.startp = _startpos_pat_;
+ MenhirLib.EngineTypes.endp = _endpos_pat_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = xs;
+ MenhirLib.EngineTypes.startp = _startpos_xs_;
+ MenhirLib.EngineTypes.endp = _endpos_xs_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let pat : (Parsetree.pattern) = Obj.magic pat in
+ let _5 : unit = Obj.magic _5 in
+ let xs : (string Asttypes.loc list) = Obj.magic xs in
+ let _3 : unit = Obj.magic _3 in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : (Longident.t) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos_pat_ in
+ let _v : (Parsetree.pattern) = let _1 =
+ let _1 =
+ let newtypes =
+# 2478 "parsing/parser.mly"
+ ( xs )
+# 28252 "parsing/parser.ml"
+ in
+ let constr =
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 883 "parsing/parser.mly"
+ ( mkrhs _1 _sloc )
+# 28261 "parsing/parser.ml"
+
+ in
+
+# 2739 "parsing/parser.mly"
+ ( Ppat_construct(constr, Some (newtypes, pat)) )
+# 28267 "parsing/parser.ml"
+
+ in
+ let _endpos__1_ = _endpos_pat_ in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 918 "parsing/parser.mly"
+ ( mkpat ~loc:_sloc _1 )
+# 28277 "parsing/parser.ml"
+
+ in
+
+# 2742 "parsing/parser.mly"
+ ( _1 )
+# 28283 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2661 "parsing/parser.mly"
+# 2741 "parsing/parser.mly"
( Ppat_variant(_1, Some _2) )
-# 27816 "parsing/parser.ml"
+# 28316 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 27825 "parsing/parser.ml"
+# 28325 "parsing/parser.ml"
in
-# 2662 "parsing/parser.mly"
+# 2742 "parsing/parser.mly"
( _1 )
-# 27831 "parsing/parser.ml"
+# 28331 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 27881 "parsing/parser.ml"
+# 28381 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 27887 "parsing/parser.ml"
+# 28387 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2664 "parsing/parser.mly"
+# 2744 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_lazy _3) _2)
-# 27896 "parsing/parser.ml"
+# 28396 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__2_ = (_startpos__2_, _endpos__2_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2633 "parsing/parser.mly"
+# 2710 "parsing/parser.mly"
( mkpat_cons ~loc:_sloc _loc__2_ (ghpat ~loc:_sloc (Ppat_tuple[_1;_3])) )
-# 27940 "parsing/parser.ml"
+# 28440 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 27946 "parsing/parser.ml"
+# 28446 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2635 "parsing/parser.mly"
+# 2712 "parsing/parser.mly"
( Pat.attr _1 _2 )
-# 27978 "parsing/parser.ml"
+# 28478 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 27983 "parsing/parser.ml"
+# 28483 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
-# 2637 "parsing/parser.mly"
+# 2714 "parsing/parser.mly"
( _1 )
-# 28008 "parsing/parser.ml"
+# 28508 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28013 "parsing/parser.ml"
+# 28513 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28060 "parsing/parser.ml"
+# 28560 "parsing/parser.ml"
in
-# 2640 "parsing/parser.mly"
+# 2717 "parsing/parser.mly"
( Ppat_alias(_1, _3) )
-# 28066 "parsing/parser.ml"
+# 28566 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28076 "parsing/parser.ml"
+# 28576 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28082 "parsing/parser.ml"
+# 28582 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28088 "parsing/parser.ml"
+# 28588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2642 "parsing/parser.mly"
+# 2719 "parsing/parser.mly"
( expecting _loc__3_ "identifier" )
-# 28131 "parsing/parser.ml"
+# 28631 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28141 "parsing/parser.ml"
+# 28641 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28147 "parsing/parser.ml"
+# 28647 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28153 "parsing/parser.ml"
+# 28653 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2644 "parsing/parser.mly"
+# 2721 "parsing/parser.mly"
( Ppat_tuple(List.rev _1) )
-# 28180 "parsing/parser.ml"
+# 28680 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28188 "parsing/parser.ml"
+# 28688 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28194 "parsing/parser.ml"
+# 28694 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28200 "parsing/parser.ml"
+# 28700 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2646 "parsing/parser.mly"
+# 2723 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28243 "parsing/parser.ml"
+# 28743 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28253 "parsing/parser.ml"
+# 28753 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28259 "parsing/parser.ml"
+# 28759 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28265 "parsing/parser.ml"
+# 28765 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _1 =
-# 2648 "parsing/parser.mly"
+# 2725 "parsing/parser.mly"
( Ppat_or(_1, _3) )
-# 28306 "parsing/parser.ml"
+# 28806 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28315 "parsing/parser.ml"
+# 28815 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28321 "parsing/parser.ml"
+# 28821 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28327 "parsing/parser.ml"
+# 28827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2650 "parsing/parser.mly"
+# 2727 "parsing/parser.mly"
( expecting _loc__3_ "pattern" )
-# 28370 "parsing/parser.ml"
+# 28870 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28380 "parsing/parser.ml"
+# 28880 "parsing/parser.ml"
in
-# 2651 "parsing/parser.mly"
+# 2728 "parsing/parser.mly"
( _1 )
-# 28386 "parsing/parser.ml"
+# 28886 "parsing/parser.ml"
in
-# 2628 "parsing/parser.mly"
+# 2705 "parsing/parser.mly"
( _1 )
-# 28392 "parsing/parser.ml"
+# 28892 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 28413 "parsing/parser.ml"
+# 28913 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 28427 "parsing/parser.ml"
+# 28927 "parsing/parser.ml"
in
-# 2110 "parsing/parser.mly"
+# 2200 "parsing/parser.mly"
( Ppat_var _1 )
-# 28433 "parsing/parser.ml"
+# 28933 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28442 "parsing/parser.ml"
+# 28942 "parsing/parser.ml"
in
-# 2112 "parsing/parser.mly"
+# 2202 "parsing/parser.mly"
( _1 )
-# 28448 "parsing/parser.ml"
+# 28948 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2111 "parsing/parser.mly"
+# 2201 "parsing/parser.mly"
( Ppat_any )
-# 28474 "parsing/parser.ml"
+# 28974 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 28482 "parsing/parser.ml"
+# 28982 "parsing/parser.ml"
in
-# 2112 "parsing/parser.mly"
+# 2202 "parsing/parser.mly"
( _1 )
-# 28488 "parsing/parser.ml"
+# 28988 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.payload) =
-# 3771 "parsing/parser.mly"
+# 3861 "parsing/parser.mly"
( PStr _1 )
-# 28513 "parsing/parser.ml"
+# 29013 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3772 "parsing/parser.mly"
+# 3862 "parsing/parser.mly"
( PSig _2 )
-# 28545 "parsing/parser.ml"
+# 29045 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3773 "parsing/parser.mly"
+# 3863 "parsing/parser.mly"
( PTyp _2 )
-# 28577 "parsing/parser.ml"
+# 29077 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.payload) =
-# 3774 "parsing/parser.mly"
+# 3864 "parsing/parser.mly"
( PPat (_2, None) )
-# 28609 "parsing/parser.ml"
+# 29109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.payload) =
-# 3775 "parsing/parser.mly"
+# 3865 "parsing/parser.mly"
( PPat (_2, Some _4) )
-# 28655 "parsing/parser.ml"
+# 29155 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) =
-# 3174 "parsing/parser.mly"
+# 3258 "parsing/parser.mly"
( _1 )
-# 28680 "parsing/parser.ml"
+# 29180 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 28723 "parsing/parser.ml"
+# 29223 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 28728 "parsing/parser.ml"
+# 29228 "parsing/parser.ml"
in
-# 3166 "parsing/parser.mly"
+# 3250 "parsing/parser.mly"
( _1 )
-# 28734 "parsing/parser.ml"
+# 29234 "parsing/parser.ml"
in
-# 3170 "parsing/parser.mly"
+# 3254 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 28740 "parsing/parser.ml"
+# 29240 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__3_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 28750 "parsing/parser.ml"
+# 29250 "parsing/parser.ml"
in
-# 3176 "parsing/parser.mly"
+# 3260 "parsing/parser.mly"
( _1 )
-# 28756 "parsing/parser.ml"
+# 29256 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 28781 "parsing/parser.ml"
+# 29281 "parsing/parser.ml"
in
-# 3174 "parsing/parser.mly"
+# 3258 "parsing/parser.mly"
( _1 )
-# 28786 "parsing/parser.ml"
+# 29286 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.core_type) = let _1 =
let _1 =
let _3 =
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 28827 "parsing/parser.ml"
+# 29327 "parsing/parser.ml"
in
let _1 =
let _1 =
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 28834 "parsing/parser.ml"
+# 29334 "parsing/parser.ml"
in
-# 919 "parsing/parser.mly"
+# 985 "parsing/parser.mly"
( xs )
-# 28839 "parsing/parser.ml"
+# 29339 "parsing/parser.ml"
in
-# 3166 "parsing/parser.mly"
+# 3250 "parsing/parser.mly"
( _1 )
-# 28845 "parsing/parser.ml"
+# 29345 "parsing/parser.ml"
in
-# 3170 "parsing/parser.mly"
+# 3254 "parsing/parser.mly"
( Ptyp_poly(_1, _3) )
-# 28851 "parsing/parser.ml"
+# 29351 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_xs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 28861 "parsing/parser.ml"
+# 29361 "parsing/parser.ml"
in
-# 3176 "parsing/parser.mly"
+# 3260 "parsing/parser.mly"
( _1 )
-# 28867 "parsing/parser.ml"
+# 29367 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3734 "parsing/parser.mly"
+# 3822 "parsing/parser.mly"
( Attr.mk ~loc:(make_loc _sloc) _2 _3 )
-# 28916 "parsing/parser.ml"
+# 29416 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 28999 "parsing/parser.ml"
+# 29499 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 29011 "parsing/parser.ml"
+# 29511 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 29019 "parsing/parser.ml"
+# 29519 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2811 "parsing/parser.mly"
+# 2891 "parsing/parser.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~prim ~attrs ~loc ~docs,
ext )
-# 29032 "parsing/parser.ml"
+# 29532 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag) = let _1 =
-# 3602 "parsing/parser.mly"
+# 3690 "parsing/parser.mly"
( Public )
-# 29050 "parsing/parser.ml"
+# 29550 "parsing/parser.ml"
in
-# 3599 "parsing/parser.mly"
+# 3687 "parsing/parser.mly"
( _1 )
-# 29055 "parsing/parser.ml"
+# 29555 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) = let _1 =
-# 3603 "parsing/parser.mly"
+# 3691 "parsing/parser.mly"
( Private )
-# 29080 "parsing/parser.ml"
+# 29580 "parsing/parser.ml"
in
-# 3599 "parsing/parser.mly"
+# 3687 "parsing/parser.mly"
( _1 )
-# 29085 "parsing/parser.ml"
+# 29585 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3625 "parsing/parser.mly"
+# 3713 "parsing/parser.mly"
( Public, Concrete )
-# 29103 "parsing/parser.ml"
+# 29603 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3626 "parsing/parser.mly"
+# 3714 "parsing/parser.mly"
( Private, Concrete )
-# 29128 "parsing/parser.ml"
+# 29628 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3627 "parsing/parser.mly"
+# 3715 "parsing/parser.mly"
( Public, Virtual )
-# 29153 "parsing/parser.ml"
+# 29653 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3628 "parsing/parser.mly"
+# 3716 "parsing/parser.mly"
( Private, Virtual )
-# 29185 "parsing/parser.ml"
+# 29685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag * Asttypes.virtual_flag) =
-# 3629 "parsing/parser.mly"
+# 3717 "parsing/parser.mly"
( Private, Virtual )
-# 29217 "parsing/parser.ml"
+# 29717 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.rec_flag) =
-# 3582 "parsing/parser.mly"
+# 3668 "parsing/parser.mly"
( Nonrecursive )
-# 29235 "parsing/parser.ml"
+# 29735 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.rec_flag) =
-# 3583 "parsing/parser.mly"
+# 3669 "parsing/parser.mly"
( Recursive )
-# 29260 "parsing/parser.ml"
+# 29760 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
(Longident.t Asttypes.loc * Parsetree.expression) list) = let eo =
# 124 "<standard.mly>"
( None )
-# 29286 "parsing/parser.ml"
+# 29786 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2630 "parsing/parser.mly"
( eo, fields )
-# 29291 "parsing/parser.ml"
+# 29791 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x =
# 191 "<standard.mly>"
( x )
-# 29332 "parsing/parser.ml"
+# 29832 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 29337 "parsing/parser.ml"
+# 29837 "parsing/parser.ml"
in
-# 2553 "parsing/parser.mly"
+# 2630 "parsing/parser.mly"
( eo, fields )
-# 29343 "parsing/parser.ml"
+# 29843 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2996 "parsing/parser.mly"
+# 3076 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29373 "parsing/parser.ml"
+# 29873 "parsing/parser.ml"
in
-# 1029 "parsing/parser.mly"
+# 1095 "parsing/parser.mly"
( [x] )
-# 29378 "parsing/parser.ml"
+# 29878 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2996 "parsing/parser.mly"
+# 3076 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29408 "parsing/parser.ml"
+# 29908 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1098 "parsing/parser.mly"
( [x] )
-# 29413 "parsing/parser.ml"
+# 29913 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.constructor_declaration list) = let x =
-# 2996 "parsing/parser.mly"
+# 3076 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Type.constructor cid ~args ?res ~attrs ~loc ~info
)
-# 29450 "parsing/parser.ml"
+# 29950 "parsing/parser.ml"
in
-# 1036 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( x :: xs )
-# 29455 "parsing/parser.ml"
+# 29955 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29486 "parsing/parser.ml"
+# 29986 "parsing/parser.ml"
in
-# 3102 "parsing/parser.mly"
+# 3182 "parsing/parser.mly"
( _1 )
-# 29491 "parsing/parser.ml"
+# 29991 "parsing/parser.ml"
in
-# 1029 "parsing/parser.mly"
+# 1095 "parsing/parser.mly"
( [x] )
-# 29497 "parsing/parser.ml"
+# 29997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3104 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 29522 "parsing/parser.ml"
+# 30022 "parsing/parser.ml"
in
-# 1029 "parsing/parser.mly"
+# 1095 "parsing/parser.mly"
( [x] )
-# 29527 "parsing/parser.ml"
+# 30027 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29558 "parsing/parser.ml"
+# 30058 "parsing/parser.ml"
in
-# 3102 "parsing/parser.mly"
+# 3182 "parsing/parser.mly"
( _1 )
-# 29563 "parsing/parser.ml"
+# 30063 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1098 "parsing/parser.mly"
( [x] )
-# 29569 "parsing/parser.ml"
+# 30069 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3104 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 29594 "parsing/parser.ml"
+# 30094 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1098 "parsing/parser.mly"
( [x] )
-# 29599 "parsing/parser.ml"
+# 30099 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
let _1 =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29637 "parsing/parser.ml"
+# 30137 "parsing/parser.ml"
in
-# 3102 "parsing/parser.mly"
+# 3182 "parsing/parser.mly"
( _1 )
-# 29642 "parsing/parser.ml"
+# 30142 "parsing/parser.ml"
in
-# 1036 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( x :: xs )
-# 29648 "parsing/parser.ml"
+# 30148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3104 "parsing/parser.mly"
+# 3184 "parsing/parser.mly"
( _1 )
-# 29680 "parsing/parser.ml"
+# 30180 "parsing/parser.ml"
in
-# 1036 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( x :: xs )
-# 29685 "parsing/parser.ml"
+# 30185 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29715 "parsing/parser.ml"
+# 30215 "parsing/parser.ml"
in
-# 1029 "parsing/parser.mly"
+# 1095 "parsing/parser.mly"
( [x] )
-# 29720 "parsing/parser.ml"
+# 30220 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_d_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29750 "parsing/parser.ml"
+# 30250 "parsing/parser.ml"
in
-# 1032 "parsing/parser.mly"
+# 1098 "parsing/parser.mly"
( [x] )
-# 29755 "parsing/parser.ml"
+# 30255 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_d_ in
let _v : (Parsetree.extension_constructor list) = let x =
-# 3108 "parsing/parser.mly"
+# 3188 "parsing/parser.mly"
(
let cid, args, res, attrs, loc, info = d in
Te.decl cid ~args ?res ~attrs ~loc ~info
)
-# 29792 "parsing/parser.ml"
+# 30292 "parsing/parser.ml"
in
-# 1036 "parsing/parser.mly"
+# 1102 "parsing/parser.mly"
( x :: xs )
-# 29797 "parsing/parser.ml"
+# 30297 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * Parsetree.core_type * Ast_helper.loc) list) =
-# 895 "parsing/parser.mly"
+# 961 "parsing/parser.mly"
( [] )
-# 29815 "parsing/parser.ml"
+# 30315 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1990 "parsing/parser.mly"
+# 2080 "parsing/parser.mly"
( _1, _3, make_loc _sloc )
-# 29874 "parsing/parser.ml"
+# 30374 "parsing/parser.ml"
in
# 183 "<standard.mly>"
( x )
-# 29880 "parsing/parser.ml"
+# 30380 "parsing/parser.ml"
in
-# 897 "parsing/parser.mly"
+# 963 "parsing/parser.mly"
( x :: xs )
-# 29886 "parsing/parser.ml"
+# 30386 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 909 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [ x ] )
-# 29911 "parsing/parser.ml"
+# 30411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Lexing.position * Parsetree.functor_parameter) list) =
-# 911 "parsing/parser.mly"
+# 977 "parsing/parser.mly"
( x :: xs )
-# 29943 "parsing/parser.ml"
+# 30443 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 909 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [ x ] )
-# 29968 "parsing/parser.ml"
+# 30468 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Asttypes.arg_label * Parsetree.expression) list) =
-# 911 "parsing/parser.mly"
+# 977 "parsing/parser.mly"
( x :: xs )
-# 30000 "parsing/parser.ml"
+# 30500 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 909 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [ x ] )
-# 30025 "parsing/parser.ml"
+# 30525 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Asttypes.label list) =
-# 911 "parsing/parser.mly"
+# 977 "parsing/parser.mly"
( x :: xs )
-# 30057 "parsing/parser.ml"
+# 30557 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30095 "parsing/parser.ml"
+# 30595 "parsing/parser.ml"
in
-# 3162 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _2 )
-# 30101 "parsing/parser.ml"
+# 30601 "parsing/parser.ml"
in
-# 909 "parsing/parser.mly"
+# 975 "parsing/parser.mly"
( [ x ] )
-# 30107 "parsing/parser.ml"
+# 30607 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 30152 "parsing/parser.ml"
+# 30652 "parsing/parser.ml"
in
-# 3162 "parsing/parser.mly"
+# 3246 "parsing/parser.mly"
( _2 )
-# 30158 "parsing/parser.ml"
+# 30658 "parsing/parser.ml"
in
-# 911 "parsing/parser.mly"
+# 977 "parsing/parser.mly"
( x :: xs )
-# 30164 "parsing/parser.ml"
+# 30664 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.case list) = let _1 =
# 124 "<standard.mly>"
( None )
-# 30189 "parsing/parser.ml"
+# 30689 "parsing/parser.ml"
in
-# 1000 "parsing/parser.mly"
+# 1066 "parsing/parser.mly"
( [x] )
-# 30194 "parsing/parser.ml"
+# 30694 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 30228 "parsing/parser.ml"
+# 30728 "parsing/parser.ml"
in
-# 1000 "parsing/parser.mly"
+# 1066 "parsing/parser.mly"
( [x] )
-# 30234 "parsing/parser.ml"
+# 30734 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.case list) =
-# 1004 "parsing/parser.mly"
+# 1070 "parsing/parser.mly"
( x :: xs )
-# 30273 "parsing/parser.ml"
+# 30773 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 30299 "parsing/parser.ml"
+# 30799 "parsing/parser.ml"
in
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30304 "parsing/parser.ml"
+# 30804 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30310 "parsing/parser.ml"
+# 30810 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type list) = let xs =
let x =
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 30350 "parsing/parser.ml"
+# 30850 "parsing/parser.ml"
in
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30355 "parsing/parser.ml"
+# 30855 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30361 "parsing/parser.ml"
+# 30861 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30386 "parsing/parser.ml"
+# 30886 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30391 "parsing/parser.ml"
+# 30891 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.with_constraint list) = let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30430 "parsing/parser.ml"
+# 30930 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30435 "parsing/parser.ml"
+# 30935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30460 "parsing/parser.ml"
+# 30960 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30465 "parsing/parser.ml"
+# 30965 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.row_field list) = let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30504 "parsing/parser.ml"
+# 31004 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30509 "parsing/parser.ml"
+# 31009 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30534 "parsing/parser.ml"
+# 31034 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30539 "parsing/parser.ml"
+# 31039 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30578 "parsing/parser.ml"
+# 31078 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30583 "parsing/parser.ml"
+# 31083 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30608 "parsing/parser.ml"
+# 31108 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30613 "parsing/parser.ml"
+# 31113 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30652 "parsing/parser.ml"
+# 31152 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30657 "parsing/parser.ml"
+# 31157 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 935 "parsing/parser.mly"
+# 1001 "parsing/parser.mly"
( [ x ] )
-# 30682 "parsing/parser.ml"
+# 31182 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30687 "parsing/parser.ml"
+# 31187 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) = let xs =
-# 939 "parsing/parser.mly"
+# 1005 "parsing/parser.mly"
( x :: xs )
-# 30726 "parsing/parser.ml"
+# 31226 "parsing/parser.ml"
in
-# 943 "parsing/parser.mly"
+# 1009 "parsing/parser.mly"
( xs )
-# 30731 "parsing/parser.ml"
+# 31231 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 966 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( x :: xs )
-# 30770 "parsing/parser.ml"
+# 31270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 970 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30809 "parsing/parser.ml"
+# 31309 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.expression list) =
-# 966 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( x :: xs )
-# 30848 "parsing/parser.ml"
+# 31348 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.expression list) =
-# 970 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30887 "parsing/parser.ml"
+# 31387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_xs_ in
let _endpos = _endpos_x_ in
let _v : (Parsetree.core_type list) =
-# 966 "parsing/parser.mly"
+# 1032 "parsing/parser.mly"
( x :: xs )
-# 30926 "parsing/parser.ml"
+# 31426 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x1_ in
let _endpos = _endpos_x2_ in
let _v : (Parsetree.core_type list) =
-# 970 "parsing/parser.mly"
+# 1036 "parsing/parser.mly"
( [ x2; x1 ] )
-# 30965 "parsing/parser.ml"
+# 31465 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.row_field) =
-# 3345 "parsing/parser.mly"
+# 3429 "parsing/parser.mly"
( _1 )
-# 30990 "parsing/parser.ml"
+# 31490 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3347 "parsing/parser.mly"
+# 3431 "parsing/parser.mly"
( Rf.inherit_ ~loc:(make_loc _sloc) _1 )
-# 31018 "parsing/parser.ml"
+# 31518 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31043 "parsing/parser.ml"
+# 31543 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31048 "parsing/parser.ml"
+# 31548 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31082 "parsing/parser.ml"
+# 31582 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31088 "parsing/parser.ml"
+# 31588 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.expression list) =
-# 991 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( x :: xs )
-# 31127 "parsing/parser.ml"
+# 31627 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 31155 "parsing/parser.ml"
+# 31655 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31163 "parsing/parser.ml"
+# 31663 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 31170 "parsing/parser.ml"
+# 31670 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31178 "parsing/parser.ml"
+# 31678 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2576 "parsing/parser.mly"
+# 2653 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31196 "parsing/parser.ml"
+# 31696 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31202 "parsing/parser.ml"
+# 31702 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let x : unit = Obj.magic x in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 31237 "parsing/parser.ml"
+# 31737 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 31245 "parsing/parser.ml"
+# 31745 "parsing/parser.ml"
in
let x =
let label =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 31252 "parsing/parser.ml"
+# 31752 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31260 "parsing/parser.ml"
+# 31760 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2576 "parsing/parser.mly"
+# 2653 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31278 "parsing/parser.ml"
+# 31778 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31284 "parsing/parser.ml"
+# 31784 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 : unit = Obj.magic _2 in
let oe : (Parsetree.expression option) = Obj.magic oe in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 31326 "parsing/parser.ml"
+# 31826 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _v : ((Asttypes.label Asttypes.loc * Parsetree.expression) list) = let x =
let label =
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 31336 "parsing/parser.ml"
+# 31836 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31344 "parsing/parser.ml"
+# 31844 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2576 "parsing/parser.mly"
+# 2653 "parsing/parser.mly"
( let e =
match oe with
| None ->
e
in
label, e )
-# 31362 "parsing/parser.ml"
+# 31862 "parsing/parser.ml"
in
-# 991 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( x :: xs )
-# 31368 "parsing/parser.ml"
+# 31868 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31393 "parsing/parser.ml"
+# 31893 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31398 "parsing/parser.ml"
+# 31898 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
# 126 "<standard.mly>"
( Some x )
-# 31432 "parsing/parser.ml"
+# 31932 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31438 "parsing/parser.ml"
+# 31938 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_x_ in
let _endpos = _endpos_xs_ in
let _v : (Parsetree.pattern list) =
-# 991 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( x :: xs )
-# 31477 "parsing/parser.ml"
+# 31977 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 124 "<standard.mly>"
( None )
-# 31516 "parsing/parser.ml"
+# 32016 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31526 "parsing/parser.ml"
+# 32026 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2559 "parsing/parser.mly"
+# 2636 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31544 "parsing/parser.ml"
+# 32044 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31550 "parsing/parser.ml"
+# 32050 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : ((Longident.t Asttypes.loc * Parsetree.expression) list) = let _2 =
# 126 "<standard.mly>"
( Some x )
-# 31596 "parsing/parser.ml"
+# 32096 "parsing/parser.ml"
in
let x =
let label =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31606 "parsing/parser.ml"
+# 32106 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2559 "parsing/parser.mly"
+# 2636 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31624 "parsing/parser.ml"
+# 32124 "parsing/parser.ml"
in
-# 987 "parsing/parser.mly"
+# 1053 "parsing/parser.mly"
( [x] )
-# 31630 "parsing/parser.ml"
+# 32130 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31688 "parsing/parser.ml"
+# 32188 "parsing/parser.ml"
in
let _startpos_label_ = _startpos__1_ in
let _symbolstartpos = _startpos_label_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2559 "parsing/parser.mly"
+# 2636 "parsing/parser.mly"
( let e =
match eo with
| None ->
e
in
label, mkexp_opt_constraint ~loc:_sloc e c )
-# 31706 "parsing/parser.ml"
+# 32206 "parsing/parser.ml"
in
-# 991 "parsing/parser.mly"
+# 1057 "parsing/parser.mly"
( x :: xs )
-# 31712 "parsing/parser.ml"
+# 32212 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) =
-# 2079 "parsing/parser.mly"
+# 2169 "parsing/parser.mly"
( _1 )
-# 31737 "parsing/parser.ml"
+# 32237 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2080 "parsing/parser.mly"
+# 2170 "parsing/parser.mly"
( _1 )
-# 31769 "parsing/parser.ml"
+# 32269 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2082 "parsing/parser.mly"
+# 2172 "parsing/parser.mly"
( Pexp_sequence(_1, _3) )
-# 31809 "parsing/parser.ml"
+# 32309 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 31818 "parsing/parser.ml"
+# 32318 "parsing/parser.ml"
in
-# 2083 "parsing/parser.mly"
+# 2173 "parsing/parser.mly"
( _1 )
-# 31824 "parsing/parser.ml"
+# 32324 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2085 "parsing/parser.mly"
+# 2175 "parsing/parser.mly"
( let seq = mkexp ~loc:_sloc (Pexp_sequence (_1, _5)) in
let payload = PStr [mkstrexp seq []] in
mkexp ~loc:_sloc (Pexp_extension (_4, payload)) )
-# 31882 "parsing/parser.ml"
+# 32382 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 31951 "parsing/parser.ml"
+# 32451 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined4_ in
let attrs2 =
let _1 = _1_inlined3 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 31960 "parsing/parser.ml"
+# 32460 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 31972 "parsing/parser.ml"
+# 32472 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 31980 "parsing/parser.ml"
+# 32480 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3026 "parsing/parser.mly"
+# 3106 "parsing/parser.mly"
( let args, res = args_res in
let loc = make_loc (_startpos, _endpos_attrs2_) in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.decl id ~args ?res ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 31995 "parsing/parser.ml"
+# 32495 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 32021 "parsing/parser.ml"
+# 32521 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 810 "parsing/parser.mly"
+# 876 "parsing/parser.mly"
( extra_sig _startpos _endpos _1 )
-# 32029 "parsing/parser.ml"
+# 32529 "parsing/parser.ml"
in
-# 1547 "parsing/parser.mly"
+# 1618 "parsing/parser.mly"
( _1 )
-# 32035 "parsing/parser.ml"
+# 32535 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.signature_item) = let _2 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 32069 "parsing/parser.ml"
+# 32569 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1562 "parsing/parser.mly"
+# 1633 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
mksig ~loc:_sloc (Psig_extension (_1, (add_docs_attrs docs _2))) )
-# 32080 "parsing/parser.ml"
+# 32580 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1566 "parsing/parser.mly"
+# 1637 "parsing/parser.mly"
( Psig_attribute _1 )
-# 32106 "parsing/parser.ml"
+# 32606 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 858 "parsing/parser.mly"
+# 924 "parsing/parser.mly"
( mksig ~loc:_sloc _1 )
-# 32114 "parsing/parser.ml"
+# 32614 "parsing/parser.ml"
in
-# 1568 "parsing/parser.mly"
+# 1639 "parsing/parser.mly"
( _1 )
-# 32120 "parsing/parser.ml"
+# 32620 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1571 "parsing/parser.mly"
+# 1642 "parsing/parser.mly"
( psig_value _1 )
-# 32146 "parsing/parser.ml"
+# 32646 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32154 "parsing/parser.ml"
+# 32654 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32160 "parsing/parser.ml"
+# 32660 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1573 "parsing/parser.mly"
+# 1644 "parsing/parser.mly"
( psig_value _1 )
-# 32186 "parsing/parser.ml"
+# 32686 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32194 "parsing/parser.ml"
+# 32694 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32200 "parsing/parser.ml"
+# 32700 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32237 "parsing/parser.ml"
+# 32737 "parsing/parser.ml"
in
-# 2847 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _1 )
-# 32242 "parsing/parser.ml"
+# 32742 "parsing/parser.ml"
in
-# 2830 "parsing/parser.mly"
+# 2910 "parsing/parser.mly"
( _1 )
-# 32248 "parsing/parser.ml"
+# 32748 "parsing/parser.ml"
in
-# 1575 "parsing/parser.mly"
+# 1646 "parsing/parser.mly"
( psig_type _1 )
-# 32254 "parsing/parser.ml"
+# 32754 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32264 "parsing/parser.ml"
+# 32764 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32270 "parsing/parser.ml"
+# 32770 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 32307 "parsing/parser.ml"
+# 32807 "parsing/parser.ml"
in
-# 2847 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _1 )
-# 32312 "parsing/parser.ml"
+# 32812 "parsing/parser.ml"
in
-# 2835 "parsing/parser.mly"
+# 2915 "parsing/parser.mly"
( _1 )
-# 32318 "parsing/parser.ml"
+# 32818 "parsing/parser.ml"
in
-# 1577 "parsing/parser.mly"
+# 1648 "parsing/parser.mly"
( psig_typesubst _1 )
-# 32324 "parsing/parser.ml"
+# 32824 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32334 "parsing/parser.ml"
+# 32834 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32340 "parsing/parser.ml"
+# 32840 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 32427 "parsing/parser.ml"
+# 32927 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1040 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( List.rev xs )
-# 32434 "parsing/parser.ml"
+# 32934 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32444 "parsing/parser.ml"
+# 32944 "parsing/parser.ml"
in
let _4 =
-# 3590 "parsing/parser.mly"
+# 3676 "parsing/parser.mly"
( Recursive )
-# 32450 "parsing/parser.ml"
+# 32950 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 32457 "parsing/parser.ml"
+# 32957 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3095 "parsing/parser.mly"
+# 3175 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 32469 "parsing/parser.ml"
+# 32969 "parsing/parser.ml"
in
-# 3082 "parsing/parser.mly"
+# 3162 "parsing/parser.mly"
( _1 )
-# 32475 "parsing/parser.ml"
+# 32975 "parsing/parser.ml"
in
-# 1579 "parsing/parser.mly"
+# 1650 "parsing/parser.mly"
( psig_typext _1 )
-# 32481 "parsing/parser.ml"
+# 32981 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32491 "parsing/parser.ml"
+# 32991 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32497 "parsing/parser.ml"
+# 32997 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 32591 "parsing/parser.ml"
+# 33091 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1040 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( List.rev xs )
-# 32598 "parsing/parser.ml"
+# 33098 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32608 "parsing/parser.ml"
+# 33108 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3591 "parsing/parser.mly"
+# 3678 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 32619 "parsing/parser.ml"
+# 33119 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 32627 "parsing/parser.ml"
+# 33127 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3095 "parsing/parser.mly"
+# 3175 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 32639 "parsing/parser.ml"
+# 33139 "parsing/parser.ml"
in
-# 3082 "parsing/parser.mly"
+# 3162 "parsing/parser.mly"
( _1 )
-# 32645 "parsing/parser.ml"
+# 33145 "parsing/parser.ml"
in
-# 1579 "parsing/parser.mly"
+# 1650 "parsing/parser.mly"
( psig_typext _1 )
-# 32651 "parsing/parser.ml"
+# 33151 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32661 "parsing/parser.ml"
+# 33161 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32667 "parsing/parser.ml"
+# 33167 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1581 "parsing/parser.mly"
+# 1652 "parsing/parser.mly"
( psig_exception _1 )
-# 32693 "parsing/parser.ml"
+# 33193 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32701 "parsing/parser.ml"
+# 33201 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32707 "parsing/parser.ml"
+# 33207 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 32772 "parsing/parser.ml"
+# 33272 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32784 "parsing/parser.ml"
+# 33284 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 32792 "parsing/parser.ml"
+# 33292 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1610 "parsing/parser.mly"
+# 1683 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 32806 "parsing/parser.ml"
+# 33306 "parsing/parser.ml"
in
-# 1583 "parsing/parser.mly"
+# 1654 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32812 "parsing/parser.ml"
+# 33312 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32822 "parsing/parser.ml"
+# 33322 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32828 "parsing/parser.ml"
+# 33328 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 32900 "parsing/parser.ml"
+# 33400 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32913 "parsing/parser.ml"
+# 33413 "parsing/parser.ml"
in
let (_endpos_id_, _startpos_id_) = (_endpos__1_, _startpos__1_) in
let _symbolstartpos = _startpos_id_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1647 "parsing/parser.mly"
+# 1720 "parsing/parser.mly"
( Mty.alias ~loc:(make_loc _sloc) id )
-# 32923 "parsing/parser.ml"
+# 33423 "parsing/parser.ml"
in
let name =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 32934 "parsing/parser.ml"
+# 33434 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 32942 "parsing/parser.ml"
+# 33442 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1638 "parsing/parser.mly"
+# 1711 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Md.mk name body ~attrs ~loc ~docs, ext
)
-# 32956 "parsing/parser.ml"
+# 33456 "parsing/parser.ml"
in
-# 1585 "parsing/parser.mly"
+# 1656 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_module body, ext) )
-# 32962 "parsing/parser.ml"
+# 33462 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 32972 "parsing/parser.ml"
+# 33472 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 32978 "parsing/parser.ml"
+# 33478 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1587 "parsing/parser.mly"
+# 1658 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modsubst body, ext) )
-# 33004 "parsing/parser.ml"
+# 33504 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33012 "parsing/parser.ml"
+# 33512 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33018 "parsing/parser.ml"
+# 33518 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 33106 "parsing/parser.ml"
+# 33606 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33118 "parsing/parser.ml"
+# 33618 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 33126 "parsing/parser.ml"
+# 33626 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1681 "parsing/parser.mly"
+# 1754 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
ext, Md.mk name mty ~attrs ~loc ~docs
)
-# 33140 "parsing/parser.ml"
+# 33640 "parsing/parser.ml"
in
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 33146 "parsing/parser.ml"
+# 33646 "parsing/parser.ml"
in
-# 1670 "parsing/parser.mly"
+# 1743 "parsing/parser.mly"
( _1 )
-# 33152 "parsing/parser.ml"
+# 33652 "parsing/parser.ml"
in
-# 1589 "parsing/parser.mly"
+# 1660 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_recmodule l, ext) )
-# 33158 "parsing/parser.ml"
+# 33658 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33168 "parsing/parser.ml"
+# 33668 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33174 "parsing/parser.ml"
+# 33674 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1591 "parsing/parser.mly"
+# 1662 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_modtype body, ext) )
-# 33200 "parsing/parser.ml"
+# 33700 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33208 "parsing/parser.ml"
+# 33708 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
+ ( _1 )
+# 33714 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ } = _menhir_stack in
+ let _1 : (Parsetree.module_type_declaration * string Asttypes.loc option) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__1_ in
+ let _v : (Parsetree.signature_item) = let _1 =
+ let _1 =
+# 1664 "parsing/parser.mly"
+ ( let (body, ext) = _1 in (Psig_modtypesubst body, ext) )
+# 33740 "parsing/parser.ml"
+ in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 941 "parsing/parser.mly"
+ ( wrap_mksig_ext ~loc:_sloc _1 )
+# 33748 "parsing/parser.ml"
+
+ in
+
+# 1674 "parsing/parser.mly"
( _1 )
-# 33214 "parsing/parser.ml"
+# 33754 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1593 "parsing/parser.mly"
+# 1666 "parsing/parser.mly"
( let (body, ext) = _1 in (Psig_open body, ext) )
-# 33240 "parsing/parser.ml"
+# 33780 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33248 "parsing/parser.ml"
+# 33788 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33254 "parsing/parser.ml"
+# 33794 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 33312 "parsing/parser.ml"
+# 33852 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 33321 "parsing/parser.ml"
+# 33861 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1439 "parsing/parser.mly"
+# 1510 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 33335 "parsing/parser.ml"
+# 33875 "parsing/parser.ml"
in
-# 1595 "parsing/parser.mly"
+# 1668 "parsing/parser.mly"
( psig_include _1 )
-# 33341 "parsing/parser.ml"
+# 33881 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33351 "parsing/parser.ml"
+# 33891 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33357 "parsing/parser.ml"
+# 33897 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let cty : (Parsetree.class_type) = Obj.magic cty in
let _7 : unit = Obj.magic _7 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 33436 "parsing/parser.ml"
+# 33976 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 33456 "parsing/parser.ml"
+# 33996 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 33468 "parsing/parser.ml"
+# 34008 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 33476 "parsing/parser.ml"
+# 34016 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2011 "parsing/parser.mly"
+# 2101 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id cty ~virt ~params ~attrs ~loc ~docs
)
-# 33491 "parsing/parser.ml"
+# 34031 "parsing/parser.ml"
in
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 33497 "parsing/parser.ml"
+# 34037 "parsing/parser.ml"
in
-# 1999 "parsing/parser.mly"
+# 2089 "parsing/parser.mly"
( _1 )
-# 33503 "parsing/parser.ml"
+# 34043 "parsing/parser.ml"
in
-# 1597 "parsing/parser.mly"
+# 1670 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class l, ext) )
-# 33509 "parsing/parser.ml"
+# 34049 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33519 "parsing/parser.ml"
+# 34059 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33525 "parsing/parser.ml"
+# 34065 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.signature_item) = let _1 =
let _1 =
-# 1599 "parsing/parser.mly"
+# 1672 "parsing/parser.mly"
( let (ext, l) = _1 in (Psig_class_type l, ext) )
-# 33551 "parsing/parser.ml"
+# 34091 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 875 "parsing/parser.mly"
+# 941 "parsing/parser.mly"
( wrap_mksig_ext ~loc:_sloc _1 )
-# 33559 "parsing/parser.ml"
+# 34099 "parsing/parser.ml"
in
-# 1601 "parsing/parser.mly"
+# 1674 "parsing/parser.mly"
( _1 )
-# 33565 "parsing/parser.ml"
+# 34105 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.constant) =
-# 3421 "parsing/parser.mly"
+# 3505 "parsing/parser.mly"
( _1 )
-# 33590 "parsing/parser.ml"
+# 34130 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 637 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * char option)
-# 33617 "parsing/parser.ml"
+# 34157 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3422 "parsing/parser.mly"
+# 3506 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer("-" ^ n, m) )
-# 33626 "parsing/parser.ml"
+# 34166 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 616 "parsing/parser.mly"
+# 670 "parsing/parser.mly"
(string * char option)
-# 33653 "parsing/parser.ml"
+# 34193 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3423 "parsing/parser.mly"
+# 3507 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float("-" ^ f, m) )
-# 33662 "parsing/parser.ml"
+# 34202 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 637 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * char option)
-# 33689 "parsing/parser.ml"
+# 34229 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3424 "parsing/parser.mly"
+# 3508 "parsing/parser.mly"
( let (n, m) = _2 in Pconst_integer (n, m) )
-# 33698 "parsing/parser.ml"
+# 34238 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _2 : (
-# 616 "parsing/parser.mly"
+# 670 "parsing/parser.mly"
(string * char option)
-# 33725 "parsing/parser.ml"
+# 34265 "parsing/parser.ml"
) = Obj.magic _2 in
let _1 : unit = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.constant) =
-# 3425 "parsing/parser.mly"
+# 3509 "parsing/parser.mly"
( let (f, m) = _2 in Pconst_float(f, m) )
-# 33734 "parsing/parser.ml"
+# 34274 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2759 "parsing/parser.mly"
+# 2839 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 33779 "parsing/parser.ml"
+# 34319 "parsing/parser.ml"
in
-# 2730 "parsing/parser.mly"
+# 2810 "parsing/parser.mly"
( let (fields, closed) = _2 in
Ppat_record(fields, closed) )
-# 33786 "parsing/parser.ml"
+# 34326 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33796 "parsing/parser.ml"
+# 34336 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 33802 "parsing/parser.ml"
+# 34342 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 2759 "parsing/parser.mly"
+# 2839 "parsing/parser.mly"
( let fields, closed = _1 in
let closed = match closed with Some () -> Open | None -> Closed in
fields, closed )
-# 33847 "parsing/parser.ml"
+# 34387 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2733 "parsing/parser.mly"
+# 2813 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 33855 "parsing/parser.ml"
+# 34395 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33865 "parsing/parser.ml"
+# 34405 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 33871 "parsing/parser.ml"
+# 34411 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2753 "parsing/parser.mly"
+# 2833 "parsing/parser.mly"
( ps )
-# 33912 "parsing/parser.ml"
+# 34452 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2735 "parsing/parser.mly"
+# 2815 "parsing/parser.mly"
( fst (mktailpat _loc__3_ _2) )
-# 33918 "parsing/parser.ml"
+# 34458 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33928 "parsing/parser.ml"
+# 34468 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 33934 "parsing/parser.ml"
+# 34474 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2753 "parsing/parser.mly"
+# 2833 "parsing/parser.mly"
( ps )
-# 33975 "parsing/parser.ml"
+# 34515 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2737 "parsing/parser.mly"
+# 2817 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 33982 "parsing/parser.ml"
+# 34522 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 33992 "parsing/parser.ml"
+# 34532 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 33998 "parsing/parser.ml"
+# 34538 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2753 "parsing/parser.mly"
+# 2833 "parsing/parser.mly"
( ps )
-# 34039 "parsing/parser.ml"
+# 34579 "parsing/parser.ml"
in
-# 2739 "parsing/parser.mly"
+# 2819 "parsing/parser.mly"
( Ppat_array _2 )
-# 34044 "parsing/parser.ml"
+# 34584 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34054 "parsing/parser.ml"
+# 34594 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 34060 "parsing/parser.ml"
+# 34600 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2741 "parsing/parser.mly"
+# 2821 "parsing/parser.mly"
( Ppat_array [] )
-# 34093 "parsing/parser.ml"
+# 34633 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34102 "parsing/parser.ml"
+# 34642 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 34108 "parsing/parser.ml"
+# 34648 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.pattern) = let _1 =
let _1 =
let _2 =
-# 2753 "parsing/parser.mly"
+# 2833 "parsing/parser.mly"
( ps )
-# 34149 "parsing/parser.ml"
+# 34689 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2743 "parsing/parser.mly"
+# 2823 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 34156 "parsing/parser.ml"
+# 34696 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 34166 "parsing/parser.ml"
+# 34706 "parsing/parser.ml"
in
-# 2744 "parsing/parser.mly"
+# 2824 "parsing/parser.mly"
( _1 )
-# 34172 "parsing/parser.ml"
+# 34712 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2246 "parsing/parser.mly"
+# 2341 "parsing/parser.mly"
( reloc_exp ~loc:_sloc _2 )
-# 34214 "parsing/parser.ml"
+# 34754 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2248 "parsing/parser.mly"
+# 2343 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 34255 "parsing/parser.ml"
+# 34795 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2250 "parsing/parser.mly"
+# 2345 "parsing/parser.mly"
( mkexp_constraint ~loc:_sloc _2 _3 )
-# 34304 "parsing/parser.ml"
+# 34844 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let i : (Parsetree.expression) = Obj.magic i in
let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2346 "parsing/parser.mly"
+ ( None )
+# 34898 "parsing/parser.ml"
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 34903 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2252 "parsing/parser.mly"
- ( array_get ~loc:_sloc _1 _4 )
-# 34360 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- } = _menhir_stack in
- let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
-
-# 2254 "parsing/parser.mly"
- ( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 34415 "parsing/parser.ml"
+# 2347 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 34913 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let i : (Parsetree.expression) = Obj.magic i in
let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2346 "parsing/parser.mly"
+ ( None )
+# 34967 "parsing/parser.ml"
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 34972 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2256 "parsing/parser.mly"
- ( string_get ~loc:_sloc _1 _4 )
-# 34471 "parsing/parser.ml"
- in
- {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = Obj.repr _v;
- MenhirLib.EngineTypes.startp = _startpos;
- MenhirLib.EngineTypes.endp = _endpos;
- MenhirLib.EngineTypes.next = _menhir_stack;
- });
- (fun _menhir_env ->
- let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
- let {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
- };
- };
- } = _menhir_stack in
- let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
- let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
-
-# 2258 "parsing/parser.mly"
- ( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 34526 "parsing/parser.ml"
+# 2347 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 34982 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = es;
- MenhirLib.EngineTypes.startp = _startpos_es_;
- MenhirLib.EngineTypes.endp = _endpos_es_;
+ MenhirLib.EngineTypes.semv = i;
+ MenhirLib.EngineTypes.startp = _startpos_i_;
+ MenhirLib.EngineTypes.endp = _endpos_i_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = d;
+ MenhirLib.EngineTypes.startp = _startpos_d_;
+ MenhirLib.EngineTypes.endp = _endpos_d_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let es : (Parsetree.expression list) = Obj.magic es in
+ let i : (Parsetree.expression) = Obj.magic i in
let _3 : unit = Obj.magic _3 in
- let _2 : (
-# 632 "parsing/parser.mly"
- (string)
-# 34574 "parsing/parser.ml"
- ) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let d : unit = Obj.magic d in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
- ( es )
-# 34583 "parsing/parser.ml"
- in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2346 "parsing/parser.mly"
+ ( None )
+# 35036 "parsing/parser.ml"
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 35041 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2260 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc lident bracket _2 _1 _4 )
-# 34591 "parsing/parser.ml"
+# 2347 "parsing/parser.mly"
+ ( mk_indexop_expr builtin_indexing_operators ~loc:_sloc _1 )
+# 35051 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 34639 "parsing/parser.ml"
+# 35099 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35109 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 34648 "parsing/parser.ml"
- in
- let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
+# 35114 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 35120 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35125 "parsing/parser.ml"
+
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 35131 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2262 "parsing/parser.mly"
- ( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 34655 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35141 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.startp = _startpos__2_;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
};
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 34703 "parsing/parser.ml"
+# 35201 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35213 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 34712 "parsing/parser.ml"
- in
- let _endpos = _endpos__5_ in
+# 35218 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 35226 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 35231 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35237 "parsing/parser.ml"
+
+ in
+
+# 2231 "parsing/parser.mly"
+ ( array, d, Paren, i, r )
+# 35243 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2264 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc lident paren _2 _1 _4 )
-# 34720 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35253 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 34768 "parsing/parser.ml"
+# 35301 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35311 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 34777 "parsing/parser.ml"
- in
- let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
+# 35316 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 35322 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35327 "parsing/parser.ml"
+
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 35333 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2266 "parsing/parser.mly"
- ( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 34784 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35343 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.startp = _startpos__2_;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
};
let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 34832 "parsing/parser.ml"
+# 35403 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _4 =
-# 2588 "parsing/parser.mly"
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35415 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 34841 "parsing/parser.ml"
- in
- let _endpos = _endpos__5_ in
+# 35420 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 35428 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 35433 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35439 "parsing/parser.ml"
+
+ in
+
+# 2233 "parsing/parser.mly"
+ ( array, d, Brace, i, r )
+# 35445 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2268 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc lident brace _2 _1 _4 )
-# 34849 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35455 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _3;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
} = _menhir_stack in
let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let es : (Parsetree.expression list) = Obj.magic es in
let _3 : unit = Obj.magic _3 in
let _2 : (
-# 632 "parsing/parser.mly"
+# 686 "parsing/parser.mly"
(string)
-# 34897 "parsing/parser.ml"
+# 35503 "parsing/parser.ml"
) = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
+ let _startpos = _startpos_array_ in
let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35513 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
+ ( es )
+# 35518 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 35524 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35529 "parsing/parser.ml"
+
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 35535 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
-# 2270 "parsing/parser.mly"
- ( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 34908 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35545 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _5;
+ MenhirLib.EngineTypes.startp = _startpos__5_;
+ MenhirLib.EngineTypes.endp = _endpos__5_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _3;
+ MenhirLib.EngineTypes.startp = _startpos__3_;
+ MenhirLib.EngineTypes.endp = _endpos__3_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.semv = array;
+ MenhirLib.EngineTypes.startp = _startpos_array_;
+ MenhirLib.EngineTypes.endp = _endpos_array_;
MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
- let es : (Parsetree.expression list) = Obj.magic es in
let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let es : (Parsetree.expression list) = Obj.magic es in
+ let _3 : unit = Obj.magic _3 in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 34968 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
- let _1 : (Parsetree.expression) = Obj.magic _1 in
+# 35605 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1 : unit = Obj.magic _1 in
+ let array : (Parsetree.expression) = Obj.magic array in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
- let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _startpos = _startpos_array_ in
+ let _endpos = _endpos__5_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let r =
+# 2348 "parsing/parser.mly"
+ ( None )
+# 35617 "parsing/parser.ml"
+ in
+ let i =
+# 2665 "parsing/parser.mly"
( es )
-# 34979 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
+# 35622 "parsing/parser.ml"
+ in
+ let d =
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 35630 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 35635 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35641 "parsing/parser.ml"
+
+ in
+
+# 2235 "parsing/parser.mly"
+ ( array, d, Bracket, i, r )
+# 35647 "parsing/parser.ml"
+
+ in
+ let (_endpos__1_, _startpos__1_) = (_endpos__5_, _startpos_array_) in
+ let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2272 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (ldot _3) bracket _4 _1 _6 )
-# 34987 "parsing/parser.ml"
+# 2349 "parsing/parser.mly"
+ ( mk_indexop_expr user_indexing_operators ~loc:_sloc _1 )
+# 35657 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = es;
- MenhirLib.EngineTypes.startp = _startpos_es_;
- MenhirLib.EngineTypes.endp = _endpos_es_;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
- let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
- (string)
-# 35047 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
+ let _e : unit = Obj.magic _e in
+ let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let _p : unit = Obj.magic _p in
let _2 : unit = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
- ( es )
-# 35058 "parsing/parser.ml"
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2240 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
+# 35713 "parsing/parser.ml"
+
+ in
+
+# 2350 "parsing/parser.mly"
+ ( _1 )
+# 35719 "parsing/parser.ml"
in
- let _loc__7_ = (_startpos__7_, _endpos__7_) in
- let _loc__5_ = (_startpos__5_, _endpos__5_) in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _e : unit = Obj.magic _e in
+ let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let _p : unit = Obj.magic _p in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2242 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
+# 35775 "parsing/parser.ml"
+
+ in
-# 2275 "parsing/parser.mly"
- ( unclosed "[" _loc__5_ "]" _loc__7_ )
-# 35065 "parsing/parser.ml"
+# 2350 "parsing/parser.mly"
+ ( _1 )
+# 35781 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let _e : unit = Obj.magic _e in
+ let _4 : (Parsetree.expression) = Obj.magic _4 in
+ let _p : unit = Obj.magic _p in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : (Parsetree.expression) = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2244 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
+# 35837 "parsing/parser.ml"
+
+ in
+
+# 2350 "parsing/parser.mly"
+ ( _1 )
+# 35843 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
+ let _e : unit = Obj.magic _e in
let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 35125 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+# 35891 "parsing/parser.ml"
+ ) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
( es )
-# 35136 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
+# 35901 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 35907 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 35912 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2240 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
+# 35920 "parsing/parser.ml"
+
+ in
-# 2277 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (ldot _3) paren _4 _1 _6 )
-# 35144 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 35926 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.semv = _1;
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
+ let _e : unit = Obj.magic _e in
let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 35204 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+# 35986 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
( es )
-# 35215 "parsing/parser.ml"
- in
- let _loc__7_ = (_startpos__7_, _endpos__7_) in
- let _loc__5_ = (_startpos__5_, _endpos__5_) in
+# 35998 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 = _1_inlined1 in
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 36007 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 36012 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 36018 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2240 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Paren _loc__e_ )
+# 36026 "parsing/parser.ml"
+
+ in
-# 2280 "parsing/parser.mly"
- ( unclosed "(" _loc__5_ ")" _loc__7_ )
-# 35222 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 36032 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
- MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
- };
- };
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
};
};
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
+ let _e : unit = Obj.magic _e in
let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 35282 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+# 36080 "parsing/parser.ml"
+ ) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
( es )
-# 35293 "parsing/parser.ml"
- in
- let _endpos = _endpos__7_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
+# 36090 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 36096 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 36101 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2242 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
+# 36109 "parsing/parser.ml"
+
+ in
-# 2282 "parsing/parser.mly"
- ( dotop_get ~loc:_sloc (ldot _3) brace _4 _1 _6 )
-# 35301 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 36115 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _7;
- MenhirLib.EngineTypes.startp = _startpos__7_;
- MenhirLib.EngineTypes.endp = _endpos__7_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = es;
MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _2;
- MenhirLib.EngineTypes.startp = _startpos__2_;
- MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.semv = _1;
};
};
} = _menhir_stack in
- let _7 : unit = Obj.magic _7 in
+ let _e : unit = Obj.magic _e in
let es : (Parsetree.expression list) = Obj.magic es in
- let _5 : unit = Obj.magic _5 in
- let _4 : (
-# 632 "parsing/parser.mly"
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
(string)
-# 35361 "parsing/parser.ml"
- ) = Obj.magic _4 in
- let _3 : (Longident.t) = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+# 36175 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__7_ in
- let _v : (Parsetree.expression) = let _6 =
-# 2588 "parsing/parser.mly"
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
( es )
-# 35372 "parsing/parser.ml"
- in
- let _loc__7_ = (_startpos__7_, _endpos__7_) in
- let _loc__5_ = (_startpos__5_, _endpos__5_) in
+# 36187 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 = _1_inlined1 in
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 36196 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 36201 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 36207 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2242 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Brace _loc__e_ )
+# 36215 "parsing/parser.ml"
+
+ in
-# 2285 "parsing/parser.mly"
- ( unclosed "{" _loc__5_ "}" _loc__7_ )
-# 35379 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 36221 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _2;
};
};
} = _menhir_stack in
- let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+ let _e : unit = Obj.magic _e in
+ let es : (Parsetree.expression list) = Obj.magic es in
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
+ (string)
+# 36269 "parsing/parser.ml"
+ ) = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _endpos = _endpos__5_ in
- let _symbolstartpos = _startpos__1_ in
- let _sloc = (_symbolstartpos, _endpos) in
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
+ ( es )
+# 36279 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 =
+# 124 "<standard.mly>"
+ ( None )
+# 36285 "parsing/parser.ml"
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 36290 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2244 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
+# 36298 "parsing/parser.ml"
+
+ in
-# 2287 "parsing/parser.mly"
- ( bigarray_get ~loc:_sloc _1 _4 )
-# 35435 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 36304 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
let {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _5;
- MenhirLib.EngineTypes.startp = _startpos__5_;
- MenhirLib.EngineTypes.endp = _endpos__5_;
+ MenhirLib.EngineTypes.semv = _e;
+ MenhirLib.EngineTypes.startp = _startpos__e_;
+ MenhirLib.EngineTypes.endp = _endpos__e_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _4;
- MenhirLib.EngineTypes.startp = _startpos__4_;
- MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.semv = es;
+ MenhirLib.EngineTypes.startp = _startpos_es_;
+ MenhirLib.EngineTypes.endp = _endpos_es_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
- MenhirLib.EngineTypes.semv = _3;
- MenhirLib.EngineTypes.startp = _startpos__3_;
- MenhirLib.EngineTypes.endp = _endpos__3_;
+ MenhirLib.EngineTypes.semv = _p;
+ MenhirLib.EngineTypes.startp = _startpos__p_;
+ MenhirLib.EngineTypes.endp = _endpos__p_;
MenhirLib.EngineTypes.next = {
MenhirLib.EngineTypes.state = _;
MenhirLib.EngineTypes.semv = _2;
MenhirLib.EngineTypes.startp = _startpos__2_;
MenhirLib.EngineTypes.endp = _endpos__2_;
MenhirLib.EngineTypes.next = {
- MenhirLib.EngineTypes.state = _menhir_s;
- MenhirLib.EngineTypes.semv = _1;
- MenhirLib.EngineTypes.startp = _startpos__1_;
- MenhirLib.EngineTypes.endp = _endpos__1_;
- MenhirLib.EngineTypes.next = _menhir_stack;
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__2_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__2_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
};
};
};
};
} = _menhir_stack in
- let _5 : unit = Obj.magic _5 in
- let _4 : (Parsetree.expression) = Obj.magic _4 in
- let _3 : unit = Obj.magic _3 in
- let _2 : unit = Obj.magic _2 in
+ let _e : unit = Obj.magic _e in
+ let es : (Parsetree.expression list) = Obj.magic es in
+ let _p : unit = Obj.magic _p in
+ let _2 : (
+# 686 "parsing/parser.mly"
+ (string)
+# 36364 "parsing/parser.ml"
+ ) = Obj.magic _2 in
+ let _2_inlined1 : (Longident.t) = Obj.magic _2_inlined1 in
+ let _1_inlined1 : unit = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
- let _endpos = _endpos__5_ in
- let _v : (Parsetree.expression) = let _loc__5_ = (_startpos__5_, _endpos__5_) in
- let _loc__3_ = (_startpos__3_, _endpos__3_) in
+ let _endpos = _endpos__e_ in
+ let _v : (Parsetree.expression) = let _1 =
+ let _4 =
+# 2665 "parsing/parser.mly"
+ ( es )
+# 36376 "parsing/parser.ml"
+ in
+ let _2 =
+ let _1 = _1_inlined1 in
+ let _1 =
+ let _2 = _2_inlined1 in
+ let x =
+# 2247 "parsing/parser.mly"
+ (_2)
+# 36385 "parsing/parser.ml"
+ in
+
+# 126 "<standard.mly>"
+ ( Some x )
+# 36390 "parsing/parser.ml"
+
+ in
+
+# 2247 "parsing/parser.mly"
+ ( _1, _2 )
+# 36396 "parsing/parser.ml"
+
+ in
+ let _loc__p_ = (_startpos__p_, _endpos__p_) in
+ let _loc__e_ = (_startpos__e_, _endpos__e_) in
+
+# 2244 "parsing/parser.mly"
+ ( indexop_unclosed_error _loc__p_ Bracket _loc__e_ )
+# 36404 "parsing/parser.ml"
+
+ in
-# 2289 "parsing/parser.mly"
- ( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 35490 "parsing/parser.ml"
+# 2351 "parsing/parser.mly"
+ ( _1 )
+# 36410 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35546 "parsing/parser.ml"
+# 36466 "parsing/parser.ml"
in
-# 2298 "parsing/parser.mly"
+# 2360 "parsing/parser.mly"
( e.pexp_desc, (ext, attrs @ e.pexp_attributes) )
-# 35552 "parsing/parser.ml"
+# 36472 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35563 "parsing/parser.ml"
+# 36483 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35614 "parsing/parser.ml"
+# 36534 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 35620 "parsing/parser.ml"
+# 36540 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2300 "parsing/parser.mly"
+# 2362 "parsing/parser.mly"
( Pexp_construct (mkloc (Lident "()") (make_loc _sloc), None), _2 )
-# 35629 "parsing/parser.ml"
+# 36549 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35640 "parsing/parser.ml"
+# 36560 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35698 "parsing/parser.ml"
+# 36618 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 35704 "parsing/parser.ml"
+# 36624 "parsing/parser.ml"
in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2302 "parsing/parser.mly"
+# 2364 "parsing/parser.mly"
( unclosed "begin" _loc__1_ "end" _loc__4_ )
-# 35712 "parsing/parser.ml"
+# 36632 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35723 "parsing/parser.ml"
+# 36643 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 35775 "parsing/parser.ml"
+# 36695 "parsing/parser.ml"
in
let _2 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35785 "parsing/parser.ml"
+# 36705 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 35791 "parsing/parser.ml"
+# 36711 "parsing/parser.ml"
in
-# 2304 "parsing/parser.mly"
+# 2366 "parsing/parser.mly"
( Pexp_new(_3), _2 )
-# 35797 "parsing/parser.ml"
+# 36717 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35808 "parsing/parser.ml"
+# 36728 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35873 "parsing/parser.ml"
+# 36793 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 35879 "parsing/parser.ml"
+# 36799 "parsing/parser.ml"
in
-# 2306 "parsing/parser.mly"
+# 2368 "parsing/parser.mly"
( Pexp_pack _4, _3 )
-# 35885 "parsing/parser.ml"
+# 36805 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 35896 "parsing/parser.ml"
+# 36816 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 35978 "parsing/parser.ml"
+# 36898 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 35988 "parsing/parser.ml"
+# 36908 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 35994 "parsing/parser.ml"
+# 36914 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2308 "parsing/parser.mly"
+# 2370 "parsing/parser.mly"
( Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _4), _6), _3 )
-# 36003 "parsing/parser.ml"
+# 36923 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36014 "parsing/parser.ml"
+# 36934 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 36086 "parsing/parser.ml"
+# 37006 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 36092 "parsing/parser.ml"
+# 37012 "parsing/parser.ml"
in
let _loc__6_ = (_startpos__6_, _endpos__6_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2310 "parsing/parser.mly"
+# 2372 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__6_ )
-# 36100 "parsing/parser.ml"
+# 37020 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2291 "parsing/parser.mly"
+# 2353 "parsing/parser.mly"
( let desc, attrs = _1 in
mkexp_attrs ~loc:_sloc desc attrs )
-# 36111 "parsing/parser.ml"
+# 37031 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36142 "parsing/parser.ml"
+# 37062 "parsing/parser.ml"
in
-# 2314 "parsing/parser.mly"
+# 2376 "parsing/parser.mly"
( Pexp_ident (_1) )
-# 36148 "parsing/parser.ml"
+# 37068 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36157 "parsing/parser.ml"
+# 37077 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36163 "parsing/parser.ml"
+# 37083 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2316 "parsing/parser.mly"
+# 2378 "parsing/parser.mly"
( Pexp_constant _1 )
-# 36189 "parsing/parser.ml"
+# 37109 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36197 "parsing/parser.ml"
+# 37117 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36203 "parsing/parser.ml"
+# 37123 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36234 "parsing/parser.ml"
+# 37154 "parsing/parser.ml"
in
-# 2318 "parsing/parser.mly"
+# 2380 "parsing/parser.mly"
( Pexp_construct(_1, None) )
-# 36240 "parsing/parser.ml"
+# 37160 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36249 "parsing/parser.ml"
+# 37169 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36255 "parsing/parser.ml"
+# 37175 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2320 "parsing/parser.mly"
+# 2382 "parsing/parser.mly"
( Pexp_variant(_1, None) )
-# 36281 "parsing/parser.ml"
+# 37201 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36289 "parsing/parser.ml"
+# 37209 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36295 "parsing/parser.ml"
+# 37215 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _2 : (Parsetree.expression) = Obj.magic _2 in
let _1 : (
-# 675 "parsing/parser.mly"
+# 729 "parsing/parser.mly"
(string)
-# 36323 "parsing/parser.ml"
+# 37243 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 36337 "parsing/parser.ml"
+# 37257 "parsing/parser.ml"
in
-# 2322 "parsing/parser.mly"
+# 2384 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 36343 "parsing/parser.ml"
+# 37263 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36353 "parsing/parser.ml"
+# 37273 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36359 "parsing/parser.ml"
+# 37279 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 2323 "parsing/parser.mly"
+# 2385 "parsing/parser.mly"
("!")
-# 36394 "parsing/parser.ml"
+# 37314 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 36402 "parsing/parser.ml"
+# 37322 "parsing/parser.ml"
in
-# 2324 "parsing/parser.mly"
+# 2386 "parsing/parser.mly"
( Pexp_apply(_1, [Nolabel,_2]) )
-# 36408 "parsing/parser.ml"
+# 37328 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36418 "parsing/parser.ml"
+# 37338 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36424 "parsing/parser.ml"
+# 37344 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2571 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( xs )
-# 36465 "parsing/parser.ml"
+# 37385 "parsing/parser.ml"
in
-# 2326 "parsing/parser.mly"
+# 2388 "parsing/parser.mly"
( Pexp_override _2 )
-# 36470 "parsing/parser.ml"
+# 37390 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36480 "parsing/parser.ml"
+# 37400 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36486 "parsing/parser.ml"
+# 37406 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2571 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( xs )
-# 36527 "parsing/parser.ml"
+# 37447 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2328 "parsing/parser.mly"
+# 2390 "parsing/parser.mly"
( unclosed "{<" _loc__1_ ">}" _loc__3_ )
-# 36534 "parsing/parser.ml"
+# 37454 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36544 "parsing/parser.ml"
+# 37464 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36550 "parsing/parser.ml"
+# 37470 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2330 "parsing/parser.mly"
+# 2392 "parsing/parser.mly"
( Pexp_override [] )
-# 36583 "parsing/parser.ml"
+# 37503 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36592 "parsing/parser.ml"
+# 37512 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36598 "parsing/parser.ml"
+# 37518 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36644 "parsing/parser.ml"
+# 37564 "parsing/parser.ml"
in
-# 2332 "parsing/parser.mly"
+# 2394 "parsing/parser.mly"
( Pexp_field(_1, _3) )
-# 36650 "parsing/parser.ml"
+# 37570 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36660 "parsing/parser.ml"
+# 37580 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36666 "parsing/parser.ml"
+# 37586 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36726 "parsing/parser.ml"
+# 37646 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36735 "parsing/parser.ml"
+# 37655 "parsing/parser.ml"
in
-# 2334 "parsing/parser.mly"
+# 2396 "parsing/parser.mly"
( Pexp_open(od, _4) )
-# 36741 "parsing/parser.ml"
+# 37661 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36751 "parsing/parser.ml"
+# 37671 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36757 "parsing/parser.ml"
+# 37677 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2571 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( xs )
-# 36812 "parsing/parser.ml"
+# 37732 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36822 "parsing/parser.ml"
+# 37742 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 36831 "parsing/parser.ml"
+# 37751 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2336 "parsing/parser.mly"
+# 2398 "parsing/parser.mly"
( (* TODO: review the location of Pexp_override *)
Pexp_open(od, mkexp ~loc:_sloc (Pexp_override _4)) )
-# 36842 "parsing/parser.ml"
+# 37762 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36852 "parsing/parser.ml"
+# 37772 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36858 "parsing/parser.ml"
+# 37778 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2571 "parsing/parser.mly"
+# 2648 "parsing/parser.mly"
( xs )
-# 36913 "parsing/parser.ml"
+# 37833 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2339 "parsing/parser.mly"
+# 2401 "parsing/parser.mly"
( unclosed "{<" _loc__3_ ">}" _loc__5_ )
-# 36920 "parsing/parser.ml"
+# 37840 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 36930 "parsing/parser.ml"
+# 37850 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 36936 "parsing/parser.ml"
+# 37856 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 36969 "parsing/parser.ml"
+# 37889 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _2 : unit = Obj.magic _2 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _3 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 36983 "parsing/parser.ml"
+# 37903 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 36991 "parsing/parser.ml"
+# 37911 "parsing/parser.ml"
in
-# 2341 "parsing/parser.mly"
+# 2403 "parsing/parser.mly"
( Pexp_send(_1, _3) )
-# 36997 "parsing/parser.ml"
+# 37917 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37007 "parsing/parser.ml"
+# 37927 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37013 "parsing/parser.ml"
+# 37933 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
} = _menhir_stack in
let _3 : (Parsetree.expression) = Obj.magic _3 in
let _1_inlined1 : (
-# 686 "parsing/parser.mly"
+# 740 "parsing/parser.mly"
(string)
-# 37047 "parsing/parser.ml"
+# 37967 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _1 : (Parsetree.expression) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 844 "parsing/parser.mly"
+# 910 "parsing/parser.mly"
( mkoperator ~loc:_sloc _1 )
-# 37063 "parsing/parser.ml"
+# 37983 "parsing/parser.ml"
in
-# 2343 "parsing/parser.mly"
+# 2405 "parsing/parser.mly"
( mkinfix _1 _2 _3 )
-# 37069 "parsing/parser.ml"
+# 37989 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37079 "parsing/parser.ml"
+# 37999 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37085 "parsing/parser.ml"
+# 38005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2345 "parsing/parser.mly"
+# 2407 "parsing/parser.mly"
( Pexp_extension _1 )
-# 37111 "parsing/parser.ml"
+# 38031 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37119 "parsing/parser.ml"
+# 38039 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37125 "parsing/parser.ml"
+# 38045 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2346 "parsing/parser.mly"
+# 2408 "parsing/parser.mly"
(Lident "()")
-# 37175 "parsing/parser.ml"
+# 38095 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37184 "parsing/parser.ml"
+# 38104 "parsing/parser.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37196 "parsing/parser.ml"
+# 38116 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37205 "parsing/parser.ml"
+# 38125 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2347 "parsing/parser.mly"
+# 2409 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:(_loc__3_) (Pexp_construct(_3, None))) )
-# 37212 "parsing/parser.ml"
+# 38132 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37222 "parsing/parser.ml"
+# 38142 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37228 "parsing/parser.ml"
+# 38148 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2349 "parsing/parser.mly"
+# 2411 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 37285 "parsing/parser.ml"
+# 38205 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37295 "parsing/parser.ml"
+# 38215 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37301 "parsing/parser.ml"
+# 38221 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2351 "parsing/parser.mly"
+# 2413 "parsing/parser.mly"
( let (exten, fields) = _2 in
Pexp_record(fields, exten) )
-# 37343 "parsing/parser.ml"
+# 38263 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37352 "parsing/parser.ml"
+# 38272 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37358 "parsing/parser.ml"
+# 38278 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2354 "parsing/parser.mly"
+# 2416 "parsing/parser.mly"
( unclosed "{" _loc__1_ "}" _loc__3_ )
-# 37402 "parsing/parser.ml"
+# 38322 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37412 "parsing/parser.ml"
+# 38332 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37418 "parsing/parser.ml"
+# 38338 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37479 "parsing/parser.ml"
+# 38399 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37488 "parsing/parser.ml"
+# 38408 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
-# 2356 "parsing/parser.mly"
+# 2418 "parsing/parser.mly"
( let (exten, fields) = _4 in
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos)
(Pexp_record(fields, exten))) )
-# 37497 "parsing/parser.ml"
+# 38417 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37507 "parsing/parser.ml"
+# 38427 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37513 "parsing/parser.ml"
+# 38433 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2360 "parsing/parser.mly"
+# 2422 "parsing/parser.mly"
( unclosed "{" _loc__3_ "}" _loc__5_ )
-# 37571 "parsing/parser.ml"
+# 38491 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37581 "parsing/parser.ml"
+# 38501 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37587 "parsing/parser.ml"
+# 38507 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 37628 "parsing/parser.ml"
+# 38548 "parsing/parser.ml"
in
-# 2362 "parsing/parser.mly"
+# 2424 "parsing/parser.mly"
( Pexp_array(_2) )
-# 37633 "parsing/parser.ml"
+# 38553 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37643 "parsing/parser.ml"
+# 38563 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37649 "parsing/parser.ml"
+# 38569 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 37690 "parsing/parser.ml"
+# 38610 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2364 "parsing/parser.mly"
+# 2426 "parsing/parser.mly"
( unclosed "[|" _loc__1_ "|]" _loc__3_ )
-# 37697 "parsing/parser.ml"
+# 38617 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37707 "parsing/parser.ml"
+# 38627 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37713 "parsing/parser.ml"
+# 38633 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) = let _1 =
let _1 =
-# 2366 "parsing/parser.mly"
+# 2428 "parsing/parser.mly"
( Pexp_array [] )
-# 37746 "parsing/parser.ml"
+# 38666 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37755 "parsing/parser.ml"
+# 38675 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37761 "parsing/parser.ml"
+# 38681 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 37816 "parsing/parser.ml"
+# 38736 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37826 "parsing/parser.ml"
+# 38746 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37835 "parsing/parser.ml"
+# 38755 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
-# 2368 "parsing/parser.mly"
+# 2430 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array(_4))) )
-# 37842 "parsing/parser.ml"
+# 38762 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37852 "parsing/parser.ml"
+# 38772 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37858 "parsing/parser.ml"
+# 38778 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 37911 "parsing/parser.ml"
+# 38831 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 37920 "parsing/parser.ml"
+# 38840 "parsing/parser.ml"
in
let _endpos = _endpos__4_ in
-# 2370 "parsing/parser.mly"
+# 2432 "parsing/parser.mly"
( (* TODO: review the location of Pexp_array *)
Pexp_open(od, mkexp ~loc:(_startpos__3_, _endpos) (Pexp_array [])) )
-# 37928 "parsing/parser.ml"
+# 38848 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 37938 "parsing/parser.ml"
+# 38858 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 37944 "parsing/parser.ml"
+# 38864 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 37999 "parsing/parser.ml"
+# 38919 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2374 "parsing/parser.mly"
+# 2436 "parsing/parser.mly"
( unclosed "[|" _loc__3_ "|]" _loc__5_ )
-# 38006 "parsing/parser.ml"
+# 38926 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38016 "parsing/parser.ml"
+# 38936 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38022 "parsing/parser.ml"
+# 38942 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 38063 "parsing/parser.ml"
+# 38983 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2376 "parsing/parser.mly"
+# 2438 "parsing/parser.mly"
( fst (mktailexp _loc__3_ _2) )
-# 38069 "parsing/parser.ml"
+# 38989 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38079 "parsing/parser.ml"
+# 38999 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38085 "parsing/parser.ml"
+# 39005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _2 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 38126 "parsing/parser.ml"
+# 39046 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2378 "parsing/parser.mly"
+# 2440 "parsing/parser.mly"
( unclosed "[" _loc__1_ "]" _loc__3_ )
-# 38133 "parsing/parser.ml"
+# 39053 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38143 "parsing/parser.ml"
+# 39063 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38149 "parsing/parser.ml"
+# 39069 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 38204 "parsing/parser.ml"
+# 39124 "parsing/parser.ml"
in
let od =
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38214 "parsing/parser.ml"
+# 39134 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38223 "parsing/parser.ml"
+# 39143 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
-# 2380 "parsing/parser.mly"
+# 2442 "parsing/parser.mly"
( let list_exp =
(* TODO: review the location of list_exp *)
let tail_exp, _tail_loc = mktailexp _loc__5_ _4 in
mkexp ~loc:(_startpos__3_, _endpos) tail_exp in
Pexp_open(od, list_exp) )
-# 38235 "parsing/parser.ml"
+# 39155 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38245 "parsing/parser.ml"
+# 39165 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38251 "parsing/parser.ml"
+# 39171 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2385 "parsing/parser.mly"
+# 2447 "parsing/parser.mly"
(Lident "[]")
-# 38301 "parsing/parser.ml"
+# 39221 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38310 "parsing/parser.ml"
+# 39230 "parsing/parser.ml"
in
let (_endpos__3_, _startpos__3_) = (_endpos__2_inlined1_, _startpos__1_inlined1_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38322 "parsing/parser.ml"
+# 39242 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38331 "parsing/parser.ml"
+# 39251 "parsing/parser.ml"
in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2386 "parsing/parser.mly"
+# 2448 "parsing/parser.mly"
( Pexp_open(od, mkexp ~loc:_loc__3_ (Pexp_construct(_3, None))) )
-# 38338 "parsing/parser.ml"
+# 39258 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38348 "parsing/parser.ml"
+# 39268 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38354 "parsing/parser.ml"
+# 39274 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.expression) = let _1 =
let _1 =
let _4 =
-# 2588 "parsing/parser.mly"
+# 2665 "parsing/parser.mly"
( es )
-# 38409 "parsing/parser.ml"
+# 39329 "parsing/parser.ml"
in
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2389 "parsing/parser.mly"
+# 2451 "parsing/parser.mly"
( unclosed "[" _loc__3_ "]" _loc__5_ )
-# 38416 "parsing/parser.ml"
+# 39336 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38426 "parsing/parser.ml"
+# 39346 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38432 "parsing/parser.ml"
+# 39352 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 38529 "parsing/parser.ml"
+# 39449 "parsing/parser.ml"
in
let _5 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 38539 "parsing/parser.ml"
+# 39459 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 38545 "parsing/parser.ml"
+# 39465 "parsing/parser.ml"
in
let od =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38556 "parsing/parser.ml"
+# 39476 "parsing/parser.ml"
in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 1498 "parsing/parser.mly"
+# 1569 "parsing/parser.mly"
( let loc = make_loc _loc__1_ in
let me = Mod.ident ~loc _1 in
Opn.mk ~loc me )
-# 38565 "parsing/parser.ml"
+# 39485 "parsing/parser.ml"
in
let _startpos_od_ = _startpos__1_ in
let _symbolstartpos = _startpos_od_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2392 "parsing/parser.mly"
+# 2454 "parsing/parser.mly"
( let modexp =
mkexp_attrs ~loc:(_startpos__3_, _endpos)
(Pexp_constraint (ghexp ~loc:_sloc (Pexp_pack _6), _8)) _5 in
Pexp_open(od, modexp) )
-# 38578 "parsing/parser.ml"
+# 39498 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__9_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38588 "parsing/parser.ml"
+# 39508 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38594 "parsing/parser.ml"
+# 39514 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 38681 "parsing/parser.ml"
+# 39601 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 38687 "parsing/parser.ml"
+# 39607 "parsing/parser.ml"
in
let _loc__8_ = (_startpos__8_, _endpos__8_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2398 "parsing/parser.mly"
+# 2460 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__8_ )
-# 38695 "parsing/parser.ml"
+# 39615 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__8_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 850 "parsing/parser.mly"
+# 916 "parsing/parser.mly"
( mkexp ~loc:_sloc _1 )
-# 38705 "parsing/parser.ml"
+# 39625 "parsing/parser.ml"
in
-# 2294 "parsing/parser.mly"
+# 2356 "parsing/parser.mly"
( _1 )
-# 38711 "parsing/parser.ml"
+# 39631 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38742 "parsing/parser.ml"
+# 39662 "parsing/parser.ml"
in
-# 2668 "parsing/parser.mly"
+# 2748 "parsing/parser.mly"
( Ppat_var (_1) )
-# 38748 "parsing/parser.ml"
+# 39668 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 38757 "parsing/parser.ml"
+# 39677 "parsing/parser.ml"
in
-# 2669 "parsing/parser.mly"
+# 2749 "parsing/parser.mly"
( _1 )
-# 38763 "parsing/parser.ml"
+# 39683 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2670 "parsing/parser.mly"
+# 2750 "parsing/parser.mly"
( _1 )
-# 38788 "parsing/parser.ml"
+# 39708 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2675 "parsing/parser.mly"
+# 2755 "parsing/parser.mly"
( reloc_pat ~loc:_sloc _2 )
-# 38830 "parsing/parser.ml"
+# 39750 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) =
-# 2677 "parsing/parser.mly"
+# 2757 "parsing/parser.mly"
( _1 )
-# 38855 "parsing/parser.ml"
+# 39775 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 38920 "parsing/parser.ml"
+# 39840 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 38930 "parsing/parser.ml"
+# 39850 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 38936 "parsing/parser.ml"
+# 39856 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2679 "parsing/parser.mly"
+# 2759 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc (Ppat_unpack _4) _3 )
-# 38945 "parsing/parser.ml"
+# 39865 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 39026 "parsing/parser.ml"
+# 39946 "parsing/parser.ml"
in
let _4 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39037 "parsing/parser.ml"
+# 39957 "parsing/parser.ml"
in
let (_endpos__4_, _startpos__4_) = (_endpos__1_inlined3_, _startpos__1_inlined3_) in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 39048 "parsing/parser.ml"
+# 39968 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 39054 "parsing/parser.ml"
+# 39974 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _loc__4_ = (_startpos__4_, _endpos__4_) in
let _sloc = (_symbolstartpos, _endpos) in
-# 2681 "parsing/parser.mly"
+# 2761 "parsing/parser.mly"
( mkpat_attrs ~loc:_sloc
(Ppat_constraint(mkpat ~loc:_loc__4_ (Ppat_unpack _4), _6))
_3 )
-# 39066 "parsing/parser.ml"
+# 39986 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2689 "parsing/parser.mly"
+# 2769 "parsing/parser.mly"
( Ppat_any )
-# 39092 "parsing/parser.ml"
+# 40012 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39100 "parsing/parser.ml"
+# 40020 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39106 "parsing/parser.ml"
+# 40026 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2691 "parsing/parser.mly"
+# 2771 "parsing/parser.mly"
( Ppat_constant _1 )
-# 39132 "parsing/parser.ml"
+# 40052 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39140 "parsing/parser.ml"
+# 40060 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39146 "parsing/parser.ml"
+# 40066 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2693 "parsing/parser.mly"
+# 2773 "parsing/parser.mly"
( Ppat_interval (_1, _3) )
-# 39186 "parsing/parser.ml"
+# 40106 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39195 "parsing/parser.ml"
+# 40115 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39201 "parsing/parser.ml"
+# 40121 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39232 "parsing/parser.ml"
+# 40152 "parsing/parser.ml"
in
-# 2695 "parsing/parser.mly"
+# 2775 "parsing/parser.mly"
( Ppat_construct(_1, None) )
-# 39238 "parsing/parser.ml"
+# 40158 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39247 "parsing/parser.ml"
+# 40167 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39253 "parsing/parser.ml"
+# 40173 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2697 "parsing/parser.mly"
+# 2777 "parsing/parser.mly"
( Ppat_variant(_1, None) )
-# 39279 "parsing/parser.ml"
+# 40199 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39287 "parsing/parser.ml"
+# 40207 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39293 "parsing/parser.ml"
+# 40213 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39332 "parsing/parser.ml"
+# 40252 "parsing/parser.ml"
in
-# 2699 "parsing/parser.mly"
+# 2779 "parsing/parser.mly"
( Ppat_type (_2) )
-# 39338 "parsing/parser.ml"
+# 40258 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39348 "parsing/parser.ml"
+# 40268 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39354 "parsing/parser.ml"
+# 40274 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39399 "parsing/parser.ml"
+# 40319 "parsing/parser.ml"
in
-# 2701 "parsing/parser.mly"
+# 2781 "parsing/parser.mly"
( Ppat_open(_1, _3) )
-# 39405 "parsing/parser.ml"
+# 40325 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39415 "parsing/parser.ml"
+# 40335 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39421 "parsing/parser.ml"
+# 40341 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2702 "parsing/parser.mly"
+# 2782 "parsing/parser.mly"
(Lident "[]")
-# 39471 "parsing/parser.ml"
+# 40391 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39480 "parsing/parser.ml"
+# 40400 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39491 "parsing/parser.ml"
+# 40411 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2703 "parsing/parser.mly"
+# 2783 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 39500 "parsing/parser.ml"
+# 40420 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39510 "parsing/parser.ml"
+# 40430 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39516 "parsing/parser.ml"
+# 40436 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _3 =
let (_endpos__2_, _startpos__1_, _2, _1) = (_endpos__2_inlined1_, _startpos__1_inlined1_, _2_inlined1, _1_inlined1) in
let _1 =
-# 2704 "parsing/parser.mly"
+# 2784 "parsing/parser.mly"
(Lident "()")
-# 39566 "parsing/parser.ml"
+# 40486 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39575 "parsing/parser.ml"
+# 40495 "parsing/parser.ml"
in
let _endpos__3_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39586 "parsing/parser.ml"
+# 40506 "parsing/parser.ml"
in
let _endpos = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2705 "parsing/parser.mly"
+# 2785 "parsing/parser.mly"
( Ppat_open(_1, mkpat ~loc:_sloc (Ppat_construct(_3, None))) )
-# 39595 "parsing/parser.ml"
+# 40515 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__2_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39605 "parsing/parser.ml"
+# 40525 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39611 "parsing/parser.ml"
+# 40531 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 39670 "parsing/parser.ml"
+# 40590 "parsing/parser.ml"
in
-# 2707 "parsing/parser.mly"
+# 2787 "parsing/parser.mly"
( Ppat_open (_1, _4) )
-# 39676 "parsing/parser.ml"
+# 40596 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39686 "parsing/parser.ml"
+# 40606 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39692 "parsing/parser.ml"
+# 40612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 2709 "parsing/parser.mly"
+# 2789 "parsing/parser.mly"
( unclosed "(" _loc__3_ ")" _loc__5_ )
-# 39749 "parsing/parser.ml"
+# 40669 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39759 "parsing/parser.ml"
+# 40679 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39765 "parsing/parser.ml"
+# 40685 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2711 "parsing/parser.mly"
+# 2791 "parsing/parser.mly"
( expecting _loc__4_ "pattern" )
-# 39814 "parsing/parser.ml"
+# 40734 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39824 "parsing/parser.ml"
+# 40744 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39830 "parsing/parser.ml"
+# 40750 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2713 "parsing/parser.mly"
+# 2793 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 39873 "parsing/parser.ml"
+# 40793 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39883 "parsing/parser.ml"
+# 40803 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39889 "parsing/parser.ml"
+# 40809 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__5_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2715 "parsing/parser.mly"
+# 2795 "parsing/parser.mly"
( Ppat_constraint(_2, _4) )
-# 39943 "parsing/parser.ml"
+# 40863 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 39952 "parsing/parser.ml"
+# 40872 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 39958 "parsing/parser.ml"
+# 40878 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _loc__5_ = (_startpos__5_, _endpos__5_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2717 "parsing/parser.mly"
+# 2797 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__5_ )
-# 40015 "parsing/parser.ml"
+# 40935 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40025 "parsing/parser.ml"
+# 40945 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 40031 "parsing/parser.ml"
+# 40951 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _loc__4_ = (_startpos__4_, _endpos__4_) in
-# 2719 "parsing/parser.mly"
+# 2799 "parsing/parser.mly"
( expecting _loc__4_ "type" )
-# 40080 "parsing/parser.ml"
+# 41000 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40090 "parsing/parser.ml"
+# 41010 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 40096 "parsing/parser.ml"
+# 41016 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3335 "parsing/parser.mly"
+# 3419 "parsing/parser.mly"
( let (lid, cstrs, attrs) = package_type_of_module_type _1 in
let descr = Ptyp_package (lid, cstrs) in
mktyp ~loc:_sloc ~attrs descr )
-# 40179 "parsing/parser.ml"
+# 41099 "parsing/parser.ml"
in
let _3 =
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 40189 "parsing/parser.ml"
+# 41109 "parsing/parser.ml"
in
-# 3758 "parsing/parser.mly"
+# 3848 "parsing/parser.mly"
( _1, _2 )
-# 40195 "parsing/parser.ml"
+# 41115 "parsing/parser.ml"
in
let _loc__7_ = (_startpos__7_, _endpos__7_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2722 "parsing/parser.mly"
+# 2802 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__7_ )
-# 40203 "parsing/parser.ml"
+# 41123 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__7_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40213 "parsing/parser.ml"
+# 41133 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 40219 "parsing/parser.ml"
+# 41139 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.pattern) = let _1 =
let _1 =
-# 2724 "parsing/parser.mly"
+# 2804 "parsing/parser.mly"
( Ppat_extension _1 )
-# 40245 "parsing/parser.ml"
+# 41165 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 852 "parsing/parser.mly"
+# 918 "parsing/parser.mly"
( mkpat ~loc:_sloc _1 )
-# 40253 "parsing/parser.ml"
+# 41173 "parsing/parser.ml"
in
-# 2685 "parsing/parser.mly"
+# 2765 "parsing/parser.mly"
( _1 )
-# 40259 "parsing/parser.ml"
+# 41179 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 40280 "parsing/parser.ml"
+# 41200 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3668 "parsing/parser.mly"
+# 3756 "parsing/parser.mly"
( _1 )
-# 40288 "parsing/parser.ml"
+# 41208 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 701 "parsing/parser.mly"
+# 756 "parsing/parser.mly"
(string)
-# 40309 "parsing/parser.ml"
+# 41229 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3669 "parsing/parser.mly"
+# 3757 "parsing/parser.mly"
( _1 )
-# 40317 "parsing/parser.ml"
+# 41237 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3670 "parsing/parser.mly"
+# 3758 "parsing/parser.mly"
( "and" )
-# 40342 "parsing/parser.ml"
+# 41262 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3671 "parsing/parser.mly"
+# 3759 "parsing/parser.mly"
( "as" )
-# 40367 "parsing/parser.ml"
+# 41287 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3672 "parsing/parser.mly"
+# 3760 "parsing/parser.mly"
( "assert" )
-# 40392 "parsing/parser.ml"
+# 41312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3673 "parsing/parser.mly"
+# 3761 "parsing/parser.mly"
( "begin" )
-# 40417 "parsing/parser.ml"
+# 41337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3674 "parsing/parser.mly"
+# 3762 "parsing/parser.mly"
( "class" )
-# 40442 "parsing/parser.ml"
+# 41362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3675 "parsing/parser.mly"
+# 3763 "parsing/parser.mly"
( "constraint" )
-# 40467 "parsing/parser.ml"
+# 41387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3676 "parsing/parser.mly"
+# 3764 "parsing/parser.mly"
( "do" )
-# 40492 "parsing/parser.ml"
+# 41412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3677 "parsing/parser.mly"
+# 3765 "parsing/parser.mly"
( "done" )
-# 40517 "parsing/parser.ml"
+# 41437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3678 "parsing/parser.mly"
+# 3766 "parsing/parser.mly"
( "downto" )
-# 40542 "parsing/parser.ml"
+# 41462 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3679 "parsing/parser.mly"
+# 3767 "parsing/parser.mly"
( "else" )
-# 40567 "parsing/parser.ml"
+# 41487 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3680 "parsing/parser.mly"
+# 3768 "parsing/parser.mly"
( "end" )
-# 40592 "parsing/parser.ml"
+# 41512 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3681 "parsing/parser.mly"
+# 3769 "parsing/parser.mly"
( "exception" )
-# 40617 "parsing/parser.ml"
+# 41537 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3682 "parsing/parser.mly"
+# 3770 "parsing/parser.mly"
( "external" )
-# 40642 "parsing/parser.ml"
+# 41562 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3683 "parsing/parser.mly"
+# 3771 "parsing/parser.mly"
( "false" )
-# 40667 "parsing/parser.ml"
+# 41587 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3684 "parsing/parser.mly"
+# 3772 "parsing/parser.mly"
( "for" )
-# 40692 "parsing/parser.ml"
+# 41612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3685 "parsing/parser.mly"
+# 3773 "parsing/parser.mly"
( "fun" )
-# 40717 "parsing/parser.ml"
+# 41637 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3686 "parsing/parser.mly"
+# 3774 "parsing/parser.mly"
( "function" )
-# 40742 "parsing/parser.ml"
+# 41662 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3687 "parsing/parser.mly"
+# 3775 "parsing/parser.mly"
( "functor" )
-# 40767 "parsing/parser.ml"
+# 41687 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3688 "parsing/parser.mly"
+# 3776 "parsing/parser.mly"
( "if" )
-# 40792 "parsing/parser.ml"
+# 41712 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3689 "parsing/parser.mly"
+# 3777 "parsing/parser.mly"
( "in" )
-# 40817 "parsing/parser.ml"
+# 41737 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3690 "parsing/parser.mly"
+# 3778 "parsing/parser.mly"
( "include" )
-# 40842 "parsing/parser.ml"
+# 41762 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3691 "parsing/parser.mly"
+# 3779 "parsing/parser.mly"
( "inherit" )
-# 40867 "parsing/parser.ml"
+# 41787 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3692 "parsing/parser.mly"
+# 3780 "parsing/parser.mly"
( "initializer" )
-# 40892 "parsing/parser.ml"
+# 41812 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3693 "parsing/parser.mly"
+# 3781 "parsing/parser.mly"
( "lazy" )
-# 40917 "parsing/parser.ml"
+# 41837 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3694 "parsing/parser.mly"
+# 3782 "parsing/parser.mly"
( "let" )
-# 40942 "parsing/parser.ml"
+# 41862 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3695 "parsing/parser.mly"
+# 3783 "parsing/parser.mly"
( "match" )
-# 40967 "parsing/parser.ml"
+# 41887 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3696 "parsing/parser.mly"
+# 3784 "parsing/parser.mly"
( "method" )
-# 40992 "parsing/parser.ml"
+# 41912 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3697 "parsing/parser.mly"
+# 3785 "parsing/parser.mly"
( "module" )
-# 41017 "parsing/parser.ml"
+# 41937 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3698 "parsing/parser.mly"
+# 3786 "parsing/parser.mly"
( "mutable" )
-# 41042 "parsing/parser.ml"
+# 41962 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3699 "parsing/parser.mly"
+# 3787 "parsing/parser.mly"
( "new" )
-# 41067 "parsing/parser.ml"
+# 41987 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3700 "parsing/parser.mly"
+# 3788 "parsing/parser.mly"
( "nonrec" )
-# 41092 "parsing/parser.ml"
+# 42012 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3701 "parsing/parser.mly"
+# 3789 "parsing/parser.mly"
( "object" )
-# 41117 "parsing/parser.ml"
+# 42037 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3702 "parsing/parser.mly"
+# 3790 "parsing/parser.mly"
( "of" )
-# 41142 "parsing/parser.ml"
+# 42062 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3703 "parsing/parser.mly"
+# 3791 "parsing/parser.mly"
( "open" )
-# 41167 "parsing/parser.ml"
+# 42087 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3704 "parsing/parser.mly"
+# 3792 "parsing/parser.mly"
( "or" )
-# 41192 "parsing/parser.ml"
+# 42112 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3705 "parsing/parser.mly"
+# 3793 "parsing/parser.mly"
( "private" )
-# 41217 "parsing/parser.ml"
+# 42137 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3706 "parsing/parser.mly"
+# 3794 "parsing/parser.mly"
( "rec" )
-# 41242 "parsing/parser.ml"
+# 42162 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3707 "parsing/parser.mly"
+# 3795 "parsing/parser.mly"
( "sig" )
-# 41267 "parsing/parser.ml"
+# 42187 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3708 "parsing/parser.mly"
+# 3796 "parsing/parser.mly"
( "struct" )
-# 41292 "parsing/parser.ml"
+# 42212 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3709 "parsing/parser.mly"
+# 3797 "parsing/parser.mly"
( "then" )
-# 41317 "parsing/parser.ml"
+# 42237 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3710 "parsing/parser.mly"
+# 3798 "parsing/parser.mly"
( "to" )
-# 41342 "parsing/parser.ml"
+# 42262 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3711 "parsing/parser.mly"
+# 3799 "parsing/parser.mly"
( "true" )
-# 41367 "parsing/parser.ml"
+# 42287 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3712 "parsing/parser.mly"
+# 3800 "parsing/parser.mly"
( "try" )
-# 41392 "parsing/parser.ml"
+# 42312 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3713 "parsing/parser.mly"
+# 3801 "parsing/parser.mly"
( "type" )
-# 41417 "parsing/parser.ml"
+# 42337 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3714 "parsing/parser.mly"
+# 3802 "parsing/parser.mly"
( "val" )
-# 41442 "parsing/parser.ml"
+# 42362 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3715 "parsing/parser.mly"
+# 3803 "parsing/parser.mly"
( "virtual" )
-# 41467 "parsing/parser.ml"
+# 42387 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3716 "parsing/parser.mly"
+# 3804 "parsing/parser.mly"
( "when" )
-# 41492 "parsing/parser.ml"
+# 42412 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3717 "parsing/parser.mly"
+# 3805 "parsing/parser.mly"
( "while" )
-# 41517 "parsing/parser.ml"
+# 42437 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3718 "parsing/parser.mly"
+# 3806 "parsing/parser.mly"
( "with" )
-# 41542 "parsing/parser.ml"
+# 42462 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Parsetree.type_exception * string Asttypes.loc option) =
-# 3003 "parsing/parser.mly"
+# 3083 "parsing/parser.mly"
( _1 )
-# 41567 "parsing/parser.ml"
+# 42487 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.type_exception * string Asttypes.loc option) = let attrs =
let _1 = _1_inlined5 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 41643 "parsing/parser.ml"
+# 42563 "parsing/parser.ml"
in
let _endpos_attrs_ = _endpos__1_inlined5_ in
let attrs2 =
let _1 = _1_inlined4 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 41652 "parsing/parser.ml"
+# 42572 "parsing/parser.ml"
in
let lid =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41663 "parsing/parser.ml"
+# 42583 "parsing/parser.ml"
in
let id =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 41674 "parsing/parser.ml"
+# 42594 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 41682 "parsing/parser.ml"
+# 42602 "parsing/parser.ml"
in
let _endpos = _endpos_attrs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3012 "parsing/parser.mly"
+# 3092 "parsing/parser.mly"
( let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Te.mk_exception ~attrs
(Te.rebind id lid ~attrs:(attrs1 @ attrs2) ~loc ~docs)
, ext )
-# 41695 "parsing/parser.ml"
+# 42615 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.expression) =
-# 2513 "parsing/parser.mly"
+# 2590 "parsing/parser.mly"
( _2 )
-# 41727 "parsing/parser.ml"
+# 42647 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2515 "parsing/parser.mly"
+# 2592 "parsing/parser.mly"
( let (l, o, p) = _1 in ghexp ~loc:_sloc (Pexp_fun(l, o, p, _2)) )
-# 41762 "parsing/parser.ml"
+# 42682 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__5_ in
let _v : (Parsetree.expression) = let _3 =
-# 2416 "parsing/parser.mly"
+# 2478 "parsing/parser.mly"
( xs )
-# 41815 "parsing/parser.ml"
+# 42735 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2517 "parsing/parser.mly"
+# 2594 "parsing/parser.mly"
( mk_newtypes ~loc:_sloc _3 _5 )
-# 41823 "parsing/parser.ml"
+# 42743 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 41850 "parsing/parser.ml"
+# 42770 "parsing/parser.ml"
in
let xs =
let items =
-# 887 "parsing/parser.mly"
+# 953 "parsing/parser.mly"
( [] )
-# 41856 "parsing/parser.ml"
+# 42776 "parsing/parser.ml"
in
-# 1301 "parsing/parser.mly"
+# 1372 "parsing/parser.mly"
( items )
-# 41861 "parsing/parser.ml"
+# 42781 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 41867 "parsing/parser.ml"
+# 42787 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 41876 "parsing/parser.ml"
+# 42796 "parsing/parser.ml"
in
-# 1294 "parsing/parser.mly"
+# 1365 "parsing/parser.mly"
( _1 )
-# 41882 "parsing/parser.ml"
+# 42802 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 41923 "parsing/parser.ml"
+# 42843 "parsing/parser.ml"
in
let xs =
let items =
let _1 =
let _1 =
let attrs =
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 41933 "parsing/parser.ml"
+# 42853 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( mkstrexp e attrs )
-# 41938 "parsing/parser.ml"
+# 42858 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 41946 "parsing/parser.ml"
+# 42866 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 840 "parsing/parser.mly"
+# 906 "parsing/parser.mly"
( mark_rhs_docs _startpos _endpos;
_1 )
-# 41956 "parsing/parser.ml"
+# 42876 "parsing/parser.ml"
in
-# 889 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( x )
-# 41962 "parsing/parser.ml"
+# 42882 "parsing/parser.ml"
in
-# 1301 "parsing/parser.mly"
+# 1372 "parsing/parser.mly"
( items )
-# 41968 "parsing/parser.ml"
+# 42888 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 41974 "parsing/parser.ml"
+# 42894 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 41983 "parsing/parser.ml"
+# 42903 "parsing/parser.ml"
in
-# 1294 "parsing/parser.mly"
+# 1365 "parsing/parser.mly"
( _1 )
-# 41989 "parsing/parser.ml"
+# 42909 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1323 "parsing/parser.mly"
+# 1394 "parsing/parser.mly"
( val_of_let_bindings ~loc:_sloc _1 )
-# 42017 "parsing/parser.ml"
+# 42937 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _2 =
let _1 = _1_inlined1 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 42053 "parsing/parser.ml"
+# 42973 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1326 "parsing/parser.mly"
+# 1397 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
Pstr_extension (_1, add_docs_attrs docs _2) )
-# 42064 "parsing/parser.ml"
+# 42984 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 856 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 42074 "parsing/parser.ml"
+# 42994 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42080 "parsing/parser.ml"
+# 43000 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1329 "parsing/parser.mly"
+# 1400 "parsing/parser.mly"
( Pstr_attribute _1 )
-# 42106 "parsing/parser.ml"
+# 43026 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 856 "parsing/parser.mly"
+# 922 "parsing/parser.mly"
( mkstr ~loc:_sloc _1 )
-# 42114 "parsing/parser.ml"
+# 43034 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42120 "parsing/parser.ml"
+# 43040 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1333 "parsing/parser.mly"
+# 1404 "parsing/parser.mly"
( pstr_primitive _1 )
-# 42146 "parsing/parser.ml"
+# 43066 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42154 "parsing/parser.ml"
+# 43074 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42160 "parsing/parser.ml"
+# 43080 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1335 "parsing/parser.mly"
+# 1406 "parsing/parser.mly"
( pstr_primitive _1 )
-# 42186 "parsing/parser.ml"
+# 43106 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42194 "parsing/parser.ml"
+# 43114 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42200 "parsing/parser.ml"
+# 43120 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1 =
let _1 =
let _1 =
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42237 "parsing/parser.ml"
+# 43157 "parsing/parser.ml"
in
-# 2847 "parsing/parser.mly"
+# 2927 "parsing/parser.mly"
( _1 )
-# 42242 "parsing/parser.ml"
+# 43162 "parsing/parser.ml"
in
-# 2830 "parsing/parser.mly"
+# 2910 "parsing/parser.mly"
( _1 )
-# 42248 "parsing/parser.ml"
+# 43168 "parsing/parser.ml"
in
-# 1337 "parsing/parser.mly"
+# 1408 "parsing/parser.mly"
( pstr_type _1 )
-# 42254 "parsing/parser.ml"
+# 43174 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_bs_, _startpos_a_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42264 "parsing/parser.ml"
+# 43184 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42270 "parsing/parser.ml"
+# 43190 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 42357 "parsing/parser.ml"
+# 43277 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let cs =
-# 1040 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( List.rev xs )
-# 42364 "parsing/parser.ml"
+# 43284 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42374 "parsing/parser.ml"
+# 43294 "parsing/parser.ml"
in
let _4 =
-# 3590 "parsing/parser.mly"
+# 3676 "parsing/parser.mly"
( Recursive )
-# 42380 "parsing/parser.ml"
+# 43300 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 42387 "parsing/parser.ml"
+# 43307 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3095 "parsing/parser.mly"
+# 3175 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 42399 "parsing/parser.ml"
+# 43319 "parsing/parser.ml"
in
-# 3078 "parsing/parser.mly"
+# 3158 "parsing/parser.mly"
( _1 )
-# 42405 "parsing/parser.ml"
+# 43325 "parsing/parser.ml"
in
-# 1339 "parsing/parser.mly"
+# 1410 "parsing/parser.mly"
( pstr_typext _1 )
-# 42411 "parsing/parser.ml"
+# 43331 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42421 "parsing/parser.ml"
+# 43341 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42427 "parsing/parser.ml"
+# 43347 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined4 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 42521 "parsing/parser.ml"
+# 43441 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined4_ in
let cs =
-# 1040 "parsing/parser.mly"
+# 1106 "parsing/parser.mly"
( List.rev xs )
-# 42528 "parsing/parser.ml"
+# 43448 "parsing/parser.ml"
in
let tid =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined3_, _startpos__1_inlined3_, _1_inlined3) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42538 "parsing/parser.ml"
+# 43458 "parsing/parser.ml"
in
let _4 =
let _startpos = _startpos__1_ in
let _loc = (_startpos, _endpos) in
-# 3591 "parsing/parser.mly"
+# 3678 "parsing/parser.mly"
( not_expecting _loc "nonrec flag" )
-# 42549 "parsing/parser.ml"
+# 43469 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 42557 "parsing/parser.ml"
+# 43477 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3095 "parsing/parser.mly"
+# 3175 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let attrs = attrs1 @ attrs2 in
Te.mk tid cs ~params ~priv ~attrs ~docs,
ext )
-# 42569 "parsing/parser.ml"
+# 43489 "parsing/parser.ml"
in
-# 3078 "parsing/parser.mly"
+# 3158 "parsing/parser.mly"
( _1 )
-# 42575 "parsing/parser.ml"
+# 43495 "parsing/parser.ml"
in
-# 1339 "parsing/parser.mly"
+# 1410 "parsing/parser.mly"
( pstr_typext _1 )
-# 42581 "parsing/parser.ml"
+# 43501 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined4_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42591 "parsing/parser.ml"
+# 43511 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42597 "parsing/parser.ml"
+# 43517 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1341 "parsing/parser.mly"
+# 1412 "parsing/parser.mly"
( pstr_exception _1 )
-# 42623 "parsing/parser.ml"
+# 43543 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42631 "parsing/parser.ml"
+# 43551 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42637 "parsing/parser.ml"
+# 43557 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 42702 "parsing/parser.ml"
+# 43622 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42714 "parsing/parser.ml"
+# 43634 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 42722 "parsing/parser.ml"
+# 43642 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1367 "parsing/parser.mly"
+# 1438 "parsing/parser.mly"
( let docs = symbol_docs _sloc in
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
let body = Mb.mk name body ~attrs ~loc ~docs in
Pstr_module body, ext )
-# 42735 "parsing/parser.ml"
+# 43655 "parsing/parser.ml"
in
-# 1343 "parsing/parser.mly"
+# 1414 "parsing/parser.mly"
( _1 )
-# 42741 "parsing/parser.ml"
+# 43661 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42751 "parsing/parser.ml"
+# 43671 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42757 "parsing/parser.ml"
+# 43677 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 42838 "parsing/parser.ml"
+# 43758 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 42850 "parsing/parser.ml"
+# 43770 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 42858 "parsing/parser.ml"
+# 43778 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1402 "parsing/parser.mly"
+# 1473 "parsing/parser.mly"
(
let loc = make_loc _sloc in
let attrs = attrs1 @ attrs2 in
ext,
Mb.mk name body ~attrs ~loc ~docs
)
-# 42873 "parsing/parser.ml"
+# 43793 "parsing/parser.ml"
in
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 42879 "parsing/parser.ml"
+# 43799 "parsing/parser.ml"
in
-# 1390 "parsing/parser.mly"
+# 1461 "parsing/parser.mly"
( _1 )
-# 42885 "parsing/parser.ml"
+# 43805 "parsing/parser.ml"
in
-# 1345 "parsing/parser.mly"
+# 1416 "parsing/parser.mly"
( pstr_recmodule _1 )
-# 42891 "parsing/parser.ml"
+# 43811 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42901 "parsing/parser.ml"
+# 43821 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42907 "parsing/parser.ml"
+# 43827 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1347 "parsing/parser.mly"
+# 1418 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_modtype body, ext) )
-# 42933 "parsing/parser.ml"
+# 43853 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42941 "parsing/parser.ml"
+# 43861 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42947 "parsing/parser.ml"
+# 43867 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1349 "parsing/parser.mly"
+# 1420 "parsing/parser.mly"
( let (body, ext) = _1 in (Pstr_open body, ext) )
-# 42973 "parsing/parser.ml"
+# 43893 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 42981 "parsing/parser.ml"
+# 43901 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 42987 "parsing/parser.ml"
+# 43907 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _1_inlined3 : (Parsetree.attributes) = Obj.magic _1_inlined3 in
let body : (Parsetree.class_expr) = Obj.magic body in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 43059 "parsing/parser.ml"
+# 43979 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let params : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) = Obj.magic params in
let virt : (Asttypes.virtual_flag) = Obj.magic virt in
let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 43079 "parsing/parser.ml"
+# 43999 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43091 "parsing/parser.ml"
+# 44011 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 43099 "parsing/parser.ml"
+# 44019 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1721 "parsing/parser.mly"
+# 1811 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
ext,
Ci.mk id body ~virt ~params ~attrs ~loc ~docs
)
-# 43114 "parsing/parser.ml"
+# 44034 "parsing/parser.ml"
in
-# 1048 "parsing/parser.mly"
+# 1114 "parsing/parser.mly"
( let (x, b) = a in x, b :: bs )
-# 43120 "parsing/parser.ml"
+# 44040 "parsing/parser.ml"
in
-# 1710 "parsing/parser.mly"
+# 1800 "parsing/parser.mly"
( _1 )
-# 43126 "parsing/parser.ml"
+# 44046 "parsing/parser.ml"
in
-# 1351 "parsing/parser.mly"
+# 1422 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class l, ext) )
-# 43132 "parsing/parser.ml"
+# 44052 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_bs_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43142 "parsing/parser.ml"
+# 44062 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 43148 "parsing/parser.ml"
+# 44068 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.structure_item) = let _1 =
let _1 =
-# 1353 "parsing/parser.mly"
+# 1424 "parsing/parser.mly"
( let (ext, l) = _1 in (Pstr_class_type l, ext) )
-# 43174 "parsing/parser.ml"
+# 44094 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43182 "parsing/parser.ml"
+# 44102 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 43188 "parsing/parser.ml"
+# 44108 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let attrs2 =
let _1 = _1_inlined2 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 43246 "parsing/parser.ml"
+# 44166 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined2_ in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 43255 "parsing/parser.ml"
+# 44175 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1439 "parsing/parser.mly"
+# 1510 "parsing/parser.mly"
(
let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Incl.mk thing ~attrs ~loc ~docs, ext
)
-# 43269 "parsing/parser.ml"
+# 44189 "parsing/parser.ml"
in
-# 1355 "parsing/parser.mly"
+# 1426 "parsing/parser.mly"
( pstr_include _1 )
-# 43275 "parsing/parser.ml"
+# 44195 "parsing/parser.ml"
in
let _endpos__1_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 873 "parsing/parser.mly"
+# 939 "parsing/parser.mly"
( wrap_mkstr_ext ~loc:_sloc _1 )
-# 43285 "parsing/parser.ml"
+# 44205 "parsing/parser.ml"
in
-# 1357 "parsing/parser.mly"
+# 1428 "parsing/parser.mly"
( _1 )
-# 43291 "parsing/parser.ml"
+# 44211 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3653 "parsing/parser.mly"
+# 3741 "parsing/parser.mly"
( "-" )
-# 43316 "parsing/parser.ml"
+# 44236 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (string) =
-# 3654 "parsing/parser.mly"
+# 3742 "parsing/parser.mly"
( "-." )
-# 43341 "parsing/parser.ml"
+# 44261 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _5 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 43396 "parsing/parser.ml"
+# 44316 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined1_ in
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 43405 "parsing/parser.ml"
+# 44325 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 43410 "parsing/parser.ml"
+# 44330 "parsing/parser.ml"
in
-# 3365 "parsing/parser.mly"
+# 3449 "parsing/parser.mly"
( _1 )
-# 43416 "parsing/parser.ml"
+# 44336 "parsing/parser.ml"
in
let _1 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43426 "parsing/parser.ml"
+# 44346 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3351 "parsing/parser.mly"
+# 3435 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _5 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 _3 _4 )
-# 43437 "parsing/parser.ml"
+# 44357 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.row_field) = let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 43471 "parsing/parser.ml"
+# 44391 "parsing/parser.ml"
in
let _endpos__2_ = _endpos__1_inlined1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43482 "parsing/parser.ml"
+# 44402 "parsing/parser.ml"
in
let _endpos = _endpos__2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3355 "parsing/parser.mly"
+# 3439 "parsing/parser.mly"
( let info = symbol_info _endpos in
let attrs = add_info_attrs info _2 in
Rf.tag ~loc:(make_loc _sloc) ~attrs _1 true [] )
-# 43493 "parsing/parser.ml"
+# 44413 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.toplevel_phrase) = let arg =
# 124 "<standard.mly>"
( None )
-# 43525 "parsing/parser.ml"
+# 44445 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined1_ in
let dir =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43536 "parsing/parser.ml"
+# 44456 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43545 "parsing/parser.ml"
+# 44465 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 689 "parsing/parser.mly"
+# 743 "parsing/parser.mly"
(string * Location.t * string option)
-# 43578 "parsing/parser.ml"
+# 44498 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3557 "parsing/parser.mly"
+# 3643 "parsing/parser.mly"
( let (s, _, _) = _1 in Pdir_string s )
-# 43591 "parsing/parser.ml"
+# 44511 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43599 "parsing/parser.ml"
+# 44519 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43605 "parsing/parser.ml"
+# 44525 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43617 "parsing/parser.ml"
+# 44537 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43626 "parsing/parser.ml"
+# 44546 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
};
} = _menhir_stack in
let _1_inlined2 : (
-# 637 "parsing/parser.mly"
+# 691 "parsing/parser.mly"
(string * char option)
-# 43659 "parsing/parser.ml"
+# 44579 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _1_inlined1 : (Asttypes.label) = Obj.magic _1_inlined1 in
let _1 : unit = Obj.magic _1 in
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3558 "parsing/parser.mly"
+# 3644 "parsing/parser.mly"
( let (n, m) = _1 in Pdir_int (n ,m) )
-# 43672 "parsing/parser.ml"
+# 44592 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43680 "parsing/parser.ml"
+# 44600 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43686 "parsing/parser.ml"
+# 44606 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43698 "parsing/parser.ml"
+# 44618 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43707 "parsing/parser.ml"
+# 44627 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3559 "parsing/parser.mly"
+# 3645 "parsing/parser.mly"
( Pdir_ident _1 )
-# 43749 "parsing/parser.ml"
+# 44669 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43757 "parsing/parser.ml"
+# 44677 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43763 "parsing/parser.ml"
+# 44683 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43775 "parsing/parser.ml"
+# 44695 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43784 "parsing/parser.ml"
+# 44704 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3560 "parsing/parser.mly"
+# 3646 "parsing/parser.mly"
( Pdir_ident _1 )
-# 43826 "parsing/parser.ml"
+# 44746 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43834 "parsing/parser.ml"
+# 44754 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43840 "parsing/parser.ml"
+# 44760 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43852 "parsing/parser.ml"
+# 44772 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43861 "parsing/parser.ml"
+# 44781 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3561 "parsing/parser.mly"
+# 3647 "parsing/parser.mly"
( Pdir_bool false )
-# 43903 "parsing/parser.ml"
+# 44823 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43911 "parsing/parser.ml"
+# 44831 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43917 "parsing/parser.ml"
+# 44837 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 43929 "parsing/parser.ml"
+# 44849 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 43938 "parsing/parser.ml"
+# 44858 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let x =
let _1 =
-# 3562 "parsing/parser.mly"
+# 3648 "parsing/parser.mly"
( Pdir_bool true )
-# 43980 "parsing/parser.ml"
+# 44900 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 878 "parsing/parser.mly"
+# 944 "parsing/parser.mly"
( mk_directive_arg ~loc:_sloc _1 )
-# 43988 "parsing/parser.ml"
+# 44908 "parsing/parser.ml"
in
# 126 "<standard.mly>"
( Some x )
-# 43994 "parsing/parser.ml"
+# 44914 "parsing/parser.ml"
in
let _endpos_arg_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 44006 "parsing/parser.ml"
+# 44926 "parsing/parser.ml"
in
let _endpos = _endpos_arg_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3553 "parsing/parser.mly"
+# 3639 "parsing/parser.mly"
( mk_directive ~loc:_sloc dir arg )
-# 44015 "parsing/parser.ml"
+# 44935 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 44054 "parsing/parser.ml"
- ) = let _1 =
+ let _v : (Parsetree.toplevel_phrase) = let _1 =
let _1 =
let _1 =
let attrs =
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 44061 "parsing/parser.ml"
+# 44977 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( mkstrexp e attrs )
-# 44066 "parsing/parser.ml"
+# 44982 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 821 "parsing/parser.mly"
+# 887 "parsing/parser.mly"
( text_str _startpos @ [_1] )
-# 44074 "parsing/parser.ml"
+# 44990 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 44083 "parsing/parser.ml"
+# 44999 "parsing/parser.ml"
in
-# 1086 "parsing/parser.mly"
+# 1154 "parsing/parser.mly"
( Ptop_def _1 )
-# 44089 "parsing/parser.ml"
+# 45005 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 44121 "parsing/parser.ml"
- ) = let _1 =
+ let _v : (Parsetree.toplevel_phrase) = let _1 =
let _1 =
# 260 "<standard.mly>"
( List.flatten xss )
-# 44126 "parsing/parser.ml"
+# 45038 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 809 "parsing/parser.mly"
+# 875 "parsing/parser.mly"
( extra_str _startpos _endpos _1 )
-# 44134 "parsing/parser.ml"
+# 45046 "parsing/parser.ml"
in
-# 1090 "parsing/parser.mly"
+# 1158 "parsing/parser.mly"
( Ptop_def _1 )
-# 44140 "parsing/parser.ml"
+# 45052 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 44172 "parsing/parser.ml"
- ) =
-# 1094 "parsing/parser.mly"
+ let _v : (Parsetree.toplevel_phrase) =
+# 1162 "parsing/parser.mly"
( _1 )
-# 44176 "parsing/parser.ml"
+# 45084 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
- let _v : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 44201 "parsing/parser.ml"
- ) =
-# 1097 "parsing/parser.mly"
+ let _v : (Parsetree.toplevel_phrase) =
+# 1165 "parsing/parser.mly"
( raise End_of_file )
-# 44205 "parsing/parser.ml"
+# 45109 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_ty_ in
let _endpos = _endpos_ty_ in
let _v : (Parsetree.core_type) =
-# 3257 "parsing/parser.mly"
+# 3341 "parsing/parser.mly"
( ty )
-# 44230 "parsing/parser.ml"
+# 45134 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 44258 "parsing/parser.ml"
+# 45162 "parsing/parser.ml"
in
-# 979 "parsing/parser.mly"
+# 1045 "parsing/parser.mly"
( xs )
-# 44263 "parsing/parser.ml"
+# 45167 "parsing/parser.ml"
in
-# 3260 "parsing/parser.mly"
+# 3344 "parsing/parser.mly"
( Ptyp_tuple tys )
-# 44269 "parsing/parser.ml"
+# 45173 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xs_, _startpos_xs_) in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44279 "parsing/parser.ml"
+# 45183 "parsing/parser.ml"
in
-# 3262 "parsing/parser.mly"
+# 3346 "parsing/parser.mly"
( _1 )
-# 44285 "parsing/parser.ml"
+# 45189 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2591 "parsing/parser.mly"
+# 2668 "parsing/parser.mly"
( (Some _2, None) )
-# 44317 "parsing/parser.ml"
+# 45221 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__4_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2592 "parsing/parser.mly"
+# 2669 "parsing/parser.mly"
( (Some _2, Some _4) )
-# 44363 "parsing/parser.ml"
+# 45267 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2593 "parsing/parser.mly"
+# 2670 "parsing/parser.mly"
( (None, Some _2) )
-# 44395 "parsing/parser.ml"
+# 45299 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2594 "parsing/parser.mly"
+# 2671 "parsing/parser.mly"
( syntax_error() )
-# 44427 "parsing/parser.ml"
+# 45331 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type option * Parsetree.core_type option) =
-# 2595 "parsing/parser.mly"
+# 2672 "parsing/parser.mly"
( syntax_error() )
-# 44459 "parsing/parser.ml"
+# 45363 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 2921 "parsing/parser.mly"
+# 3001 "parsing/parser.mly"
( (Ptype_abstract, Public, None) )
-# 44477 "parsing/parser.ml"
+# 45381 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.type_kind * Asttypes.private_flag * Parsetree.core_type option) =
-# 2923 "parsing/parser.mly"
+# 3003 "parsing/parser.mly"
( _2 )
-# 44509 "parsing/parser.ml"
+# 45413 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3516 "parsing/parser.mly"
+# 3600 "parsing/parser.mly"
( _1 )
-# 44534 "parsing/parser.ml"
+# 45438 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) =
-# 2938 "parsing/parser.mly"
+# 3018 "parsing/parser.mly"
( _2, _1 )
-# 44566 "parsing/parser.ml"
+# 45470 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 2931 "parsing/parser.mly"
+# 3011 "parsing/parser.mly"
( [] )
-# 44584 "parsing/parser.ml"
+# 45488 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos_p_ in
let _endpos = _endpos_p_ in
let _v : ((Parsetree.core_type * (Asttypes.variance * Asttypes.injectivity)) list) =
-# 2933 "parsing/parser.mly"
+# 3013 "parsing/parser.mly"
( [p] )
-# 44609 "parsing/parser.ml"
+# 45513 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 44649 "parsing/parser.ml"
+# 45553 "parsing/parser.ml"
in
-# 951 "parsing/parser.mly"
+# 1017 "parsing/parser.mly"
( xs )
-# 44654 "parsing/parser.ml"
+# 45558 "parsing/parser.ml"
in
-# 2935 "parsing/parser.mly"
+# 3015 "parsing/parser.mly"
( ps )
-# 44660 "parsing/parser.ml"
+# 45564 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos_tyvar_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2943 "parsing/parser.mly"
+# 3023 "parsing/parser.mly"
( Ptyp_var tyvar )
-# 44693 "parsing/parser.ml"
+# 45597 "parsing/parser.ml"
in
let _endpos__1_ = _endpos_tyvar_ in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44702 "parsing/parser.ml"
+# 45606 "parsing/parser.ml"
in
-# 2946 "parsing/parser.mly"
+# 3026 "parsing/parser.mly"
( _1 )
-# 44708 "parsing/parser.ml"
+# 45612 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__1_ in
let _v : (Parsetree.core_type) = let _1 =
let _1 =
-# 2945 "parsing/parser.mly"
+# 3025 "parsing/parser.mly"
( Ptyp_any )
-# 44734 "parsing/parser.ml"
+# 45638 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 854 "parsing/parser.mly"
+# 920 "parsing/parser.mly"
( mktyp ~loc:_sloc _1 )
-# 44742 "parsing/parser.ml"
+# 45646 "parsing/parser.ml"
in
-# 2946 "parsing/parser.mly"
+# 3026 "parsing/parser.mly"
( _1 )
-# 44748 "parsing/parser.ml"
+# 45652 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2950 "parsing/parser.mly"
+# 3030 "parsing/parser.mly"
( NoVariance, NoInjectivity )
-# 44766 "parsing/parser.ml"
+# 45670 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2951 "parsing/parser.mly"
+# 3031 "parsing/parser.mly"
( Covariant, NoInjectivity )
-# 44791 "parsing/parser.ml"
+# 45695 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2952 "parsing/parser.mly"
+# 3032 "parsing/parser.mly"
( Contravariant, NoInjectivity )
-# 44816 "parsing/parser.ml"
+# 45720 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2953 "parsing/parser.mly"
+# 3033 "parsing/parser.mly"
( NoVariance, Injective )
-# 44841 "parsing/parser.ml"
+# 45745 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2954 "parsing/parser.mly"
+# 3034 "parsing/parser.mly"
( Covariant, Injective )
-# 44873 "parsing/parser.ml"
+# 45777 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2954 "parsing/parser.mly"
+# 3034 "parsing/parser.mly"
( Covariant, Injective )
-# 44905 "parsing/parser.ml"
+# 45809 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2955 "parsing/parser.mly"
+# 3035 "parsing/parser.mly"
( Contravariant, Injective )
-# 44937 "parsing/parser.ml"
+# 45841 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.variance * Asttypes.injectivity) =
-# 2955 "parsing/parser.mly"
+# 3035 "parsing/parser.mly"
( Contravariant, Injective )
-# 44969 "parsing/parser.ml"
+# 45873 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 629 "parsing/parser.mly"
+# 683 "parsing/parser.mly"
(string)
-# 44990 "parsing/parser.ml"
+# 45894 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2957 "parsing/parser.mly"
+# 3037 "parsing/parser.mly"
( if _1 = "+!" then Covariant, Injective else
if _1 = "-!" then Contravariant, Injective else
expecting _loc__1_ "type_variance" )
-# 45001 "parsing/parser.ml"
+# 45905 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 675 "parsing/parser.mly"
+# 729 "parsing/parser.mly"
(string)
-# 45022 "parsing/parser.ml"
+# 45926 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.variance * Asttypes.injectivity) = let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 2961 "parsing/parser.mly"
+# 3041 "parsing/parser.mly"
( if _1 = "!+" then Covariant, Injective else
if _1 = "!-" then Contravariant, Injective else
expecting _loc__1_ "type_variance" )
-# 45033 "parsing/parser.ml"
+# 45937 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_xss_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 787 "parsing/parser.mly"
- (Parsetree.toplevel_phrase list)
-# 45065 "parsing/parser.ml"
- ) = let _1 =
+ let _v : (Parsetree.toplevel_phrase list) = let _1 =
let _1 =
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 45071 "parsing/parser.ml"
+# 45971 "parsing/parser.ml"
in
let xs =
let _1 =
-# 887 "parsing/parser.mly"
+# 953 "parsing/parser.mly"
( [] )
-# 45077 "parsing/parser.ml"
+# 45977 "parsing/parser.ml"
in
-# 1117 "parsing/parser.mly"
+# 1185 "parsing/parser.mly"
( _1 )
-# 45082 "parsing/parser.ml"
+# 45982 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 45088 "parsing/parser.ml"
+# 45988 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_xss_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 813 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 45097 "parsing/parser.ml"
+# 45997 "parsing/parser.ml"
in
-# 1110 "parsing/parser.mly"
+# 1178 "parsing/parser.mly"
( _1 )
-# 45103 "parsing/parser.ml"
+# 46003 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos_e_ in
let _endpos = _endpos__2_ in
- let _v : (
-# 787 "parsing/parser.mly"
- (Parsetree.toplevel_phrase list)
-# 45149 "parsing/parser.ml"
- ) = let _1 =
+ let _v : (Parsetree.toplevel_phrase list) = let _1 =
let _1 =
let ys =
# 260 "<standard.mly>"
( List.flatten xss )
-# 45155 "parsing/parser.ml"
+# 46051 "parsing/parser.ml"
in
let xs =
let _1 =
let _1 =
let _1 =
let attrs =
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 45165 "parsing/parser.ml"
+# 46061 "parsing/parser.ml"
in
-# 1308 "parsing/parser.mly"
+# 1379 "parsing/parser.mly"
( mkstrexp e attrs )
-# 45170 "parsing/parser.ml"
+# 46066 "parsing/parser.ml"
in
-# 831 "parsing/parser.mly"
+# 897 "parsing/parser.mly"
( Ptop_def [_1] )
-# 45176 "parsing/parser.ml"
+# 46072 "parsing/parser.ml"
in
let _startpos__1_ = _startpos_e_ in
let _startpos = _startpos__1_ in
-# 829 "parsing/parser.mly"
+# 895 "parsing/parser.mly"
( text_def _startpos @ [_1] )
-# 45184 "parsing/parser.ml"
+# 46080 "parsing/parser.ml"
in
-# 889 "parsing/parser.mly"
+# 955 "parsing/parser.mly"
( x )
-# 45190 "parsing/parser.ml"
+# 46086 "parsing/parser.ml"
in
-# 1117 "parsing/parser.mly"
+# 1185 "parsing/parser.mly"
( _1 )
-# 45196 "parsing/parser.ml"
+# 46092 "parsing/parser.ml"
in
# 267 "<standard.mly>"
( xs @ ys )
-# 45202 "parsing/parser.ml"
+# 46098 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos_xss_, _startpos_e_) in
let _endpos = _endpos__1_ in
let _startpos = _startpos__1_ in
-# 813 "parsing/parser.mly"
+# 879 "parsing/parser.mly"
( extra_def _startpos _endpos _1 )
-# 45211 "parsing/parser.ml"
+# 46107 "parsing/parser.ml"
in
-# 1110 "parsing/parser.mly"
+# 1178 "parsing/parser.mly"
( _1 )
-# 45217 "parsing/parser.ml"
+# 46113 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) =
-# 3435 "parsing/parser.mly"
+# 3519 "parsing/parser.mly"
( _2 )
-# 45256 "parsing/parser.ml"
+# 46152 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
let _loc__1_ = (_startpos__1_, _endpos__1_) in
-# 3436 "parsing/parser.mly"
+# 3520 "parsing/parser.mly"
( unclosed "(" _loc__1_ ")" _loc__3_ )
-# 45297 "parsing/parser.ml"
+# 46193 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__2_ in
let _v : (Asttypes.label) = let _loc__2_ = (_startpos__2_, _endpos__2_) in
-# 3437 "parsing/parser.mly"
+# 3521 "parsing/parser.mly"
( expecting _loc__2_ "operator" )
-# 45330 "parsing/parser.ml"
+# 46226 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _endpos = _endpos__3_ in
let _v : (Asttypes.label) = let _loc__3_ = (_startpos__3_, _endpos__3_) in
-# 3438 "parsing/parser.mly"
+# 3522 "parsing/parser.mly"
( expecting _loc__3_ "module-expr" )
-# 45370 "parsing/parser.ml"
+# 46266 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
MenhirLib.EngineTypes.next = _menhir_stack;
} = _menhir_stack in
let _1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45391 "parsing/parser.ml"
+# 46287 "parsing/parser.ml"
) = Obj.magic _1 in
let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3441 "parsing/parser.mly"
+# 3525 "parsing/parser.mly"
( _1 )
-# 45399 "parsing/parser.ml"
+# 46295 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.label) =
-# 3442 "parsing/parser.mly"
+# 3526 "parsing/parser.mly"
( _1 )
-# 45424 "parsing/parser.ml"
+# 46320 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Longident.t) =
-# 3510 "parsing/parser.mly"
+# 3594 "parsing/parser.mly"
( _1 )
-# 45449 "parsing/parser.ml"
+# 46345 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let ty : (Parsetree.core_type) = Obj.magic ty in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45496 "parsing/parser.ml"
+# 46392 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let mutable_ : (Asttypes.mutable_flag) = Obj.magic mutable_ in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let label =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 45510 "parsing/parser.ml"
+# 46406 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45518 "parsing/parser.ml"
+# 46414 "parsing/parser.ml"
in
let attrs =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 45524 "parsing/parser.ml"
+# 46420 "parsing/parser.ml"
in
let _1 =
-# 3646 "parsing/parser.mly"
+# 3734 "parsing/parser.mly"
( Fresh )
-# 45529 "parsing/parser.ml"
+# 46425 "parsing/parser.ml"
in
-# 1861 "parsing/parser.mly"
+# 1951 "parsing/parser.mly"
( (label, mutable_, Cfk_virtual ty), attrs )
-# 45534 "parsing/parser.ml"
+# 46430 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45581 "parsing/parser.ml"
+# 46477 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 45595 "parsing/parser.ml"
+# 46491 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45603 "parsing/parser.ml"
+# 46499 "parsing/parser.ml"
in
let _2 =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 45609 "parsing/parser.ml"
+# 46505 "parsing/parser.ml"
in
let _1 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 45614 "parsing/parser.ml"
+# 46510 "parsing/parser.ml"
in
-# 1863 "parsing/parser.mly"
+# 1953 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 45619 "parsing/parser.ml"
+# 46515 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : (Parsetree.expression) = Obj.magic _6 in
let _5 : unit = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45672 "parsing/parser.ml"
+# 46568 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 45687 "parsing/parser.ml"
+# 46583 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45695 "parsing/parser.ml"
+# 46591 "parsing/parser.ml"
in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 45703 "parsing/parser.ml"
+# 46599 "parsing/parser.ml"
in
let _1 =
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 45709 "parsing/parser.ml"
+# 46605 "parsing/parser.ml"
in
-# 1863 "parsing/parser.mly"
+# 1953 "parsing/parser.mly"
( (_4, _3, Cfk_concrete (_1, _6)), _2 )
-# 45714 "parsing/parser.ml"
+# 46610 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined1 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45768 "parsing/parser.ml"
+# 46664 "parsing/parser.ml"
) = Obj.magic _1_inlined1 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1 : (Parsetree.attributes) = Obj.magic _1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 45782 "parsing/parser.ml"
+# 46678 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45790 "parsing/parser.ml"
+# 46686 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined1_ in
let _2 =
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 45797 "parsing/parser.ml"
+# 46693 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_, _startpos__1_) in
let _1 =
-# 3649 "parsing/parser.mly"
+# 3737 "parsing/parser.mly"
( Fresh )
-# 45803 "parsing/parser.ml"
+# 46699 "parsing/parser.ml"
in
let (_endpos__1_, _startpos__1_) = (_endpos__0_, _endpos__0_) in
let _endpos = _endpos__7_ in
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1866 "parsing/parser.mly"
+# 1956 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 45823 "parsing/parser.ml"
+# 46719 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _6 : unit = Obj.magic _6 in
let _5 : (Parsetree.core_type option * Parsetree.core_type option) = Obj.magic _5 in
let _1_inlined2 : (
-# 651 "parsing/parser.mly"
+# 705 "parsing/parser.mly"
(string)
-# 45883 "parsing/parser.ml"
+# 46779 "parsing/parser.ml"
) = Obj.magic _1_inlined2 in
let _3 : (Asttypes.mutable_flag) = Obj.magic _3 in
let _1_inlined1 : (Parsetree.attributes) = Obj.magic _1_inlined1 in
Parsetree.attributes) = let _4 =
let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined2_, _startpos__1_inlined2_, _1_inlined2) in
let _1 =
-# 3409 "parsing/parser.mly"
+# 3493 "parsing/parser.mly"
( _1 )
-# 45898 "parsing/parser.ml"
+# 46794 "parsing/parser.ml"
in
let _endpos = _endpos__1_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 45906 "parsing/parser.ml"
+# 46802 "parsing/parser.ml"
in
let _startpos__4_ = _startpos__1_inlined2_ in
let _2 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 45915 "parsing/parser.ml"
+# 46811 "parsing/parser.ml"
in
let (_endpos__2_, _startpos__2_) = (_endpos__1_inlined1_, _startpos__1_inlined1_) in
let _1 =
-# 3650 "parsing/parser.mly"
+# 3738 "parsing/parser.mly"
( Override )
-# 45922 "parsing/parser.ml"
+# 46818 "parsing/parser.ml"
in
let _endpos = _endpos__7_ in
let _symbolstartpos = if _startpos__1_ != _endpos__1_ then
_startpos__4_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 1866 "parsing/parser.mly"
+# 1956 "parsing/parser.mly"
( let e = mkexp_constraint ~loc:_sloc _7 _5 in
(_4, _3, Cfk_concrete (_1, e)), _2
)
-# 45941 "parsing/parser.ml"
+# 46837 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.value_description * string Asttypes.loc option) = let attrs2 =
let _1 = _1_inlined3 in
-# 3743 "parsing/parser.mly"
+# 3831 "parsing/parser.mly"
( _1 )
-# 46010 "parsing/parser.ml"
+# 46906 "parsing/parser.ml"
in
let _endpos_attrs2_ = _endpos__1_inlined3_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46022 "parsing/parser.ml"
+# 46918 "parsing/parser.ml"
in
let attrs1 =
let _1 = _1_inlined1 in
-# 3747 "parsing/parser.mly"
+# 3835 "parsing/parser.mly"
( _1 )
-# 46030 "parsing/parser.ml"
+# 46926 "parsing/parser.ml"
in
let _endpos = _endpos_attrs2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 2792 "parsing/parser.mly"
+# 2872 "parsing/parser.mly"
( let attrs = attrs1 @ attrs2 in
let loc = make_loc _sloc in
let docs = symbol_docs _sloc in
Val.mk id ty ~attrs ~loc ~docs,
ext )
-# 46043 "parsing/parser.ml"
+# 46939 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _menhir_stack.MenhirLib.EngineTypes.endp in
let _endpos = _startpos in
let _v : (Asttypes.virtual_flag) =
-# 3610 "parsing/parser.mly"
+# 3698 "parsing/parser.mly"
( Concrete )
-# 46061 "parsing/parser.ml"
+# 46957 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.virtual_flag) =
-# 3611 "parsing/parser.mly"
+# 3699 "parsing/parser.mly"
( Virtual )
-# 46086 "parsing/parser.ml"
+# 46982 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.mutable_flag) =
-# 3634 "parsing/parser.mly"
+# 3722 "parsing/parser.mly"
( Immutable )
-# 46111 "parsing/parser.ml"
+# 47007 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3635 "parsing/parser.mly"
+# 3723 "parsing/parser.mly"
( Mutable )
-# 46143 "parsing/parser.ml"
+# 47039 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.mutable_flag) =
-# 3636 "parsing/parser.mly"
+# 3724 "parsing/parser.mly"
( Mutable )
-# 46175 "parsing/parser.ml"
+# 47071 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3641 "parsing/parser.mly"
+# 3729 "parsing/parser.mly"
( Public )
-# 46200 "parsing/parser.ml"
+# 47096 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3642 "parsing/parser.mly"
+# 3730 "parsing/parser.mly"
( Private )
-# 46232 "parsing/parser.ml"
+# 47128 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3643 "parsing/parser.mly"
+# 3731 "parsing/parser.mly"
( Private )
-# 46264 "parsing/parser.ml"
+# 47160 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let xs =
# 253 "<standard.mly>"
( List.rev xs )
-# 46326 "parsing/parser.ml"
+# 47222 "parsing/parser.ml"
in
-# 901 "parsing/parser.mly"
+# 967 "parsing/parser.mly"
( xs )
-# 46331 "parsing/parser.ml"
+# 47227 "parsing/parser.ml"
in
-# 2892 "parsing/parser.mly"
+# 2972 "parsing/parser.mly"
( _1 )
-# 46337 "parsing/parser.ml"
+# 47233 "parsing/parser.ml"
in
let _endpos__6_ = _endpos_xs_ in
let _5 =
let _1 = _1_inlined2 in
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 46346 "parsing/parser.ml"
+# 47242 "parsing/parser.ml"
in
let _3 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46357 "parsing/parser.ml"
+# 47253 "parsing/parser.ml"
in
let _endpos = _endpos__6_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3128 "parsing/parser.mly"
+# 3208 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_type
(_3,
~manifest:_5
~priv:_4
~loc:(make_loc _sloc))) )
-# 46374 "parsing/parser.ml"
+# 47270 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _v : (Parsetree.with_constraint) = let _5 =
let _1 = _1_inlined2 in
-# 3205 "parsing/parser.mly"
+# 3289 "parsing/parser.mly"
( _1 )
-# 46429 "parsing/parser.ml"
+# 47325 "parsing/parser.ml"
in
let _endpos__5_ = _endpos__1_inlined2_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46441 "parsing/parser.ml"
+# 47337 "parsing/parser.ml"
in
let _endpos = _endpos__5_ in
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 3141 "parsing/parser.mly"
+# 3221 "parsing/parser.mly"
( let lident = loc_last _3 in
Pwith_typesubst
(_3,
~params:_2
~manifest:_5
~loc:(make_loc _sloc))) )
-# 46456 "parsing/parser.ml"
+# 47352 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46507 "parsing/parser.ml"
+# 47403 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46518 "parsing/parser.ml"
+# 47414 "parsing/parser.ml"
in
-# 3149 "parsing/parser.mly"
+# 3229 "parsing/parser.mly"
( Pwith_module (_2, _4) )
-# 46524 "parsing/parser.ml"
+# 47420 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46575 "parsing/parser.ml"
+# 47471 "parsing/parser.ml"
in
let _2 =
let _symbolstartpos = _startpos__1_ in
let _sloc = (_symbolstartpos, _endpos) in
-# 817 "parsing/parser.mly"
+# 883 "parsing/parser.mly"
( mkrhs _1 _sloc )
-# 46586 "parsing/parser.ml"
+# 47482 "parsing/parser.ml"
in
-# 3151 "parsing/parser.mly"
+# 3231 "parsing/parser.mly"
( Pwith_modsubst (_2, _4) )
-# 46592 "parsing/parser.ml"
+# 47488 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = rhs;
+ MenhirLib.EngineTypes.startp = _startpos_rhs_;
+ MenhirLib.EngineTypes.endp = _endpos_rhs_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let rhs : (Parsetree.module_type) = Obj.magic rhs in
+ let _4 : unit = Obj.magic _4 in
+ let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos_rhs_ in
+ let _v : (Parsetree.with_constraint) = let l =
+ let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 883 "parsing/parser.mly"
+ ( mkrhs _1 _sloc )
+# 47546 "parsing/parser.ml"
+
+ in
+
+# 3233 "parsing/parser.mly"
+ ( Pwith_modtype (l, rhs) )
+# 47552 "parsing/parser.ml"
+ in
+ {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = Obj.repr _v;
+ MenhirLib.EngineTypes.startp = _startpos;
+ MenhirLib.EngineTypes.endp = _endpos;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ });
+ (fun _menhir_env ->
+ let _menhir_stack = _menhir_env.MenhirLib.EngineTypes.stack in
+ let {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = rhs;
+ MenhirLib.EngineTypes.startp = _startpos_rhs_;
+ MenhirLib.EngineTypes.endp = _endpos_rhs_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _4;
+ MenhirLib.EngineTypes.startp = _startpos__4_;
+ MenhirLib.EngineTypes.endp = _endpos__4_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _1_inlined1;
+ MenhirLib.EngineTypes.startp = _startpos__1_inlined1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_inlined1_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _;
+ MenhirLib.EngineTypes.semv = _2;
+ MenhirLib.EngineTypes.startp = _startpos__2_;
+ MenhirLib.EngineTypes.endp = _endpos__2_;
+ MenhirLib.EngineTypes.next = {
+ MenhirLib.EngineTypes.state = _menhir_s;
+ MenhirLib.EngineTypes.semv = _1;
+ MenhirLib.EngineTypes.startp = _startpos__1_;
+ MenhirLib.EngineTypes.endp = _endpos__1_;
+ MenhirLib.EngineTypes.next = _menhir_stack;
+ };
+ };
+ };
+ };
+ } = _menhir_stack in
+ let rhs : (Parsetree.module_type) = Obj.magic rhs in
+ let _4 : unit = Obj.magic _4 in
+ let _1_inlined1 : (Longident.t) = Obj.magic _1_inlined1 in
+ let _2 : unit = Obj.magic _2 in
+ let _1 : unit = Obj.magic _1 in
+ let _endpos__0_ = _menhir_stack.MenhirLib.EngineTypes.endp in
+ let _startpos = _startpos__1_ in
+ let _endpos = _endpos_rhs_ in
+ let _v : (Parsetree.with_constraint) = let l =
+ let (_endpos__1_, _startpos__1_, _1) = (_endpos__1_inlined1_, _startpos__1_inlined1_, _1_inlined1) in
+ let _endpos = _endpos__1_ in
+ let _symbolstartpos = _startpos__1_ in
+ let _sloc = (_symbolstartpos, _endpos) in
+
+# 883 "parsing/parser.mly"
+ ( mkrhs _1 _sloc )
+# 47610 "parsing/parser.ml"
+
+ in
+
+# 3235 "parsing/parser.mly"
+ ( Pwith_modtypesubst (l, rhs) )
+# 47616 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__1_ in
let _v : (Asttypes.private_flag) =
-# 3154 "parsing/parser.mly"
+# 3238 "parsing/parser.mly"
( Public )
-# 46617 "parsing/parser.ml"
+# 47641 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let _startpos = _startpos__1_ in
let _endpos = _endpos__2_ in
let _v : (Asttypes.private_flag) =
-# 3155 "parsing/parser.mly"
+# 3239 "parsing/parser.mly"
( Private )
-# 46649 "parsing/parser.ml"
+# 47673 "parsing/parser.ml"
in
{
MenhirLib.EngineTypes.state = _menhir_s;
let use_file =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1809 lexer lexbuf) : (
-# 787 "parsing/parser.mly"
- (Parsetree.toplevel_phrase list)
-# 46680 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1828 lexer lexbuf) : (Parsetree.toplevel_phrase list))
and toplevel_phrase =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1789 lexer lexbuf) : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 46688 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1808 lexer lexbuf) : (Parsetree.toplevel_phrase))
and parse_val_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1783 lexer lexbuf) : (
-# 797 "parsing/parser.mly"
- (Longident.t)
-# 46696 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1802 lexer lexbuf) : (Longident.t))
and parse_pattern =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1779 lexer lexbuf) : (
-# 793 "parsing/parser.mly"
- (Parsetree.pattern)
-# 46704 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1798 lexer lexbuf) : (Parsetree.pattern))
and parse_mty_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1775 lexer lexbuf) : (
-# 799 "parsing/parser.mly"
- (Longident.t)
-# 46712 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1794 lexer lexbuf) : (Longident.t))
and parse_mod_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1771 lexer lexbuf) : (
-# 803 "parsing/parser.mly"
- (Longident.t)
-# 46720 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1790 lexer lexbuf) : (Longident.t))
and parse_mod_ext_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1767 lexer lexbuf) : (
-# 801 "parsing/parser.mly"
- (Longident.t)
-# 46728 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1786 lexer lexbuf) : (Longident.t))
and parse_expression =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1763 lexer lexbuf) : (
-# 791 "parsing/parser.mly"
- (Parsetree.expression)
-# 46736 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1782 lexer lexbuf) : (Parsetree.expression))
and parse_core_type =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1759 lexer lexbuf) : (
-# 789 "parsing/parser.mly"
- (Parsetree.core_type)
-# 46744 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1778 lexer lexbuf) : (Parsetree.core_type))
and parse_constr_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1755 lexer lexbuf) : (
-# 795 "parsing/parser.mly"
- (Longident.t)
-# 46752 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1774 lexer lexbuf) : (Longident.t))
and parse_any_longident =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1737 lexer lexbuf) : (
-# 805 "parsing/parser.mly"
- (Longident.t)
-# 46760 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1756 lexer lexbuf) : (Longident.t))
and interface =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 1733 lexer lexbuf) : (
-# 783 "parsing/parser.mly"
- (Parsetree.signature)
-# 46768 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 1752 lexer lexbuf) : (Parsetree.signature))
and implementation =
fun lexer lexbuf ->
- (Obj.magic (MenhirInterpreter.entry 0 lexer lexbuf) : (
-# 781 "parsing/parser.mly"
- (Parsetree.structure)
-# 46776 "parsing/parser.ml"
- ))
+ (Obj.magic (MenhirInterpreter.entry `Simplified 0 lexer lexbuf) : (Parsetree.structure))
module Incremental = struct
let use_file =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1809 initial_position) : (
-# 787 "parsing/parser.mly"
- (Parsetree.toplevel_phrase list)
-# 46786 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1828 initial_position) : (Parsetree.toplevel_phrase list) MenhirInterpreter.checkpoint)
and toplevel_phrase =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1789 initial_position) : (
-# 785 "parsing/parser.mly"
- (Parsetree.toplevel_phrase)
-# 46794 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1808 initial_position) : (Parsetree.toplevel_phrase) MenhirInterpreter.checkpoint)
and parse_val_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1783 initial_position) : (
-# 797 "parsing/parser.mly"
- (Longident.t)
-# 46802 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1802 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_pattern =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1779 initial_position) : (
-# 793 "parsing/parser.mly"
- (Parsetree.pattern)
-# 46810 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1798 initial_position) : (Parsetree.pattern) MenhirInterpreter.checkpoint)
and parse_mty_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1775 initial_position) : (
-# 799 "parsing/parser.mly"
- (Longident.t)
-# 46818 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1794 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_mod_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1771 initial_position) : (
-# 803 "parsing/parser.mly"
- (Longident.t)
-# 46826 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1790 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_mod_ext_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1767 initial_position) : (
-# 801 "parsing/parser.mly"
- (Longident.t)
-# 46834 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1786 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_expression =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1763 initial_position) : (
-# 791 "parsing/parser.mly"
- (Parsetree.expression)
-# 46842 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1782 initial_position) : (Parsetree.expression) MenhirInterpreter.checkpoint)
and parse_core_type =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1759 initial_position) : (
-# 789 "parsing/parser.mly"
- (Parsetree.core_type)
-# 46850 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1778 initial_position) : (Parsetree.core_type) MenhirInterpreter.checkpoint)
and parse_constr_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1755 initial_position) : (
-# 795 "parsing/parser.mly"
- (Longident.t)
-# 46858 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1774 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and parse_any_longident =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1737 initial_position) : (
-# 805 "parsing/parser.mly"
- (Longident.t)
-# 46866 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1756 initial_position) : (Longident.t) MenhirInterpreter.checkpoint)
and interface =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 1733 initial_position) : (
-# 783 "parsing/parser.mly"
- (Parsetree.signature)
-# 46874 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 1752 initial_position) : (Parsetree.signature) MenhirInterpreter.checkpoint)
and implementation =
fun initial_position ->
- (Obj.magic (MenhirInterpreter.start 0 initial_position) : (
-# 781 "parsing/parser.mly"
- (Parsetree.structure)
-# 46882 "parsing/parser.ml"
- ) MenhirInterpreter.checkpoint)
+ (Obj.magic (MenhirInterpreter.start 0 initial_position) : (Parsetree.structure) MenhirInterpreter.checkpoint)
end
-# 3777 "parsing/parser.mly"
+# 3867 "parsing/parser.mly"
-# 46890 "parsing/parser.ml"
+# 47810 "parsing/parser.ml"
# 269 "<standard.mly>"
-# 46895 "parsing/parser.ml"
+# 47815 "parsing/parser.ml"
#
# Copyright (c) 2008 Steven G. Johnson <stevenj@alum.mit.edu>
# Copyright (c) 2011 Daniel Richard G. <skunk@iSKUNK.ORG>
+# Copyright (c) 2019 Marc Stevens <marc.stevens@cwi.nl>
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# modified version of the Autoconf Macro, you may extend this special
# exception to the GPL to apply to your modified version as well.
-#serial 24
+#serial 27
AU_ALIAS([ACX_PTHREAD], [AX_PTHREAD])
AC_DEFUN([AX_PTHREAD], [
# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
# libraries is broken (non-POSIX).
-# Create a list of thread flags to try. Items starting with a "-" are
-# C compiler flags, and other items are library names, except for "none"
-# which indicates that we try without any flags at all, and "pthread-config"
-# which is a program returning the flags for the Pth emulation library.
+# Create a list of thread flags to try. Items with a "," contain both
+# C compiler flags (before ",") and linker flags (after ","). Other items
+# starting with a "-" are C compiler flags, and remaining items are
+# library names, except for "none" which indicates that we try without
+# any flags at all, and "pthread-config" which is a program returning
+# the flags for the Pth emulation library.
ax_pthread_flags="pthreads none -Kthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
# that too in a future libc.) So we'll check first for the
# standard Solaris way of linking pthreads (-mt -lpthread).
- ax_pthread_flags="-mt,pthread pthread $ax_pthread_flags"
+ ax_pthread_flags="-mt,-lpthread pthread $ax_pthread_flags"
;;
esac
+# Are we compiling with Clang?
+
+AC_CACHE_CHECK([whether $CC is Clang],
+ [ax_cv_PTHREAD_CLANG],
+ [ax_cv_PTHREAD_CLANG=no
+ # Note that Autoconf sets GCC=yes for Clang as well as GCC
+ if test "x$GCC" = "xyes"; then
+ AC_EGREP_CPP([AX_PTHREAD_CC_IS_CLANG],
+ [/* Note: Clang 2.7 lacks __clang_[a-z]+__ */
+# if defined(__clang__) && defined(__llvm__)
+ AX_PTHREAD_CC_IS_CLANG
+# endif
+ ],
+ [ax_cv_PTHREAD_CLANG=yes])
+ fi
+ ])
+ax_pthread_clang="$ax_cv_PTHREAD_CLANG"
+
+
# GCC generally uses -pthread, or -pthreads on some platforms (e.g. SPARC)
+# Note that for GCC and Clang -pthread generally implies -lpthread,
+# except when -nostdlib is passed.
+# This is problematic using libtool to build C++ shared libraries with pthread:
+# [1] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=25460
+# [2] https://bugzilla.redhat.com/show_bug.cgi?id=661333
+# [3] https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=468555
+# To solve this, first try -pthread together with -lpthread for GCC
+
AS_IF([test "x$GCC" = "xyes"],
- [ax_pthread_flags="-pthread -pthreads $ax_pthread_flags"])
+ [ax_pthread_flags="-pthread,-lpthread -pthread -pthreads $ax_pthread_flags"])
+
+# Clang takes -pthread (never supported any other flag), but we'll try with -lpthread first
+
+AS_IF([test "x$ax_pthread_clang" = "xyes"],
+ [ax_pthread_flags="-pthread,-lpthread -pthread"])
+
# The presence of a feature test macro requesting re-entrant function
# definitions is, on some systems, a strong hint that pthreads support is
[ax_pthread_check_cond=0],
[ax_pthread_check_cond="!defined($ax_pthread_check_macro)"])
-# Are we compiling with Clang?
-AC_CACHE_CHECK([whether $CC is Clang],
- [ax_cv_PTHREAD_CLANG],
- [ax_cv_PTHREAD_CLANG=no
- # Note that Autoconf sets GCC=yes for Clang as well as GCC
- if test "x$GCC" = "xyes"; then
- AC_EGREP_CPP([AX_PTHREAD_CC_IS_CLANG],
- [/* Note: Clang 2.7 lacks __clang_[a-z]+__ */
-# if defined(__clang__) && defined(__llvm__)
- AX_PTHREAD_CC_IS_CLANG
-# endif
- ],
- [ax_cv_PTHREAD_CLANG=yes])
- fi
- ])
-ax_pthread_clang="$ax_cv_PTHREAD_CLANG"
+if test "x$ax_pthread_ok" = "xno"; then
+for ax_pthread_try_flag in $ax_pthread_flags; do
+
+ case $ax_pthread_try_flag in
+ none)
+ AC_MSG_CHECKING([whether pthreads work without any flags])
+ ;;
+
+ *,*)
+ PTHREAD_CFLAGS=`echo $ax_pthread_try_flag | sed "s/^\(.*\),\(.*\)$/\1/"`
+ PTHREAD_LIBS=`echo $ax_pthread_try_flag | sed "s/^\(.*\),\(.*\)$/\2/"`
+ AC_MSG_CHECKING([whether pthreads work with "$PTHREAD_CFLAGS" and "$PTHREAD_LIBS"])
+ ;;
+
+ -*)
+ AC_MSG_CHECKING([whether pthreads work with $ax_pthread_try_flag])
+ PTHREAD_CFLAGS="$ax_pthread_try_flag"
+ ;;
+
+ pthread-config)
+ AC_CHECK_PROG([ax_pthread_config], [pthread-config], [yes], [no])
+ AS_IF([test "x$ax_pthread_config" = "xno"], [continue])
+ PTHREAD_CFLAGS="`pthread-config --cflags`"
+ PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
+ ;;
+
+ *)
+ AC_MSG_CHECKING([for the pthreads library -l$ax_pthread_try_flag])
+ PTHREAD_LIBS="-l$ax_pthread_try_flag"
+ ;;
+ esac
+
+ ax_pthread_save_CFLAGS="$CFLAGS"
+ ax_pthread_save_LIBS="$LIBS"
+ CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+ LIBS="$PTHREAD_LIBS $LIBS"
+
+ # Check for various functions. We must include pthread.h,
+ # since some functions may be macros. (On the Sequent, we
+ # need a special flag -Kthread to make this header compile.)
+ # We check for pthread_join because it is in -lpthread on IRIX
+ # while pthread_create is in libc. We check for pthread_attr_init
+ # due to DEC craziness with -lpthreads. We check for
+ # pthread_cleanup_push because it is one of the few pthread
+ # functions on Solaris that doesn't have a non-functional libc stub.
+ # We try pthread_create on general principles.
+
+ AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <pthread.h>
+# if $ax_pthread_check_cond
+# error "$ax_pthread_check_macro must be defined"
+# endif
+ static void *some_global = NULL;
+ static void routine(void *a)
+ {
+ /* To avoid any unused-parameter or
+ unused-but-set-parameter warning. */
+ some_global = a;
+ }
+ static void *start_routine(void *a) { return a; }],
+ [pthread_t th; pthread_attr_t attr;
+ pthread_create(&th, 0, start_routine, 0);
+ pthread_join(th, 0);
+ pthread_attr_init(&attr);
+ pthread_cleanup_push(routine, 0);
+ pthread_cleanup_pop(0) /* ; */])],
+ [ax_pthread_ok=yes],
+ [])
+
+ CFLAGS="$ax_pthread_save_CFLAGS"
+ LIBS="$ax_pthread_save_LIBS"
+
+ AC_MSG_RESULT([$ax_pthread_ok])
+ AS_IF([test "x$ax_pthread_ok" = "xyes"], [break])
+
+ PTHREAD_LIBS=""
+ PTHREAD_CFLAGS=""
+done
+fi
-ax_pthread_clang_warning=no
# Clang needs special handling, because older versions handle the -pthread
# option in a rather... idiosyncratic way
# -pthread does define _REENTRANT, and while the Darwin headers
# ignore this macro, third-party headers might not.)
- PTHREAD_CFLAGS="-pthread"
- PTHREAD_LIBS=
-
- ax_pthread_ok=yes
-
# However, older versions of Clang make a point of warning the user
# that, in an invocation where only linking and no compilation is
# taking place, the -pthread option has no effect ("argument unused
fi # $ax_pthread_clang = yes
-if test "x$ax_pthread_ok" = "xno"; then
-for ax_pthread_try_flag in $ax_pthread_flags; do
-
- case $ax_pthread_try_flag in
- none)
- AC_MSG_CHECKING([whether pthreads work without any flags])
- ;;
-
- -mt,pthread)
- AC_MSG_CHECKING([whether pthreads work with -mt -lpthread])
- PTHREAD_CFLAGS="-mt"
- PTHREAD_LIBS="-lpthread"
- ;;
-
- -*)
- AC_MSG_CHECKING([whether pthreads work with $ax_pthread_try_flag])
- PTHREAD_CFLAGS="$ax_pthread_try_flag"
- ;;
-
- pthread-config)
- AC_CHECK_PROG([ax_pthread_config], [pthread-config], [yes], [no])
- AS_IF([test "x$ax_pthread_config" = "xno"], [continue])
- PTHREAD_CFLAGS="`pthread-config --cflags`"
- PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`"
- ;;
- *)
- AC_MSG_CHECKING([for the pthreads library -l$ax_pthread_try_flag])
- PTHREAD_LIBS="-l$ax_pthread_try_flag"
- ;;
- esac
-
- ax_pthread_save_CFLAGS="$CFLAGS"
- ax_pthread_save_LIBS="$LIBS"
- CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
- LIBS="$PTHREAD_LIBS $LIBS"
-
- # Check for various functions. We must include pthread.h,
- # since some functions may be macros. (On the Sequent, we
- # need a special flag -Kthread to make this header compile.)
- # We check for pthread_join because it is in -lpthread on IRIX
- # while pthread_create is in libc. We check for pthread_attr_init
- # due to DEC craziness with -lpthreads. We check for
- # pthread_cleanup_push because it is one of the few pthread
- # functions on Solaris that doesn't have a non-functional libc stub.
- # We try pthread_create on general principles.
-
- AC_LINK_IFELSE([AC_LANG_PROGRAM([#include <pthread.h>
-# if $ax_pthread_check_cond
-# error "$ax_pthread_check_macro must be defined"
-# endif
- static void routine(void *a) { a = 0; }
- static void *start_routine(void *a) { return a; }],
- [pthread_t th; pthread_attr_t attr;
- pthread_create(&th, 0, start_routine, 0);
- pthread_join(th, 0);
- pthread_attr_init(&attr);
- pthread_cleanup_push(routine, 0);
- pthread_cleanup_pop(0) /* ; */])],
- [ax_pthread_ok=yes],
- [])
-
- CFLAGS="$ax_pthread_save_CFLAGS"
- LIBS="$ax_pthread_save_LIBS"
-
- AC_MSG_RESULT([$ax_pthread_ok])
- AS_IF([test "x$ax_pthread_ok" = "xyes"], [break])
-
- PTHREAD_LIBS=""
- PTHREAD_CFLAGS=""
-done
-fi
# Various other checks:
if test "x$ax_pthread_ok" = "xyes"; then
AC_CACHE_CHECK([for PTHREAD_PRIO_INHERIT],
[ax_cv_PTHREAD_PRIO_INHERIT],
[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <pthread.h>]],
- [[int i = PTHREAD_PRIO_INHERIT;]])],
+ [[int i = PTHREAD_PRIO_INHERIT;
+ return i;]])],
[ax_cv_PTHREAD_PRIO_INHERIT=yes],
[ax_cv_PTHREAD_PRIO_INHERIT=no])
])
from the tail call optimization? *)
let preserve_tailcall_for_prim = function
- Pidentity | Popaque | Pdirapply | Prevapply | Psequor | Psequand ->
+ | Popaque | Psequor | Psequand ->
true
| Pbytes_to_string | Pbytes_of_string | Pignore | Pgetglobal _ | Psetglobal _
| Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
let rec comp_expr env exp sz cont =
if sz > !max_stack_used then max_stack_used := sz;
match exp with
- Lvar id ->
+ Lvar id | Lmutvar id ->
begin try
let pos = Ident.find_same id env.ce_stack in
Kacc(sz - pos) :: cont
end
end
| Lsend(kind, met, obj, args, _) ->
- let args = if kind = Cached then List.tl args else args in
+ assert (kind <> Cached);
let nargs = List.length args + 1 in
let getmethod, args' =
if kind = Self then (Kgetmethod, met::obj::args) else
Stack.push to_compile functions_to_compile;
comp_args env (List.map (fun n -> Lvar n) fv) sz
(Kclosure(lbl, List.length fv) :: cont)
- | Llet(_str, _k, id, arg, body) ->
+ | Llet(_, _k, id, arg, body)
+ | Lmutlet(_k, id, arg, body) ->
comp_expr env arg sz
(Kpush :: comp_expr (add_var id (sz+1) env) body (sz+1)
(add_pop 1 cont))
in
comp_init env sz decl_size
end
- | Lprim((Pidentity | Popaque), [arg], _) ->
+ | Lprim(Popaque, [arg], _) ->
comp_expr env arg sz cont
| Lprim(Pignore, [arg], _) ->
comp_expr env arg sz (add_const_unit cont)
- | Lprim(Pdirapply, [func;arg], loc)
- | Lprim(Prevapply, [arg;func], loc) ->
- let exp = Lapply{
- ap_loc=loc;
- ap_func=func;
- ap_args=[arg];
- ap_tailcall=Default_tailcall;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise;
- } in
- comp_expr env exp sz cont
| Lprim(Pnot, [arg], _) ->
let newcont =
match cont with
| Cannot_open_dll of filepath
| Required_module_unavailable of modname * modname
| Camlheader of string * filepath
+ | Wrong_link_order of (modname * modname) list
exception Error of error
(* First pass: determine which units are needed *)
let missing_globals = ref Ident.Map.empty
+let provided_globals = ref Ident.Set.empty
+let badly_ordered_dependencies : (string * string) list ref = ref []
let is_required (rel, _pos) =
match rel with
let add_required compunit =
let add id =
+ if Ident.Set.mem id !provided_globals then
+ badly_ordered_dependencies :=
+ ((Ident.name id), compunit.cu_name) :: !badly_ordered_dependencies;
missing_globals := Ident.Map.add id compunit.cu_name !missing_globals
in
List.iter add (Symtable.required_globals compunit.cu_reloc);
let remove_required (rel, _pos) =
match rel with
Reloc_setglobal id ->
- missing_globals := Ident.Map.remove id !missing_globals
+ missing_globals := Ident.Map.remove id !missing_globals;
+ provided_globals := Ident.Set.add id !provided_globals;
| _ -> ()
let scan_file obj_name tolink =
\nextern \"C\" {\
\n#endif\
\n#include <caml/mlvalues.h>\
-\n#include <caml/startup.h>\n";
+\n#include <caml/startup.h>\
+\n#include <caml/sys.h>\n";
output_string outchan "static int caml_code[] = {\n";
Symtable.init();
clear_crc_interfaces ();
\n caml_sections, sizeof(caml_sections),\
\n /* pooling */ 0,\
\n argv);\
-\n caml_sys_exit(Val_int(0));\
+\n caml_do_exit(0);\
\n return 0; /* not reached */\
\n}\n"
end else begin
\n}\
\n#endif\n";
);
- if !Clflags.debug then
+ if not with_main && !Clflags.debug then
output_cds_file ((Filename.chop_extension outfile) ^ ".cds")
(* Build a custom runtime *)
match Ident.Map.bindings missing_modules with
| [] -> ()
| (id, cu_name) :: _ ->
- raise (Error (Required_module_unavailable (Ident.name id, cu_name)))
+ match !badly_ordered_dependencies with
+ | [] ->
+ raise (Error (Required_module_unavailable (Ident.name id, cu_name)))
+ | l ->
+ raise (Error (Wrong_link_order l))
end;
Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs; (* put user's libs last *)
Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
fprintf ppf "Module `%s' is unavailable (required by `%s')" s m
| Camlheader (msg, header) ->
fprintf ppf "System error while copying file %s: %s" header msg
+ | Wrong_link_order l ->
+ let depends_on ppf (dep, depending) =
+ fprintf ppf "%s depends on %s" depending dep
+ in
+ fprintf ppf "@[<hov 2>Wrong link order: %a@]"
+ (pp_print_list ~pp_sep:(fun ppf () -> fprintf ppf ",@ ") depends_on) l
let () =
Location.register_error_of_exn
| Cannot_open_dll of filepath
| Required_module_unavailable of modname * modname
| Camlheader of string * filepath
+ | Wrong_link_order of (modname * modname) list
exception Error of error
# linked in the archive, but they are marked as dependencies to ensure
# that they are consistent with the interface digests in the archives.
-UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
- utils/identifiable.cmo utils/numbers.cmo utils/arg_helper.cmo \
- utils/clflags.cmo utils/profile.cmo utils/local_store.cmo \
- utils/load_path.cmo \
- utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
- utils/consistbl.cmo utils/strongly_connected_components.cmo \
- utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \
- utils/domainstate.cmo utils/binutils.cmo
-UTILS_CMI=
-
-PARSING=parsing/location.cmo parsing/longident.cmo \
- parsing/docstrings.cmo parsing/syntaxerr.cmo \
+UTILS = \
+ utils/config.cmo \
+ utils/build_path_prefix_map.cmo \
+ utils/misc.cmo \
+ utils/identifiable.cmo \
+ utils/numbers.cmo \
+ utils/arg_helper.cmo \
+ utils/clflags.cmo \
+ utils/profile.cmo \
+ utils/local_store.cmo \
+ utils/load_path.cmo \
+ utils/terminfo.cmo \
+ utils/ccomp.cmo \
+ utils/warnings.cmo \
+ utils/consistbl.cmo \
+ utils/strongly_connected_components.cmo \
+ utils/targetint.cmo \
+ utils/int_replace_polymorphic_compare.cmo \
+ utils/domainstate.cmo \
+ utils/binutils.cmo \
+ utils/lazy_backtrack.cmo \
+ utils/diffing.cmo
+UTILS_CMI =
+
+PARSING = \
+ parsing/location.cmo \
+ parsing/longident.cmo \
+ parsing/docstrings.cmo \
+ parsing/syntaxerr.cmo \
parsing/ast_helper.cmo \
parsing/pprintast.cmo \
- parsing/camlinternalMenhirLib.cmo parsing/parser.cmo \
- parsing/lexer.cmo parsing/parse.cmo parsing/printast.cmo \
- parsing/ast_mapper.cmo parsing/ast_iterator.cmo parsing/attr_helper.cmo \
- parsing/builtin_attributes.cmo parsing/ast_invariants.cmo parsing/depend.cmo
-PARSING_CMI=\
+ parsing/camlinternalMenhirLib.cmo \
+ parsing/parser.cmo \
+ parsing/lexer.cmo \
+ parsing/parse.cmo \
+ parsing/printast.cmo \
+ parsing/ast_mapper.cmo \
+ parsing/ast_iterator.cmo \
+ parsing/attr_helper.cmo \
+ parsing/builtin_attributes.cmo \
+ parsing/ast_invariants.cmo \
+ parsing/depend.cmo
+PARSING_CMI = \
parsing/asttypes.cmi \
parsing/parsetree.cmi
-TYPING=typing/ident.cmo typing/path.cmo \
- typing/primitive.cmo typing/type_immediacy.cmo typing/types.cmo \
- typing/btype.cmo typing/oprint.cmo \
- typing/subst.cmo typing/predef.cmo \
- typing/datarepr.cmo file_formats/cmi_format.cmo \
- typing/persistent_env.cmo typing/env.cmo \
- typing/typedtree.cmo typing/printtyped.cmo typing/ctype.cmo \
- typing/printtyp.cmo typing/includeclass.cmo \
- typing/mtype.cmo typing/envaux.cmo typing/includecore.cmo \
- typing/tast_iterator.cmo typing/tast_mapper.cmo typing/stypes.cmo \
- file_formats/cmt_format.cmo typing/cmt2annot.cmo typing/untypeast.cmo \
- typing/includemod.cmo typing/typetexp.cmo typing/printpat.cmo \
- typing/patterns.cmo typing/parmatch.cmo \
- typing/typedecl_properties.cmo typing/typedecl_variance.cmo \
- typing/typedecl_unboxed.cmo typing/typedecl_immediacy.cmo \
+TYPING = \
+ typing/ident.cmo \
+ typing/path.cmo \
+ typing/primitive.cmo \
+ typing/type_immediacy.cmo \
+ typing/types.cmo \
+ typing/btype.cmo \
+ typing/oprint.cmo \
+ typing/subst.cmo \
+ typing/predef.cmo \
+ typing/datarepr.cmo \
+ file_formats/cmi_format.cmo \
+ typing/persistent_env.cmo \
+ typing/env.cmo \
+ typing/errortrace.cmo \
+ typing/typedtree.cmo \
+ typing/signature_group.cmo \
+ typing/printtyped.cmo \
+ typing/ctype.cmo \
+ typing/printtyp.cmo \
+ typing/includeclass.cmo \
+ typing/mtype.cmo \
+ typing/envaux.cmo \
+ typing/includecore.cmo \
+ typing/tast_iterator.cmo \
+ typing/tast_mapper.cmo \
+ typing/stypes.cmo \
+ file_formats/cmt_format.cmo \
+ typing/cmt2annot.cmo \
+ typing/untypeast.cmo \
+ typing/includemod.cmo \
+ typing/includemod_errorprinter.cmo \
+ typing/typetexp.cmo \
+ typing/printpat.cmo \
+ typing/patterns.cmo \
+ typing/parmatch.cmo \
+ typing/typedecl_properties.cmo \
+ typing/typedecl_variance.cmo \
+ typing/typedecl_unboxed.cmo \
+ typing/typedecl_immediacy.cmo \
typing/typedecl_separability.cmo \
- typing/typedecl.cmo typing/typeopt.cmo \
- typing/rec_check.cmo typing/typecore.cmo typing/typeclass.cmo \
+ typing/typedecl.cmo \
+ typing/typeopt.cmo \
+ typing/rec_check.cmo \
+ typing/typecore.cmo \
+ typing/typeclass.cmo \
typing/typemod.cmo
-TYPING_CMI=\
+TYPING_CMI = \
typing/annot.cmi \
typing/outcometree.cmi
-LAMBDA=lambda/debuginfo.cmo \
- lambda/lambda.cmo lambda/printlambda.cmo \
- lambda/switch.cmo lambda/matching.cmo \
- lambda/translobj.cmo lambda/translattribute.cmo \
- lambda/translprim.cmo lambda/translcore.cmo \
- lambda/translclass.cmo lambda/translmod.cmo \
- lambda/simplif.cmo lambda/runtimedef.cmo
-LAMBDA_CMI=
-
-COMP=\
- bytecomp/meta.cmo bytecomp/opcodes.cmo \
- bytecomp/bytesections.cmo bytecomp/dll.cmo \
+LAMBDA = \
+ lambda/debuginfo.cmo \
+ lambda/lambda.cmo \
+ lambda/printlambda.cmo \
+ lambda/switch.cmo \
+ lambda/matching.cmo \
+ lambda/translobj.cmo \
+ lambda/translattribute.cmo \
+ lambda/translprim.cmo \
+ lambda/translcore.cmo \
+ lambda/translclass.cmo \
+ lambda/translmod.cmo \
+ lambda/simplif.cmo \
+ lambda/runtimedef.cmo
+LAMBDA_CMI =
+
+COMP = \
+ bytecomp/meta.cmo \
+ bytecomp/opcodes.cmo \
+ bytecomp/bytesections.cmo \
+ bytecomp/dll.cmo \
bytecomp/symtable.cmo \
- driver/pparse.cmo driver/compenv.cmo \
- driver/main_args.cmo driver/compmisc.cmo \
+ driver/pparse.cmo \
+ driver/compenv.cmo \
+ driver/main_args.cmo \
+ driver/compmisc.cmo \
driver/makedepend.cmo \
driver/compile_common.cmo
-COMP_CMI=\
+COMP_CMI = \
file_formats/cmo_format.cmi \
file_formats/cmx_format.cmi \
file_formats/cmxs_format.cmi
# All file format descriptions (including cmx{,s}) are in the
# ocamlcommon library so that ocamlobjinfo can depend on them.
-COMMON_CMI=$(UTILS_CMI) $(PARSING_CMI) $(TYPING_CMI) $(LAMBDA_CMI) $(COMP_CMI)
+COMMON_CMI = $(UTILS_CMI) $(PARSING_CMI) $(TYPING_CMI) $(LAMBDA_CMI) $(COMP_CMI)
-COMMON=$(UTILS) $(PARSING) $(TYPING) $(LAMBDA) $(COMP)
+COMMON = $(UTILS) $(PARSING) $(TYPING) $(LAMBDA) $(COMP)
-BYTECOMP=bytecomp/instruct.cmo bytecomp/bytegen.cmo \
- bytecomp/printinstr.cmo bytecomp/emitcode.cmo \
- bytecomp/bytelink.cmo bytecomp/bytelibrarian.cmo bytecomp/bytepackager.cmo \
- driver/errors.cmo driver/compile.cmo driver/maindriver.cmo
-BYTECOMP_CMI=
+BYTECOMP = \
+ bytecomp/instruct.cmo \
+ bytecomp/bytegen.cmo \
+ bytecomp/printinstr.cmo \
+ bytecomp/emitcode.cmo \
+ bytecomp/bytelink.cmo \
+ bytecomp/bytelibrarian.cmo \
+ bytecomp/bytepackager.cmo \
+ driver/errors.cmo \
+ driver/compile.cmo \
+ driver/maindriver.cmo
+BYTECOMP_CMI =
-INTEL_ASM=\
+INTEL_ASM = \
asmcomp/x86_proc.cmo \
asmcomp/x86_dsl.cmo \
asmcomp/x86_gas.cmo \
asmcomp/x86_masm.cmo
-INTEL_ASM_CMI=\
+INTEL_ASM_CMI = \
asmcomp/x86_ast.cmi
-ARCH_SPECIFIC_ASMCOMP=
-ARCH_SPECIFIC_ASMCOMP_CMI=
+ARCH_SPECIFIC_ASMCOMP =
+ARCH_SPECIFIC_ASMCOMP_CMI =
ifeq ($(ARCH),i386)
-ARCH_SPECIFIC_ASMCOMP=$(INTEL_ASM)
-ARCH_SPECIFIC_ASMCOMP_CMI=$(INTEL_ASM_CMI)
+ARCH_SPECIFIC_ASMCOMP = $(INTEL_ASM)
+ARCH_SPECIFIC_ASMCOMP_CMI = $(INTEL_ASM_CMI)
endif
ifeq ($(ARCH),amd64)
-ARCH_SPECIFIC_ASMCOMP=$(INTEL_ASM)
-ARCH_SPECIFIC_ASMCOMP_CMI=$(INTEL_ASM_CMI)
+ARCH_SPECIFIC_ASMCOMP = $(INTEL_ASM)
+ARCH_SPECIFIC_ASMCOMP_CMI = $(INTEL_ASM_CMI)
endif
-ASMCOMP=\
+ASMCOMP = \
$(ARCH_SPECIFIC_ASMCOMP) \
asmcomp/arch.cmo \
- asmcomp/cmm.cmo asmcomp/printcmm.cmo \
- asmcomp/reg.cmo asmcomp/debug/reg_with_debug_info.cmo \
- asmcomp/debug/reg_availability_set.cmo \
- asmcomp/mach.cmo asmcomp/proc.cmo \
+ asmcomp/cmm.cmo \
+ asmcomp/printcmm.cmo \
+ asmcomp/reg.cmo \
+ asmcomp/mach.cmo \
+ asmcomp/proc.cmo \
asmcomp/afl_instrument.cmo \
asmcomp/strmatch.cmo \
asmcomp/cmmgen_state.cmo \
asmcomp/cmm_helpers.cmo \
asmcomp/cmmgen.cmo \
+ asmcomp/cmm_invariants.cmo \
asmcomp/interval.cmo \
- asmcomp/printmach.cmo asmcomp/selectgen.cmo \
+ asmcomp/printmach.cmo \
+ asmcomp/dataflow.cmo \
+ asmcomp/polling.cmo \
+ asmcomp/selectgen.cmo \
asmcomp/selection.cmo \
asmcomp/comballoc.cmo \
- asmcomp/CSEgen.cmo asmcomp/CSE.cmo \
+ asmcomp/CSEgen.cmo \
+ asmcomp/CSE.cmo \
asmcomp/liveness.cmo \
- asmcomp/spill.cmo asmcomp/split.cmo \
- asmcomp/interf.cmo asmcomp/coloring.cmo \
+ asmcomp/spill.cmo \
+ asmcomp/split.cmo \
+ asmcomp/interf.cmo \
+ asmcomp/coloring.cmo \
asmcomp/linscan.cmo \
- asmcomp/reloadgen.cmo asmcomp/reload.cmo \
+ asmcomp/reloadgen.cmo \
+ asmcomp/reload.cmo \
asmcomp/deadcode.cmo \
- asmcomp/linear.cmo asmcomp/printlinear.cmo asmcomp/linearize.cmo \
+ asmcomp/linear.cmo \
+ asmcomp/printlinear.cmo \
+ asmcomp/linearize.cmo \
file_formats/linear_format.cmo \
- asmcomp/debug/available_regs.cmo \
- asmcomp/debug/compute_ranges_intf.cmo \
- asmcomp/debug/compute_ranges.cmo \
- asmcomp/schedgen.cmo asmcomp/scheduling.cmo \
+ asmcomp/schedgen.cmo \
+ asmcomp/scheduling.cmo \
asmcomp/branch_relaxation_intf.cmo \
asmcomp/branch_relaxation.cmo \
- asmcomp/emitaux.cmo asmcomp/emit.cmo asmcomp/asmgen.cmo \
- asmcomp/asmlink.cmo asmcomp/asmlibrarian.cmo asmcomp/asmpackager.cmo \
- driver/opterrors.cmo driver/optcompile.cmo driver/optmaindriver.cmo
-ASMCOMP_CMI=$(ARCH_SPECIFIC_ASMCOMP_CMI)
+ asmcomp/emitaux.cmo \
+ asmcomp/emit.cmo \
+ asmcomp/asmgen.cmo \
+ asmcomp/asmlink.cmo \
+ asmcomp/asmlibrarian.cmo \
+ asmcomp/asmpackager.cmo \
+ driver/opterrors.cmo \
+ driver/optcompile.cmo \
+ driver/optmaindriver.cmo
+ASMCOMP_CMI = $(ARCH_SPECIFIC_ASMCOMP_CMI)
# Files under middle_end/ are not to reference files under asmcomp/.
# This ensures that the middle end can be linked (e.g. for objinfo) even when
# the native code compiler is not present for some particular target.
-MIDDLE_END_CLOSURE=\
+MIDDLE_END_CLOSURE = \
middle_end/closure/closure.cmo \
middle_end/closure/closure_middle_end.cmo
-MIDDLE_END_CLOSURE_CMI=
+MIDDLE_END_CLOSURE_CMI =
# Owing to dependencies through [Compilenv], which would be
# difficult to remove, some of the lower parts of Flambda (anything that is
# saved in a .cmx file) have to be included in the [MIDDLE_END] stanza, below.
-MIDDLE_END_FLAMBDA=\
+MIDDLE_END_FLAMBDA = \
middle_end/flambda/import_approx.cmo \
middle_end/flambda/lift_code.cmo \
middle_end/flambda/closure_conversion_aux.cmo \
middle_end/flambda/un_anf.cmo \
middle_end/flambda/flambda_to_clambda.cmo \
middle_end/flambda/flambda_middle_end.cmo
-MIDDLE_END_FLAMBDA_CMI=\
+MIDDLE_END_FLAMBDA_CMI = \
middle_end/flambda/inlining_decision_intf.cmi \
middle_end/flambda/simplify_boxed_integer_ops_intf.cmi
-MIDDLE_END=\
+MIDDLE_END = \
middle_end/internal_variable_names.cmo \
middle_end/linkage_name.cmo \
middle_end/compilation_unit.cmo \
middle_end/compilenv.cmo \
$(MIDDLE_END_CLOSURE) \
$(MIDDLE_END_FLAMBDA)
-MIDDLE_END_CMI=\
+MIDDLE_END_CMI = \
middle_end/backend_intf.cmi \
$(MIDDLE_END_CLOSURE_CMI) \
$(MIDDLE_END_FLAMBDA_CMI)
-OPTCOMP=$(MIDDLE_END) $(ASMCOMP)
-OPTCOMP_CMI=$(MIDDLE_END_CMI) $(ASMCOMP_CMI)
-
-TOPLEVEL=toplevel/genprintval.cmo toplevel/toploop.cmo \
- toplevel/trace.cmo toplevel/topdirs.cmo toplevel/topmain.cmo
-TOPLEVEL_CMI=
-
-OPTTOPLEVEL=toplevel/genprintval.cmo toplevel/opttoploop.cmo \
- toplevel/opttopdirs.cmo toplevel/opttopmain.cmo
-OPTTOPLEVEL_CMI=
+OPTCOMP = $(MIDDLE_END) $(ASMCOMP)
+OPTCOMP_CMI = $(MIDDLE_END_CMI) $(ASMCOMP_CMI)
+
+TOPLEVEL = \
+ toplevel/genprintval.cmo \
+ toplevel/topcommon.cmo \
+ toplevel/byte/topeval.cmo \
+ toplevel/byte/trace.cmo \
+ toplevel/toploop.cmo \
+ toplevel/topdirs.cmo \
+ toplevel/byte/topmain.cmo
+TOPLEVEL_CMI = \
+ toplevel/topcommon.cmi \
+ toplevel/byte/topeval.cmi \
+ toplevel/byte/trace.cmi \
+ toplevel/toploop.cmi \
+ toplevel/topdirs.cmi \
+ toplevel/byte/topmain.cmi
+
+OPTTOPLEVEL = \
+ toplevel/genprintval.cmo \
+ toplevel/topcommon.cmo \
+ toplevel/native/topeval.cmo \
+ toplevel/native/trace.cmo \
+ toplevel/toploop.cmo \
+ toplevel/topdirs.cmo \
+ toplevel/native/topmain.cmo
+OPTTOPLEVEL_CMI = \
+ toplevel/topcommon.cmi \
+ toplevel/native/topeval.cmi \
+ toplevel/native/trace.cmi \
+ toplevel/toploop.cmi \
+ toplevel/topdirs.cmi \
+ toplevel/native/topmain.cmi
+
+TOPLEVEL_SHARED_MLIS = topeval.mli trace.mli topmain.mli
+TOPLEVEL_SHARED_CMIS = $(TOPLEVEL_SHARED_MLIS:%.mli=%.cmi)
+TOPLEVEL_SHARED_ARTEFACTS = $(TOPLEVEL_SHARED_MLIS) $(TOPLEVEL_SHARED_CMIS)
+
+$(addprefix toplevel/byte/, $(TOPLEVEL_SHARED_CMIS)):\
+toplevel/byte/%.cmi: toplevel/%.cmi
+ cp $< toplevel/$*.mli $(@D)
+
+$(addprefix toplevel/native/, $(TOPLEVEL_SHARED_CMIS)):\
+toplevel/native/%.cmi: toplevel/%.cmi
+ cp $< toplevel/$*.mli $(@D)
+
+beforedepend::
+ cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) byte/
+ cd toplevel ; cp $(TOPLEVEL_SHARED_MLIS) native/
+partialclean::
+ cd toplevel/byte ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS)
+ cd toplevel/native ; rm -f $(TOPLEVEL_SHARED_ARTEFACTS)
$(COMMON:.cmo=.cmx) $(BYTECOMP:.cmo=.cmx) $(OPTCOMP:.cmo=.cmx): ocamlopt$(EXE)
$(OPTTOPLEVEL:.cmo=.cmx): ocamlopt$(EXE)
compilerlibs/ocamltoplevel.cma: $(TOPLEVEL_CMI) $(TOPLEVEL)
- $(CAMLC) -a -o $@ $(TOPLEVEL)
+ $(CAMLC) -a -o $@ -I toplevel/byte $(TOPLEVEL)
partialclean::
rm -f compilerlibs/ocamltoplevel.cma
-compilerlibs/ocamlopttoplevel.cmxa: $(OPTTOPLEVEL_CMI) $(OPTTOPLEVEL:.cmo=.cmx)
- $(CAMLOPT) -a -o $@ $(OPTTOPLEVEL:.cmo=.cmx)
+compilerlibs/ocamltoplevel.cmxa: $(OPTTOPLEVEL_CMI) $(OPTTOPLEVEL:.cmo=.cmx)
+ $(CAMLOPT) -a -o $@ -I toplevel/native $(OPTTOPLEVEL:.cmo=.cmx)
partialclean::
- rm -f compilerlibs/ocamlopttoplevel.cmxa \
- compilerlibs/ocamlopttoplevel.a compilerlibs/ocamlopttoplevel.lib
+ rm -f compilerlibs/ocamltoplevel.cmxa \
+ compilerlibs/ocamltoplevel.a compilerlibs/ocamltoplevel.lib
fi
fi
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for OCaml 4.12.1.
+# Generated by GNU Autoconf 2.69 for OCaml 4.13.0.
#
# Report bugs to <caml-list@inria.fr>.
#
# Identity of this package.
PACKAGE_NAME='OCaml'
PACKAGE_TARNAME='ocaml'
-PACKAGE_VERSION='4.12.1'
-PACKAGE_STRING='OCaml 4.12.1'
+PACKAGE_VERSION='4.13.0'
+PACKAGE_STRING='OCaml 4.13.0'
PACKAGE_BUGREPORT='caml-list@inria.fr'
PACKAGE_URL='http://www.ocaml.org'
PTHREAD_CC
ax_pthread_config
rlwrap
-SYSTEM_AS
DIRECT_LD
INSTALL_DATA
INSTALL_SCRIPT
INSTALL_PROGRAM
+flexlink
ac_ct_DEP_CC
DEP_CC
CPP
function_sections
flat_float_array
windows_unicode
+cmm_invariants
flambda_invariants
flambda
frame_pointers
AS
endianness
ASPP
-x_libraries
-x_includes
-pthread_link
ocamltest
+documentation_tool_cmd
+documentation_tool
ocamldoc
with_camltex
with_debugger
cc_has_debug_prefix_map
otherlibraries
has_monotonic_clock
+instrumented_runtime_libs
instrumented_runtime
debug_runtime
cmxs
AR
shebangscripts
long_shebang
-iflexdir
+bootstrapping_flexdll
+flexdir
ocamlc_cppflags
ocamlc_cflags
nativecclibs
enable_unix_lib
enable_bigarray_lib
enable_ocamldoc
+with_odoc
enable_ocamltest
enable_frame_pointers
enable_naked_pointers
enable_naked_pointers_checker
enable_spacetime
enable_cfi
+enable_imprecise_c99_float_ops
enable_installing_source_artifacts
enable_installing_bytecode_programs
enable_native_compiler
enable_flambda
enable_flambda_invariants
+enable_cmm_invariants
with_target_bindir
enable_reserved_header_bits
enable_stdlib_manpages
enable_flat_float_array
enable_function_sections
with_afl
+with_flexdll
enable_shared
enable_static
with_pic
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures OCaml 4.12.1 to adapt to many kinds of systems.
+\`configure' configures OCaml 4.13.0 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of OCaml 4.12.1:";;
+ short | recursive ) echo "Configuration of OCaml 4.13.0:";;
esac
cat <<\_ACEOF
--enable-naked-pointers-checker
enable the naked pointers checker
--disable-cfi disable the CFI directives in assembly files
+ --enable-imprecise-c99-float-ops
+ enables potentially imprecise replacement
+ implementations of C99 float ops if unavailable on
+ this platform
--enable-installing-source-artifacts
install *.cmt* and *.mli files
--enable-installing-bytecode-programs
--enable-flambda enable flambda optimizations
--enable-flambda-invariants
enable invariants checks in flambda
+ --enable-cmm-invariants enable invariants checks in Cmm
--enable-reserved-header-bits=BITS
reserve BITS (between 0 and 31) bits in block
headers for profiling info
Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --with-odoc build documentation with odoc
--with-target-bindir location of binary programs on target system
--with-afl use the AFL fuzzer
+ --with-flexdll bootstrap FlexDLL from the given sources
--with-pic[=PKGS] try to use only PIC/non-PIC objects [default=use
both]
--with-aix-soname=aix|svr4|both
--with-gnu-ld assume the C compiler uses GNU ld [default=no]
--with-sysroot[=DIR] Search for dependent libraries within DIR (or the
compiler's sysroot if not specified).
+ --with-odoc
Some influential environment variables:
AS which assembler to use
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-OCaml configure 4.12.1
+OCaml configure 4.13.0
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by OCaml $as_me 4.12.1, which was
+It was created by OCaml $as_me 4.13.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
-{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.12.1" >&5
-$as_echo "$as_me: Configuring OCaml version 4.12.1" >&6;}
+{ $as_echo "$as_me:${as_lineno-$LINENO}: Configuring OCaml version 4.13.0" >&5
+$as_echo "$as_me: Configuring OCaml version 4.13.0" >&6;}
# Configuration variables
libraries_man_section=3
# Command to build executalbes
-# In general this command is supposed to use the CFLAGs-related variables
-# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
-# account on Windows, because flexlink, which is used to build
-# executables on this platform, can not handle them.
-mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
+# In general this command is supposed to use the CFLAGs- and LDFLAGS-
+# related variables (OC_CFLAGS and OC_LDFLAGS for ocaml-specific
+# flags, CFLAGS and LDFLAGS for generic flags chosen by the user), but
+# at the moment they are not taken into account on Windows, because
+# flexlink, which is used to build executables on this platform, can
+# not handle them.
+mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS) \$(LDFLAGS)"
# Flags for building executable files with debugging symbols
mkexedebugflag="-g"
oc_dll_ldflags=""
with_sharedlibs=true
ostype="Unix"
-iflexdir=""
SO="so"
toolchain="cc"
profinfo=false
profinfo_width=0
extralibs=
instrumented_runtime=false
-instrumented_runtime_ldlibs=""
+instrumented_runtime_libs=""
+bootstrapping_flexdll=false
# Information about the package
-VERSION=4.12.1
+VERSION=4.13.0
# Note: This is present for the flexdll bootstrap where it exposed as the old
+
+
fi
+
+# Check whether --with-odoc was given.
+if test "${with_odoc+set}" = set; then :
+ withval=$with_odoc;
+fi
+
+
+
# Check whether --enable-ocamltest was given.
if test "${enable_ocamltest+set}" = set; then :
enableval=$enable_ocamltest;
fi
+# Check whether --enable-imprecise-c99-float-ops was given.
+if test "${enable_imprecise_c99_float_ops+set}" = set; then :
+ enableval=$enable_imprecise_c99_float_ops;
+fi
+
+
# Check whether --enable-installing-source-artifacts was given.
if test "${enable_installing_source_artifacts+set}" = set; then :
enableval=$enable_installing_source_artifacts;
fi
+# Check whether --enable-cmm-invariants was given.
+if test "${enable_cmm_invariants+set}" = set; then :
+ enableval=$enable_cmm_invariants;
+fi
+
+
# Check whether --with-target-bindir was given.
if test "${with_target_bindir+set}" = set; then :
fi
+
+# Check whether --with-flexdll was given.
+if test "${with_flexdll+set}" = set; then :
+ withval=$with_flexdll; if test x"$withval" = 'xyes'; then :
+ with_flexdll=flexdll
+fi
+fi
+
+
if test x"$enable_unix_lib" = "xno"; then :
if test x"$enable_debugger" = "xyes"; then :
as_fn_error $? "replay debugger requires the unix library" "$LINENO" 5
if ${ocaml_cv_cc_vendor+:} false; then :
$as_echo_n "(cached) " >&6
else
- ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-'`
+ ocaml_cv_cc_vendor=`grep '^[a-z]' conftest.i | tr -s ' ' '-' \
+ | tr -d '\r'`
fi
else
$as_echo "$ocaml_cv_cc_vendor" >&6; }
+## In cross-compilation mode, can we run executables produced?
+# At the moment, it's required, but the fact is used in C99 function detection
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether host executables can be run in the build" >&5
+$as_echo_n "checking whether host executables can be run in the build... " >&6; }
+ old_cross_compiling="$cross_compiling"
+ cross_compiling='no'
+ if test "$cross_compiling" = yes; then :
+ # autoconf displays a warning if this parameter is missing, but
+ # cross-compilation mode was disabled above.
+ assert=false
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int main (void) {return 0;}
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ host_runnable=true
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ host_runnable=false
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ cross_compiling="$old_cross_compiling"
+
+
# Determine how to call the C preprocessor directly.
# Most of the time, calling the C preprocessor through the C compiler is
# desirable and even important.
cc_warnings='-Wall -Wdeclaration-after-statement' ;;
esac
-case $enable_warn_error,4.12.1 in #(
+case $enable_warn_error,4.13.0 in #(
yes,*|,*+dev*) :
cc_warnings="$cc_warnings $warn_error_flag" ;; #(
*) :
if test x"$enable_shared" = "xno"; then :
with_sharedlibs=false
-fi
-
-case $CC,$host in #(
- *,*-*-darwin*) :
- mkexe="$mkexe -Wl,-no_compact_unwind";
- $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
- ;; #(
- *,*-*-haiku*) :
- mathlib="" ;; #(
- *,*-*-cygwin*) :
- case $target in #(
- i686-*) :
- flavor=cygwin ;; #(
- x86_64-*) :
- flavor=cygwin64 ;; #(
- *) :
- as_fn_error $? "unknown cygwin variant" "$LINENO" 5 ;;
-esac
- common_cppflags="$common_cppflags -U_WIN32"
- if $with_sharedlibs; then :
- flexlink="flexlink -chain $flavor -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- if test -z "$flexdir"; then :
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexlink not found: native shared libraries won't be available.
- " >&5
-$as_echo "$as_me: WARNING: flexlink not found: native shared libraries won't be available.
- " >&2;}
- with_sharedlibs=false
-else
- iflexdir="-I\"$flexdir\""
- mkexe="$flexlink -exe"
- mkexedebugflag="-link -g"
-
-fi
-
-fi
- if ! $with_sharedlibs; then :
- mkexe="$mkexe -Wl,--stack,16777216"
- oc_ldflags="-Wl,--stack,16777216"
-
-fi
- ostype="Cygwin" ;; #(
- *,*-*-mingw32) :
- if $with_sharedlibs; then :
case $host in #(
- i686-*-*) :
- flexdll_chain="mingw"; oc_dll_ldflags="-static-libgcc" ;; #(
- x86_64-*-*) :
- flexdll_chain="mingw64" ;; #(
+ *-pc-windows|*-w64-mingw32) :
+ as_fn_error $? "Cannot build native Win32 with --disable-shared" "$LINENO" 5 ;; #(
*) :
;;
esac
- flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- if test -z "$flexdir"; then :
- flexdir='$(ROOTDIR)/flexdll'
-fi
- iflexdir="-I\"$flexdir\""
- mkexedebugflag="-link -g"
fi
- ostype="Win32"
- toolchain="mingw"
- mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
- oc_ldflags='-municode'
- SO="dll" ;; #(
- *,*-pc-windows) :
- toolchain=msvc
- ostype="Win32"
- mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
- oc_ldflags='/ENTRY:wmainCRTStartup'
- case $host in #(
+
+# Define flexlink chain and flags correctly for the different Windows ports
+case $host in #(
+ i686-*-cygwin) :
+ flexdll_chain='cygwin'
+ flexlink_flags="-chain $flexdll_chain -merge-manifest -stack 16777216" ;; #(
+ x86_64-*-cygwin) :
+ flexdll_chain='cygwin64'
+ flexlink_flags="-chain $flexdll_chain -merge-manifest -stack 16777216" ;; #(
+ *-*-cygwin*) :
+ as_fn_error $? "unknown cygwin variant" "$LINENO" 5 ;; #(
+ i686-w64-mingw32) :
+ flexdll_chain='mingw'
+ flexlink_flags="-chain $flexdll_chain -stack 16777216" ;; #(
+ x86_64-w64-mingw32) :
+ flexdll_chain='mingw64'
+ flexlink_flags="-chain $flexdll_chain -stack 33554432" ;; #(
i686-pc-windows) :
- flexdll_chain=msvc ;; #(
+ flexdll_chain='msvc'
+ flexlink_flags="-merge-manifest -stack 16777216" ;; #(
x86_64-pc-windows) :
- flexdll_chain=msvc64 ;; #(
+ flexdll_chain='msvc64'
+ flexlink_flags="-x64 -merge-manifest -stack 33554432" ;; #(
*) :
;;
esac
- if $with_sharedlibs; then :
- flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- if test -z "$flexdir"; then :
- flexdir='$(ROOTDIR)/flexdll'
+
+if test x"$enable_shared" != 'xno'; then :
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for flexdll sources" >&5
+$as_echo_n "checking for flexdll sources... " >&6; }
+ if test x"$with_flexdll" = "xno"; then :
+ flexdir=''
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: disabled" >&5
+$as_echo "disabled" >&6; }
+else
+ flexmsg=''
+ case $target in #(
+ *-*-cygwin*|*-w64-mingw32|*-pc-windows) :
+ if test x"$with_flexdll" = 'x' -o x"$with_flexdll" = 'xflexdll'; then :
+ if test -f 'flexdll/flexdll.h'; then :
+ flexdir=flexdll
+ iflexdir='$(ROOTDIR)/flexdll'
+ with_flexdll="$iflexdir"
+else
+ if test x"$with_flexdll" != 'x'; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not available" >&5
+$as_echo "requested but not available" >&6; }
+ as_fn_error $? "exiting" "$LINENO" 5
+fi
+fi
+else
+ rm -rf flexdll-sources
+ if test -f "$with_flexdll/flexdll.h"; then :
+ mkdir -p flexdll-sources
+ cp -r "$with_flexdll"/* flexdll-sources/
+ flexdir='flexdll-sources'
+ iflexdir='$(ROOTDIR)/flexdll-sources'
+ flexmsg=" (from $with_flexdll)"
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not available" >&5
+$as_echo "requested but not available" >&6; }
+ as_fn_error $? "exiting" "$LINENO" 5
fi
- iflexdir="-I\"$flexdir\""
- mkexedebugflag=''
+fi
+ if test x"$flexdir" = 'x'; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $iflexdir$flexmsg" >&5
+$as_echo "$iflexdir$flexmsg" >&6; }
+ bootstrapping_flexdll=true
+ # The submodule should be searched *before* any other -I paths
+ internal_cppflags="-I $iflexdir $internal_cppflags"
fi ;; #(
- *,x86_64-*-linux*) :
- $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
- ;; #(
- xlc*,powerpc-ibm-aix*) :
- mkexe="$mkexe "
- oc_ldflags="-brtl -bexpfull"
- $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
- ;; #(
- gcc*,powerpc-*-linux*) :
- oc_ldflags="-mbss-plt" ;; #(
*) :
- ;;
+ if test x"$with_flexdll" != 'x'; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: requested but not supported" >&5
+$as_echo "requested but not supported" >&6; }
+ as_fn_error $? "exiting" "$LINENO" 5
+fi ;;
esac
+fi
-
-## Program to use to install files
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AmigaOS /C/install, which installs bootblocks on floppy discs
-# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# OS/2's system install, which has a completely different semantic
-# ./install, which can be erroneously created by make from ./install.sh.
-# Reject install programs that cannot install multiple files.
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
-$as_echo_n "checking for a BSD-compatible install... " >&6; }
-if test -z "$INSTALL"; then
-if ${ac_cv_path_install+:} false; then :
+ # Extract the first word of "flexlink", so it can be a program name with args.
+set dummy flexlink; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_flexlink+:} false; then :
$as_echo_n "(cached) " >&6
else
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+ if test -n "$flexlink"; then
+ ac_cv_prog_flexlink="$flexlink" # Let the user override the test.
+else
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- # Account for people who put trailing slashes in PATH elements.
-case $as_dir/ in #((
- ./ | .// | /[cC]/* | \
- /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
- ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
- /usr/ucb/* ) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- # Don't use installbsd from OSF since it installs stuff as root
- # by default.
- for ac_prog in ginstall scoinst install; do
- for ac_exec_ext in '' $ac_executable_extensions; do
- if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
- if test $ac_prog = install &&
- grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- :
- elif test $ac_prog = install &&
- grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
- # program-specific install script used by HP pwplus--don't use.
- :
- else
- rm -rf conftest.one conftest.two conftest.dir
- echo one > conftest.one
- echo two > conftest.two
- mkdir conftest.dir
- if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
- test -s conftest.one && test -s conftest.two &&
- test -s conftest.dir/conftest.one &&
- test -s conftest.dir/conftest.two
- then
- ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
- break 3
- fi
- fi
- fi
- done
- done
- ;;
-esac
-
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_flexlink="flexlink"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
done
IFS=$as_save_IFS
-rm -rf conftest.one conftest.two conftest.dir
-
fi
- if test "${ac_cv_path_install+set}" = set; then
- INSTALL=$ac_cv_path_install
- else
- # As a last resort, use the slow shell script. Don't cache a
- # value for INSTALL within a source directory, because that will
- # break other packages using the cache if that directory is
- # removed, or if the value is a relative name.
- INSTALL=$ac_install_sh
- fi
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
-$as_echo "$INSTALL" >&6; }
+flexlink=$ac_cv_prog_flexlink
+if test -n "$flexlink"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $flexlink" >&5
+$as_echo "$flexlink" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+ if test -n "$flexlink" -a -z "$flexdir"; then :
-# Checks for libraries
-## Mathematical library
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5
-$as_echo_n "checking for cos in -lm... " >&6; }
-if ${ac_cv_lib_m_cos+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lm $LIBS"
-cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
+ saved_CC="$CC"
+ saved_CFLAGS="$CFLAGS"
+ saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
+ saved_ac_ext="$ac_ext"
+ saved_ac_compile="$ac_compile"
+ # Move the content of confdefs.h to another file so it does not
+ # get included
+ mv confdefs.h confdefs.h.bak
+ touch confdefs.h
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char cos ();
-int
-main ()
-{
-return cos ();
- ;
- return 0;
-}
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $flexlink works" >&5
+$as_echo_n "checking whether $flexlink works... " >&6; }
+
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int answer = 42;
_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_cv_lib_m_cos=yes
-else
+if ac_fn_c_try_compile "$LINENO"; then :
+ # Create conftest1.$ac_objext as a symlink on Cygwin to ensure that native
+ # flexlink can cope. The reverse test is unnecessary (a Cygwin-compiled
+ # flexlink can read anything).
+ mv conftest.$ac_objext conftest1.$ac_objext
+ case $host in #(
+ *-pc-cygwin) :
+ ln -s conftest1.$ac_objext conftest2.$ac_objext ;; #(
+ *) :
+ cp conftest1.$ac_objext conftest2.$ac_objext ;;
+esac
+
+ CC="$flexlink -chain $flexdll_chain -exe"
+ LIBS="conftest2.$ac_objext"
+ CPPFLAGS="$internal_cppflags $CPPFLAGS"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int main() { return 0; }
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ as_fn_error $? "$flexlink does not work" "$LINENO" 5
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unexpected compile error" >&5
+$as_echo "unexpected compile error" >&6; }
+ as_fn_error $? "error calling the C compiler" "$LINENO" 5
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+
+
+ # Restore the content of confdefs.h
+ mv confdefs.h.bak confdefs.h
+ ac_compile="$saved_ac_compile"
+ ac_ext="$saved_ac_ext"
+ CPPFLAGS="$saved_CPPFLAGS"
+ CFLAGS="$saved_CFLAGS"
+ CC="$saved_CC"
+ LIBS="$saved_LIBS"
+
+
+
+ case $host in #(
+ *-w64-mingw32|*-pc-windows) :
+ flexlink_where="$(cmd /c "$flexlink" -where 2>/dev/null)"
+ if test -z "$flexlink_where"; then :
+ as_fn_error $? "$flexlink is not executable from a native Win32 process" "$LINENO" 5
+
+fi ;; #(
+ *) :
+ ;;
+esac
+
+fi
+
+
+
+ saved_CC="$CC"
+ saved_CFLAGS="$CFLAGS"
+ saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
+ saved_ac_ext="$ac_ext"
+ saved_ac_compile="$ac_compile"
+ # Move the content of confdefs.h to another file so it does not
+ # get included
+ mv confdefs.h confdefs.h.bak
+ touch confdefs.h
+
+
+ if test -n "$flexdir"; then :
+ CPPFLAGS="-I $flexdir $CPPFLAGS"
+fi
+ have_flexdll_h=no
+ ac_fn_c_check_header_mongrel "$LINENO" "flexdll.h" "ac_cv_header_flexdll_h" "$ac_includes_default"
+if test "x$ac_cv_header_flexdll_h" = xyes; then :
+ have_flexdll_h=yes
+else
+ have_flexdll_h=no
+fi
+
+
+ if test x"$have_flexdll_h" = 'xno'; then :
+ if test -n "$flexdir"; then :
+ as_fn_error $? "$flexdir/flexdll.h appears unusable" "$LINENO" 5
+fi
+fi
+
+
+ # Restore the content of confdefs.h
+ mv confdefs.h.bak confdefs.h
+ ac_compile="$saved_ac_compile"
+ ac_ext="$saved_ac_ext"
+ CPPFLAGS="$saved_CPPFLAGS"
+ CFLAGS="$saved_CFLAGS"
+ CC="$saved_CC"
+ LIBS="$saved_LIBS"
+
+
+
+ if test -n "$flexlink" -a x"$have_flexdll_h" = 'xno'; then :
+
+
+ saved_CC="$CC"
+ saved_CFLAGS="$CFLAGS"
+ saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
+ saved_ac_ext="$ac_ext"
+ saved_ac_compile="$ac_compile"
+ # Move the content of confdefs.h to another file so it does not
+ # get included
+ mv confdefs.h confdefs.h.bak
+ touch confdefs.h
+
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if \"$flexlink -where\" includes flexdll.h" >&5
+$as_echo_n "checking if \"$flexlink -where\" includes flexdll.h... " >&6; }
+ flexlink_where="$($flexlink -where | tr -d '\r')"
+ CPPFLAGS="$CPPFLAGS -I \"$flexlink_where\""
+ cat > conftest.c <<"EOF"
+#include <flexdll.h>
+int main (void) {return 0;}
+EOF
+ cat > conftest.Makefile <<EOF
+all:
+ $CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.c $LIBS
+EOF
+ if make -f conftest.Makefile >/dev/null 2>/dev/null; then :
+ have_flexdll_h=yes
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+ # Restore the content of confdefs.h
+ mv confdefs.h.bak confdefs.h
+ ac_compile="$saved_ac_compile"
+ ac_ext="$saved_ac_ext"
+ CPPFLAGS="$saved_CPPFLAGS"
+ CFLAGS="$saved_CFLAGS"
+ CC="$saved_CC"
+ LIBS="$saved_LIBS"
+
+
+ if test "x$have_flexdll_h" = 'xyes'; then :
+ internal_cppflags="$internal_cppflags -I \"$flexlink_where\""
+fi
+
+fi
+
+fi
+
+if test x"$have_flexdll_h" = 'xno'; then :
+ case $host in #(
+ *-*-cygwin*) :
+ if $with_sharedlibs; then :
+ with_sharedlibs=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexdll.h not found: shared library support disabled." >&5
+$as_echo "$as_me: WARNING: flexdll.h not found: shared library support disabled." >&2;}
+
+fi ;; #(
+ *-w64-mingw32|*-pc-windows) :
+ as_fn_error $? "flexdll.h is required for native Win32" "$LINENO" 5 ;; #(
+ *) :
+ ;;
+esac
+fi
+
+if test -z "$flexdir" -o x"$have_flexdll_h" = 'xno'; then :
+ case $host in #(
+ *-*-cygwin*) :
+ if $with_sharedlibs; then :
+ if test -z "$flexlink"; then :
+ with_sharedlibs=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: flexlink/flexdll.h not found: shared library support disabled." >&5
+$as_echo "$as_me: WARNING: flexlink/flexdll.h not found: shared library support disabled." >&2;}
+
+fi
+fi ;; #(
+ *-w64-mingw32|*-pc-windows) :
+ if test -z "$flexlink"; then :
+ as_fn_error $? "flexlink is required for native Win32" "$LINENO" 5
+fi ;; #(
+ *) :
+ ;;
+esac
+fi
+
+case $CC,$host in #(
+ *,*-*-darwin*) :
+ mkexe="$mkexe -Wl,-no_compact_unwind";
+ $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+ *,*-*-haiku*) :
+ mathlib="" ;; #(
+ *,*-*-cygwin*) :
+ common_cppflags="$common_cppflags -U_WIN32"
+ if $with_sharedlibs; then :
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexedebugflag="-link -g"
+else
+ mkexe="$mkexe -Wl,--stack,16777216"
+ oc_ldflags="-Wl,--stack,16777216"
+
+fi
+ ostype="Cygwin" ;; #(
+ *,*-*-mingw32) :
+ case $host in #(
+ i686-*-*) :
+ oc_dll_ldflags="-static-libgcc" ;; #(
+ *) :
+ ;;
+esac
+ mkexedebugflag="-link -g"
+ ostype="Win32"
+ toolchain="mingw"
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ oc_ldflags='-municode'
+ SO="dll" ;; #(
+ *,*-pc-windows) :
+ toolchain=msvc
+ ostype="Win32"
+ mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ oc_ldflags='/ENTRY:wmainCRTStartup'
+ mkexedebugflag='' ;; #(
+ *,x86_64-*-linux*) :
+ $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+ xlc*,powerpc-ibm-aix*) :
+ mkexe="$mkexe "
+ oc_ldflags="-brtl -bexpfull"
+ $as_echo "#define HAS_ARCH_CODE32 1" >>confdefs.h
+ ;; #(
+ gcc*,powerpc-*-linux*) :
+ oc_ldflags="-mbss-plt" ;; #(
+ *) :
+ ;;
+esac
+
+
+## Program to use to install files
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AmigaOS /C/install, which installs bootblocks on floppy discs
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# OS/2's system install, which has a completely different semantic
+# ./install, which can be erroneously created by make from ./install.sh.
+# Reject install programs that cannot install multiple files.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5
+$as_echo_n "checking for a BSD-compatible install... " >&6; }
+if test -z "$INSTALL"; then
+if ${ac_cv_path_install+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ # Account for people who put trailing slashes in PATH elements.
+case $as_dir/ in #((
+ ./ | .// | /[cC]/* | \
+ /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \
+ ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \
+ /usr/ucb/* ) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
+ if test $ac_prog = install &&
+ grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ elif test $ac_prog = install &&
+ grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
+ # program-specific install script used by HP pwplus--don't use.
+ :
+ else
+ rm -rf conftest.one conftest.two conftest.dir
+ echo one > conftest.one
+ echo two > conftest.two
+ mkdir conftest.dir
+ if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" &&
+ test -s conftest.one && test -s conftest.two &&
+ test -s conftest.dir/conftest.one &&
+ test -s conftest.dir/conftest.two
+ then
+ ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c"
+ break 3
+ fi
+ fi
+ fi
+ done
+ done
+ ;;
+esac
+
+ done
+IFS=$as_save_IFS
+
+rm -rf conftest.one conftest.two conftest.dir
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL=$ac_cv_path_install
+ else
+ # As a last resort, use the slow shell script. Don't cache a
+ # value for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the value is a relative name.
+ INSTALL=$ac_install_sh
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5
+$as_echo "$INSTALL" >&6; }
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# Checks for libraries
+
+## Mathematical library
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for cos in -lm" >&5
+$as_echo_n "checking for cos in -lm... " >&6; }
+if ${ac_cv_lib_m_cos+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lm $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char cos ();
+int
+main ()
+{
+return cos ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_m_cos=yes
+else
ac_cv_lib_m_cos=no
fi
rm -f core conftest.err conftest.$ac_objext \
if test x"$enable_shared" != "xno"; then :
case $host in #(
*-apple-darwin*) :
- mksharedlib="$CC -shared -flat_namespace -undefined suppress \
- -Wl,-no_compact_unwind"
+ mksharedlib="$CC -shared \
+ -flat_namespace -undefined suppress -Wl,-no_compact_unwind \
+ \$(LDFLAGS)"
shared_libraries_supported=true ;; #(
*-*-mingw32) :
mksharedlib='$(FLEXLINK)'
mkmaindll='$(FLEXLINK) -maindll'
shared_libraries_supported=$with_sharedlibs ;; #(
*-*-cygwin*) :
- mksharedlib="$flexlink"
- mkmaindll="$flexlink -maindll"
- shared_libraries_supported=true ;; #(
+ mksharedlib='$(FLEXLINK)'
+ mkmaindll='$(FLEXLINK) -maindll'
+ shared_libraries_supported=$with_sharedlibs ;; #(
powerpc-ibm-aix*) :
case $ocaml_cv_cc_vendor in #(
xlc*) :
- mksharedlib="$CC -qmkshrobj -G"
+ mksharedlib="$CC -qmkshrobj -G \$(LDFLAGS)"
shared_libraries_supported=true ;; #(
*) :
;;
sharedlib_cflags="-fPIC"
case $CC,$host in #(
gcc*,powerpc-*-linux*) :
- mksharedlib="$CC -shared -mbss-plt" ;; #(
+ mksharedlib="$CC -shared -mbss-plt \$(LDFLAGS)" ;; #(
*) :
- mksharedlib="$CC -shared" ;;
+ mksharedlib="$CC -shared \$(LDFLAGS)" ;;
esac
oc_ldflags="$oc_ldflags -Wl,-E"
rpath="-Wl,-rpath,"
natdynlink=false
-if test x"$enable_shared" != "xno"; then :
+if test x"$shared_libraries_supported" = 'xtrue'; then :
case "$host" in #(
*-*-cygwin*) :
natdynlink=true ;; #(
fi; system=elf ;; #(
s390x*-*-linux*) :
arch=s390x; model=z10; system=elf ;; #(
- armv6*-*-linux-gnueabihf) :
+ # expected to match "gnueabihf" as well as "musleabihf"
+ armv6*-*-linux-*eabihf) :
arch=arm; model=armv6; system=linux_eabihf ;; #(
- armv7*-*-linux-gnueabihf) :
+ armv7*-*-linux-*eabihf) :
arch=arm; model=armv7; system=linux_eabihf ;; #(
- armv8*-*-linux-gnueabihf) :
+ armv8*-*-linux-*eabihf) :
arch=arm; model=armv8; system=linux_eabihf ;; #(
- armv8*-*-linux-gnueabi) :
+ armv8*-*-linux-*eabi) :
arch=arm; model=armv8; system=linux_eabi ;; #(
- armv7*-*-linux-gnueabi) :
+ armv7*-*-linux-*eabi) :
arch=arm; model=armv7; system=linux_eabi ;; #(
- armv6t2*-*-linux-gnueabi) :
+ armv6t2*-*-linux-*eabi) :
arch=arm; model=armv6t2; system=linux_eabi ;; #(
- armv6*-*-linux-gnueabi) :
+ armv6*-*-linux-*eabi) :
arch=arm; model=armv6; system=linux_eabi ;; #(
armv6*-*-freebsd*) :
arch=arm; model=armv6; system=freebsd ;; #(
arch=arm; model=armv6; system=netbsd ;; #(
earmv7*-*-netbsd*) :
arch=arm; model=armv7; system=netbsd ;; #(
- armv5te*-*-linux-gnueabi) :
+ armv5te*-*-linux-*eabi) :
arch=arm; model=armv5te; system=linux_eabi ;; #(
- armv5*-*-linux-gnueabi) :
+ armv5*-*-linux-*eabi) :
arch=arm; model=armv5; system=linux_eabi ;; #(
- arm*-*-linux-gnueabihf) :
+ arm*-*-linux-*eabihf) :
arch=arm; system=linux_eabihf ;; #(
- arm*-*-linux-gnueabi) :
+ arm*-*-linux-*eabi) :
arch=arm; system=linux_eabi ;; #(
arm*-*-openbsd*) :
arch=arm; system=bsd ;; #(
;; #(
*) :
case $host in #(
- *-linux-musl) :
+ # expected to match "*-linux-musl" as well as "*-linux-musleabi*"
+ *-linux-musl*) :
# Alpine and other musl-based Linux distributions
common_cflags="-no-pie $common_cflags" ;; #(
*) :
# Assembler
-if test -n "$host_alias"; then :
+if test -n "$target_alias"; then :
+ toolpref="${target_alias}-"
+ as_target="$target"
+ as_cpu="$target_cpu"
+else
+ if test -n "$host_alias"; then :
toolpref="${host_alias}-"
+ as_target="$host"
+ as_cpu="$host_cpu"
else
toolpref=""
+ as_target="$build"
+ as_cpu="$build_cpu"
fi
-
-# We first compute default values for as and aspp
-# If values have been given by the user then they take precedence over
-# those just computed
-# One may want to check whether the user provided values first
-# and only compute values if none has been provided
-
-if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
-set dummy ${ac_tool_prefix}as; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_prog_SYSTEM_AS+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if test -n "$SYSTEM_AS"; then
- ac_cv_prog_SYSTEM_AS="$SYSTEM_AS" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_SYSTEM_AS="${ac_tool_prefix}as"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
-fi
-fi
-SYSTEM_AS=$ac_cv_prog_SYSTEM_AS
-if test -n "$SYSTEM_AS"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $SYSTEM_AS" >&5
-$as_echo "$SYSTEM_AS" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
fi
+# Finding the assembler
+# The OCaml build system distinguishes two different assemblers:
+# 1. AS, used to assemble the code generated by the ocamlopt native compiler
+# 2. ASPP, to assemble other assembly files that may require preprocessing
+# In general, "$CC -c" is used as a default value for both AS and ASPP.
+# On a few platforms (Windows) both values are overriden.
+# On other platforms, (Linux with GCC) the assembler AS is called directly
+# to avoiding forking a C compiler process for each compilation by ocamlopt.
+# Both AS and ASPP can be overriden by the user.
-fi
-if test -z "$ac_cv_prog_SYSTEM_AS"; then
- ac_ct_SYSTEM_AS=$SYSTEM_AS
- # Extract the first word of "as", so it can be a program name with args.
-set dummy as; ac_word=$2
-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
-$as_echo_n "checking for $ac_word... " >&6; }
-if ${ac_cv_prog_ac_ct_SYSTEM_AS+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- if test -n "$ac_ct_SYSTEM_AS"; then
- ac_cv_prog_ac_ct_SYSTEM_AS="$ac_ct_SYSTEM_AS" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_SYSTEM_AS="as"
- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
- done
-IFS=$as_save_IFS
-
-fi
-fi
-ac_ct_SYSTEM_AS=$ac_cv_prog_ac_ct_SYSTEM_AS
-if test -n "$ac_ct_SYSTEM_AS"; then
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_SYSTEM_AS" >&5
-$as_echo "$ac_ct_SYSTEM_AS" >&6; }
-else
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
-$as_echo "no" >&6; }
-fi
-
- if test "x$ac_ct_SYSTEM_AS" = x; then
- SYSTEM_AS=""
- else
- case $cross_compiling:$ac_tool_warned in
-yes:)
-{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
-$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
-ac_tool_warned=yes ;;
-esac
- SYSTEM_AS=$ac_ct_SYSTEM_AS
- fi
-else
- SYSTEM_AS="$ac_cv_prog_SYSTEM_AS"
-fi
+default_as="$CC -c"
+default_aspp="$CC -c"
-
-case "$arch,$system" in #(
- i386,win32) :
- default_as="ml -nologo -coff -Cp -c -Fo" ;; #(
- amd64,win64) :
- default_as="ml64 -nologo -Cp -c -Fo" ;; #(
- amd64,macosx) :
- case $ocaml_cv_cc_vendor in #(
- clang-*) :
- default_as='clang -arch x86_64 -Wno-trigraphs -c'
- default_aspp='clang -arch x86_64 -Wno-trigraphs -c' ;; #(
- *) :
- default_as="${toolpref}as -arch x86_64"
- default_aspp="${toolpref}gcc -arch x86_64 -c" ;;
-esac ;; #(
- amd64,solaris) :
- case $ocaml_cv_cc_vendor in #(
- sunc-*) :
- if test x"$SYSTEM_AS" = "x"; then :
- as_fn_error $? "GNU as assembler is required." "$LINENO" 5
-else
- default_as="${toolpref}as --64"
- default_aspp="${toolpref}cc -m64 -c"
-fi ;; #(
- gcc-*) :
- if test x"$SYSTEM_AS" = "x"; then :
- default_as="${toolpref}gcc -m64 -c"
- default_aspp="${toolpref}gcc -m64 -c"
-else
- default_as="${toolpref}as --64"
- default_aspp="${toolpref}gcc -m64 -c"
-fi ;; #(
+case $as_target,$ocaml_cv_cc_vendor in #(
+ *-*-linux*,gcc-*) :
+ case $as_cpu in #(
+ x86_64|arm*|aarch64*|i[3-6]86|riscv*) :
+ default_as="${toolpref}as" ;; #(
*) :
;;
esac ;; #(
- power,elf) :
- case $model in #(
- ppc64le) :
- default_as="${toolpref}as -a64 -mpower8"
- default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c" ;; #(
- ppc64) :
- default_as="${toolpref}as -a64 -mppc64"
- default_aspp="${toolpref}gcc -m64 -c" ;; #(
- ppc) :
- default_as="${toolpref}as -mppc"
- default_aspp="${toolpref}gcc -m32 -c" ;; #(
- *) :
- ;;
-esac ;; #(
- s390x,elf) :
- default_as="${toolpref}as -m 64 -march=$model"
- default_aspp="${toolpref}gcc -c -Wa,-march=$model" ;; #(
- *,freebsd) :
- default_as="${toolpref}cc -c -Wno-trigraphs"
- default_aspp="${toolpref}cc -c -Wno-trigraphs" ;; #(
- *,dragonfly) :
- default_as="${toolpref}as"
- default_aspp="${toolpref}cc -c" ;; #(
- amd64,*|arm,*|arm64,*|i386,*|riscv,*) :
- case $ocaml_cv_cc_vendor in #(
- clang-*) :
- default_as="${toolpref}clang -c -Wno-trigraphs"
- default_aspp="${toolpref}clang -c -Wno-trigraphs" ;; #(
- *) :
- default_as="${toolpref}as"
- default_aspp="${toolpref}gcc -c" ;;
-esac ;; #(
+ i686-pc-windows,*) :
+ default_as="ml -nologo -coff -Cp -c -Fo"
+ default_aspp="$default_as" ;; #(
+ x86_64-pc-windows,*) :
+ default_as="ml64 -nologo -Cp -c -Fo"
+ default_aspp="$default_as" ;; #(
+ *-*-darwin*,clang-*) :
+ default_as="$default_as -Wno-trigraphs"
+ default_aspp="$default_as" ;; #(
*) :
;;
esac
## Check for C99 float ops
-# Note: this was disabled on Windows but the autoconf-generated script
-# does find the function it is looking for.
-# however the fma test does not pass so we disable the feature
-# for the moment, to be backward-compatible
+has_c99_float_ops=true
+for ac_func in expm1 log1p hypot fma exp2 log2 cbrt acosh asinh atanh erf erfc trunc round copysign
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
-case $host in #(
- *-*-mingw32|*-pc-windows) :
- ;; #(
+else
+ has_c99_float_ops=false
+fi
+done
+
+
+if $has_c99_float_ops; then :
+ $as_echo "#define HAS_C99_FLOAT_OPS 1" >>confdefs.h
+
+ # Check whether round works (known bug in mingw-w64)
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether round works" >&5
+$as_echo_n "checking whether round works... " >&6; }
+
+ old_cross_compiling="$cross_compiling"
+ if test "x$host_runnable" = 'xtrue'; then :
+ cross_compiling='no'
+fi
+ if test "$cross_compiling" = yes; then :
+ case $target in #(
+ x86_64-w64-mingw32) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cross-compiling; assume not" >&5
+$as_echo "cross-compiling; assume not" >&6; } ;; #(
+ *) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cross-compiling; assume yes" >&5
+$as_echo "cross-compiling; assume yes" >&6; }
+ $as_echo "#define HAS_WORKING_ROUND 1" >>confdefs.h
+ ;;
+esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <math.h>
+int main (void) {
+ static volatile double d = 0.49999999999999994449;
+ return (fpclassify(round(d)) != FP_ZERO);
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ $as_echo "#define HAS_WORKING_ROUND 1" >>confdefs.h
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ case $enable_imprecise_c99_float_ops,$target in #(
+ no,*) :
+ hard_error=true ;; #(
+ yes,*) :
+ hard_error=false ;; #(
+ *,x86_64-w64-mingw32) :
+ hard_error=false ;; #(
+ *) :
+ hard_error=true ;;
+esac
+ if test x"$hard_error" = "xtrue"; then :
+ as_fn_error $? "round does not work, enable emulation with --enable-imprecise-c99-float-ops" "$LINENO" 5
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: round does not work; emulation enabled" >&5
+$as_echo "$as_me: WARNING: round does not work; emulation enabled" >&2;}
+fi
+fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
+fi
+
+ cross_compiling="$old_cross_compiling"
+
+
+ # Check whether fma works (regressed in mingw-w64 8.0.0; present, but broken,
+ # in VS2013-2017 and present but unimplemented in Cygwin64)
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether fma works" >&5
+$as_echo_n "checking whether fma works... " >&6; }
+
+ old_cross_compiling="$cross_compiling"
+ if test "x$host_runnable" = 'xtrue'; then :
+ cross_compiling='no'
+fi
+ if test "$cross_compiling" = yes; then :
+ case $target in #(
+ x86_64-w64-mingw32|x86_64-*-cygwin*) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cross-compiling; assume not" >&5
+$as_echo "cross-compiling; assume not" >&6; } ;; #(
+ *) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: cross-compiling; assume yes" >&5
+$as_echo "cross-compiling; assume yes" >&6; }
+ $as_echo "#define HAS_WORKING_FMA 1" >>confdefs.h
+ ;;
+esac
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+#include <math.h>
+int main (void) {
+ /* Tests 264-266 from testsuite/tests/fma/fma.ml. These tests trigger the
+ broken implementations of Cygwin64, mingw-w64 (x86_64) and VS2013-2017.
+ The static volatile variables aim to thwart GCC's constant folding. */
+ static volatile double x, y, z;
+ double t264, t265, t266;
+ x = 0x3.bd5b7dde5fddap-496;
+ y = 0x3.bd5b7dde5fddap-496;
+ z = -0xd.fc352bc352bap-992;
+ t264 = fma(x, y, z);
+ x = 0x3.bd5b7dde5fddap-504;
+ y = 0x3.bd5b7dde5fddap-504;
+ z = -0xd.fc352bc352bap-1008;
+ t265 = fma(x, y, z);
+ x = 0x8p-540;
+ y = 0x4p-540;
+ z = 0x4p-1076;
+ t266 = fma(x, y, z);
+ return (!(t264 == 0x1.0989687cp-1044 ||
+ t264 == 0x0.000004277ca1fp-1022 || /* Acceptable emulated values */
+ t264 == 0x0.00000428p-1022)
+ || !(t265 == 0x1.0988p-1060 ||
+ t265 == 0x0.0000000004278p-1022 || /* Acceptable emulated values */
+ t265 == 0x0.000000000428p-1022)
+ || !(t266 == 0x8p-1076));
+}
+
+_ACEOF
+if ac_fn_c_try_run "$LINENO"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ $as_echo "#define HAS_WORKING_FMA 1" >>confdefs.h
+
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+ case $enable_imprecise_c99_float_ops,$target in #(
+ no,*) :
+ hard_error=true ;; #(
+ yes,*) :
+ hard_error=false ;; #(
+ *,x86_64-w64-mingw32|*,x86_64-*-cygwin*) :
+ hard_error=false ;; #(
*) :
- has_c99_float_ops=true
- ac_fn_c_check_func "$LINENO" "expm1" "ac_cv_func_expm1"
-if test "x$ac_cv_func_expm1" = xyes; then :
-
+ case $ocaml_cv_cc_vendor in #(
+ msvc-*) :
+ if test "${ocaml_cv_cc_vendor#msvc-}" -lt 1920 ; then :
+ hard_error=false
else
- has_c99_float_ops=false
-fi
-
- if $has_c99_float_ops; then :
- ac_fn_c_check_func "$LINENO" "log1p" "ac_cv_func_log1p"
-if test "x$ac_cv_func_log1p" = xyes; then :
-
+ hard_error=true
+fi ;; #(
+ *) :
+ hard_error=true ;;
+esac ;;
+esac
+ if test x"$hard_error" = "xtrue"; then :
+ as_fn_error $? "fma does not work, enable emulation with --enable-imprecise-c99-float-ops" "$LINENO" 5
else
- has_c99_float_ops=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: fma does not work; emulation enabled" >&5
+$as_echo "$as_me: WARNING: fma does not work; emulation enabled" >&2;}
fi
-
fi
- if $has_c99_float_ops; then :
- ac_fn_c_check_func "$LINENO" "hypot" "ac_cv_func_hypot"
-if test "x$ac_cv_func_hypot" = xyes; then :
-
-else
- has_c99_float_ops=false
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-fi
- if $has_c99_float_ops; then :
- ac_fn_c_check_func "$LINENO" "fma" "ac_cv_func_fma"
-if test "x$ac_cv_func_fma" = xyes; then :
+ cross_compiling="$old_cross_compiling"
- case $target in #(
- x86_64-*-cygwin) :
- ;; #(
+
+else
+ if test x"$enable_imprecise_c99_float_ops" != "xyes" ; then :
+ case $enable_imprecise_c99_float_ops,$ocaml_cv_cc_vendor in #(
+ no,*) :
+ hard_error=true ;; #(
+ ,msvc-*) :
+ if test "${ocaml_cv_cc_vendor#msvc-}" -lt 1800 ; then :
+ hard_error=false
+else
+ hard_error=true
+fi ;; #(
*) :
- $as_echo "#define HAS_WORKING_FMA 1" >>confdefs.h
- ;;
+ hard_error=true ;;
esac
+ if test x"$hard_error" = 'xtrue'; then :
+ as_fn_error $? "C99 float ops unavailable, enable replacements with --enable-imprecise-c99-float-ops" "$LINENO" 5
else
- has_c99_float_ops=false
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: C99 float ops unavailable, replacements enabled (ancient Visual Studio)" >&5
+$as_echo "$as_me: WARNING: C99 float ops unavailable, replacements enabled (ancient Visual Studio)" >&2;}
fi
-
fi
- if $has_c99_float_ops; then :
- ac_fn_c_check_func "$LINENO" "copysign" "ac_cv_func_copysign"
-if test "x$ac_cv_func_copysign" = xyes; then :
- $as_echo "#define HAS_C99_FLOAT_OPS 1" >>confdefs.h
-
fi
-fi ;;
-esac
-
## getrusage
ac_fn_c_check_func "$LINENO" "getrusage" "ac_cv_func_getrusage"
if test "x$ac_cv_func_getrusage" = xyes; then :
instrumented_runtime=true
if test "x$ac_cv_search_clock_gettime" = "xnone required"; then :
- instrumented_runtime_ldlibs=""
+ instrumented_runtime_libs=""
else
- instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime
+ instrumented_runtime_libs=$ac_cv_search_clock_gettime
fi
;; #(
## TODO: check whether the different libraries are really useful
-sockets=false
+sockets=true
case $host in #(
*-*-mingw32|*-pc-windows) :
cclibs="$cclibs -lws2_32"
- sockets=true ;; #(
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing socket" >&5
+$as_echo_n "checking for library containing socket... " >&6; }
+if ${ac_cv_search_socket+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char socket ();
+int
+main ()
+{
+return socket ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' ws2_32; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_socket=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_socket+:} false; then :
+ break
+fi
+done
+if ${ac_cv_search_socket+:} false; then :
+
+else
+ ac_cv_search_socket=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_socket" >&5
+$as_echo "$ac_cv_search_socket" >&6; }
+ac_res=$ac_cv_search_socket
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
+
+fi
+ ;; #(
*-*-haiku) :
cclibs="$cclibs -lnetwork"
- sockets=true ;; #(
- *-*-solaris*) :
- cclibs="$cclibs -lsocket -lnsl"
- sockets=true ;; #(
- *) :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing socket" >&5
+$as_echo_n "checking for library containing socket... " >&6; }
+if ${ac_cv_search_socket+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
- ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket"
-if test "x$ac_cv_func_socket" = xyes; then :
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char socket ();
+int
+main ()
+{
+return socket ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' network; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_socket=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_socket+:} false; then :
+ break
+fi
+done
+if ${ac_cv_search_socket+:} false; then :
+else
+ ac_cv_search_socket=no
fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_socket" >&5
+$as_echo "$ac_cv_search_socket" >&6; }
+ac_res=$ac_cv_search_socket
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
- ac_fn_c_check_func "$LINENO" "socketpair" "ac_cv_func_socketpair"
-if test "x$ac_cv_func_socketpair" = xyes; then :
+fi
+ ;; #(
+ *-*-solaris*) :
+ cclibs="$cclibs -lsocket -lnsl"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing socket" >&5
+$as_echo_n "checking for library containing socket... " >&6; }
+if ${ac_cv_search_socket+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char socket ();
+int
+main ()
+{
+return socket ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' socket; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_socket=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_socket+:} false; then :
+ break
fi
+done
+if ${ac_cv_search_socket+:} false; then :
- ac_fn_c_check_func "$LINENO" "bind" "ac_cv_func_bind"
-if test "x$ac_cv_func_bind" = xyes; then :
+else
+ ac_cv_search_socket=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_socket" >&5
+$as_echo "$ac_cv_search_socket" >&6; }
+ac_res=$ac_cv_search_socket
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
fi
- ac_fn_c_check_func "$LINENO" "listen" "ac_cv_func_listen"
-if test "x$ac_cv_func_listen" = xyes; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing inet_ntop" >&5
+$as_echo_n "checking for library containing inet_ntop... " >&6; }
+if ${ac_cv_search_inet_ntop+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_func_search_save_LIBS=$LIBS
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char inet_ntop ();
+int
+main ()
+{
+return inet_ntop ();
+ ;
+ return 0;
+}
+_ACEOF
+for ac_lib in '' nsl; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
+ LIBS="-l$ac_lib $ac_func_search_save_LIBS"
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_inet_ntop=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_inet_ntop+:} false; then :
+ break
fi
+done
+if ${ac_cv_search_inet_ntop+:} false; then :
- ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept"
-if test "x$ac_cv_func_accept" = xyes; then :
+else
+ ac_cv_search_inet_ntop=no
+fi
+rm conftest.$ac_ext
+LIBS=$ac_func_search_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_inet_ntop" >&5
+$as_echo "$ac_cv_search_inet_ntop" >&6; }
+ac_res=$ac_cv_search_inet_ntop
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
fi
+ ;; #(
+ *) :
- ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"
-if test "x$ac_cv_func_connect" = xyes; then :
+ for ac_func in socket socketpair bind listen accept connect
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+else
+ sockets=false
fi
+done
- sockets=true
;;
esac
fi
-## socklen_t in sys/socket.h
+## socklen_t
-ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "#include <sys/socket.h>
+case $host in #(
+ *-*-mingw32|*-pc-windows) :
+ ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "#include <ws2tcpip.h>
"
if test "x$ac_cv_type_socklen_t" = xyes; then :
$as_echo "#define HAS_SOCKLEN_T 1" >>confdefs.h
fi
+ ;; #(
+ *) :
+ ac_fn_c_check_type "$LINENO" "socklen_t" "ac_cv_type_socklen_t" "#include <sys/socket.h>
+"
+if test "x$ac_cv_type_socklen_t" = xyes; then :
+ $as_echo "#define HAS_SOCKLEN_T 1" >>confdefs.h
+fi
+ ;;
+esac
ac_fn_c_check_func "$LINENO" "inet_aton" "ac_cv_func_inet_aton"
if test "x$ac_cv_func_inet_aton" = xyes; then :
ipv6=true
-ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" "
+case $host in #(
+ *-*-mingw32|*-pc-windows) :
+ ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" "#include <ws2tcpip.h>
+"
+if test "x$ac_cv_type_struct_sockaddr_in6" = xyes; then :
+
+else
+ ipv6=false
+fi
+ ;; #(
+ *) :
+ ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" "
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
ipv6=false
fi
+ ;;
+esac
if $ipv6; then :
ac_fn_c_check_func "$LINENO" "getaddrinfo" "ac_cv_func_getaddrinfo"
fi
+ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath"
+if test "x$ac_cv_func_realpath" = xyes; then :
+ $as_echo "#define HAS_REALPATH 1" >>confdefs.h
+
+fi
+
+
# wait
ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
if test "x$ac_cv_func_waitpid" = xyes; then :
## shared library support
if $shared_libraries_supported; then :
case $host in #(
- *-*-mingw32|*-pc-windows) :
+ *-*-mingw32|*-pc-windows|*-*-cygwin*) :
supports_shared_libraries=$shared_libraries_supported; DLLIBS="" ;; #(
*) :
ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen"
case $arch,$system in #(
i386,linux_elf|amd64,linux|amd64,macosx \
- |amd64,openbsd|i386,bsd_elf) :
+ |amd64,openbsd|i386,bsd_elf|arm64,linux|arm64,macosx) :
$as_echo "#define HAS_STACK_OVERFLOW_DETECTION 1" >>confdefs.h
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
# (e.g. DEC) have both -lpthread and -lpthreads, where one of the
# libraries is broken (non-POSIX).
-# Create a list of thread flags to try. Items starting with a "-" are
-# C compiler flags, and other items are library names, except for "none"
-# which indicates that we try without any flags at all, and "pthread-config"
-# which is a program returning the flags for the Pth emulation library.
+# Create a list of thread flags to try. Items with a "," contain both
+# C compiler flags (before ",") and linker flags (after ","). Other items
+# starting with a "-" are C compiler flags, and remaining items are
+# library names, except for "none" which indicates that we try without
+# any flags at all, and "pthread-config" which is a program returning
+# the flags for the Pth emulation library.
ax_pthread_flags="pthreads none -Kthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config"
# that too in a future libc.) So we'll check first for the
# standard Solaris way of linking pthreads (-mt -lpthread).
- ax_pthread_flags="-mt,pthread pthread $ax_pthread_flags"
- ;;
-esac
-
-# GCC generally uses -pthread, or -pthreads on some platforms (e.g. SPARC)
-
-if test "x$GCC" = "xyes"; then :
- ax_pthread_flags="-pthread -pthreads $ax_pthread_flags"
-fi
-
-# The presence of a feature test macro requesting re-entrant function
-# definitions is, on some systems, a strong hint that pthreads support is
-# correctly enabled
-
-case $host_os in
- darwin* | hpux* | linux* | osf* | solaris*)
- ax_pthread_check_macro="_REENTRANT"
- ;;
-
- aix*)
- ax_pthread_check_macro="_THREAD_SAFE"
- ;;
-
- *)
- ax_pthread_check_macro="--"
+ ax_pthread_flags="-mt,-lpthread pthread $ax_pthread_flags"
;;
esac
-if test "x$ax_pthread_check_macro" = "x--"; then :
- ax_pthread_check_cond=0
-else
- ax_pthread_check_cond="!defined($ax_pthread_check_macro)"
-fi
# Are we compiling with Clang?
$as_echo "$ax_cv_PTHREAD_CLANG" >&6; }
ax_pthread_clang="$ax_cv_PTHREAD_CLANG"
-ax_pthread_clang_warning=no
-
-# Clang needs special handling, because older versions handle the -pthread
-# option in a rather... idiosyncratic way
-if test "x$ax_pthread_clang" = "xyes"; then
+# GCC generally uses -pthread, or -pthreads on some platforms (e.g. SPARC)
- # Clang takes -pthread; it has never supported any other flag
+# Note that for GCC and Clang -pthread generally implies -lpthread,
+# except when -nostdlib is passed.
+# This is problematic using libtool to build C++ shared libraries with pthread:
+# [1] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=25460
+# [2] https://bugzilla.redhat.com/show_bug.cgi?id=661333
+# [3] https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=468555
+# To solve this, first try -pthread together with -lpthread for GCC
- # (Note 1: This will need to be revisited if a system that Clang
- # supports has POSIX threads in a separate library. This tends not
- # to be the way of modern systems, but it's conceivable.)
+if test "x$GCC" = "xyes"; then :
+ ax_pthread_flags="-pthread,-lpthread -pthread -pthreads $ax_pthread_flags"
+fi
- # (Note 2: On some systems, notably Darwin, -pthread is not needed
- # to get POSIX threads support; the API is always present and
- # active. We could reasonably leave PTHREAD_CFLAGS empty. But
- # -pthread does define _REENTRANT, and while the Darwin headers
- # ignore this macro, third-party headers might not.)
+# Clang takes -pthread (never supported any other flag), but we'll try with -lpthread first
- PTHREAD_CFLAGS="-pthread"
- PTHREAD_LIBS=
+if test "x$ax_pthread_clang" = "xyes"; then :
+ ax_pthread_flags="-pthread,-lpthread -pthread"
+fi
- ax_pthread_ok=yes
- # However, older versions of Clang make a point of warning the user
- # that, in an invocation where only linking and no compilation is
- # taking place, the -pthread option has no effect ("argument unused
- # during compilation"). They expect -pthread to be passed in only
- # when source code is being compiled.
- #
- # Problem is, this is at odds with the way Automake and most other
- # C build frameworks function, which is that the same flags used in
- # compilation (CFLAGS) are also used in linking. Many systems
- # supported by AX_PTHREAD require exactly this for POSIX threads
- # support, and in fact it is often not straightforward to specify a
- # flag that is used only in the compilation phase and not in
- # linking. Such a scenario is extremely rare in practice.
- #
- # Even though use of the -pthread flag in linking would only print
- # a warning, this can be a nuisance for well-run software projects
- # that build with -Werror. So if the active version of Clang has
- # this misfeature, we search for an option to squash it.
+# The presence of a feature test macro requesting re-entrant function
+# definitions is, on some systems, a strong hint that pthreads support is
+# correctly enabled
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread" >&5
-$as_echo_n "checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread... " >&6; }
-if ${ax_cv_PTHREAD_CLANG_NO_WARN_FLAG+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- ax_cv_PTHREAD_CLANG_NO_WARN_FLAG=unknown
- # Create an alternate version of $ac_link that compiles and
- # links in two steps (.c -> .o, .o -> exe) instead of one
- # (.c -> exe), because the warning occurs only in the second
- # step
- ax_pthread_save_ac_link="$ac_link"
- ax_pthread_sed='s/conftest\.\$ac_ext/conftest.$ac_objext/g'
- ax_pthread_link_step=`$as_echo "$ac_link" | sed "$ax_pthread_sed"`
- ax_pthread_2step_ac_link="($ac_compile) && (echo ==== >&5) && ($ax_pthread_link_step)"
- ax_pthread_save_CFLAGS="$CFLAGS"
- for ax_pthread_try in '' -Qunused-arguments -Wno-unused-command-line-argument unknown; do
- if test "x$ax_pthread_try" = "xunknown"; then :
- break
-fi
- CFLAGS="-Werror -Wunknown-warning-option $ax_pthread_try -pthread $ax_pthread_save_CFLAGS"
- ac_link="$ax_pthread_save_ac_link"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-int main(void){return 0;}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- ac_link="$ax_pthread_2step_ac_link"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-int main(void){return 0;}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- break
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+case $host_os in
+ darwin* | hpux* | linux* | osf* | solaris*)
+ ax_pthread_check_macro="_REENTRANT"
+ ;;
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- done
- ac_link="$ax_pthread_save_ac_link"
- CFLAGS="$ax_pthread_save_CFLAGS"
- if test "x$ax_pthread_try" = "x"; then :
- ax_pthread_try=no
-fi
- ax_cv_PTHREAD_CLANG_NO_WARN_FLAG="$ax_pthread_try"
+ aix*)
+ ax_pthread_check_macro="_THREAD_SAFE"
+ ;;
+ *)
+ ax_pthread_check_macro="--"
+ ;;
+esac
+if test "x$ax_pthread_check_macro" = "x--"; then :
+ ax_pthread_check_cond=0
+else
+ ax_pthread_check_cond="!defined($ax_pthread_check_macro)"
fi
-{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&5
-$as_echo "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&6; }
-
- case "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" in
- no | unknown) ;;
- *) PTHREAD_CFLAGS="$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG $PTHREAD_CFLAGS" ;;
- esac
-fi # $ax_pthread_clang = yes
if test "x$ax_pthread_ok" = "xno"; then
for ax_pthread_try_flag in $ax_pthread_flags; do
$as_echo_n "checking whether pthreads work without any flags... " >&6; }
;;
- -mt,pthread)
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work with -mt -lpthread" >&5
-$as_echo_n "checking whether pthreads work with -mt -lpthread... " >&6; }
- PTHREAD_CFLAGS="-mt"
- PTHREAD_LIBS="-lpthread"
+ *,*)
+ PTHREAD_CFLAGS=`echo $ax_pthread_try_flag | sed "s/^\(.*\),\(.*\)$/\1/"`
+ PTHREAD_LIBS=`echo $ax_pthread_try_flag | sed "s/^\(.*\),\(.*\)$/\2/"`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work with \"$PTHREAD_CFLAGS\" and \"$PTHREAD_LIBS\"" >&5
+$as_echo_n "checking whether pthreads work with \"$PTHREAD_CFLAGS\" and \"$PTHREAD_LIBS\"... " >&6; }
;;
-*)
# if $ax_pthread_check_cond
# error "$ax_pthread_check_macro must be defined"
# endif
- static void routine(void *a) { a = 0; }
+ static void *some_global = NULL;
+ static void routine(void *a)
+ {
+ /* To avoid any unused-parameter or
+ unused-but-set-parameter warning. */
+ some_global = a;
+ }
static void *start_routine(void *a) { return a; }
int
main ()
done
fi
+
+# Clang needs special handling, because older versions handle the -pthread
+# option in a rather... idiosyncratic way
+
+if test "x$ax_pthread_clang" = "xyes"; then
+
+ # Clang takes -pthread; it has never supported any other flag
+
+ # (Note 1: This will need to be revisited if a system that Clang
+ # supports has POSIX threads in a separate library. This tends not
+ # to be the way of modern systems, but it's conceivable.)
+
+ # (Note 2: On some systems, notably Darwin, -pthread is not needed
+ # to get POSIX threads support; the API is always present and
+ # active. We could reasonably leave PTHREAD_CFLAGS empty. But
+ # -pthread does define _REENTRANT, and while the Darwin headers
+ # ignore this macro, third-party headers might not.)
+
+ # However, older versions of Clang make a point of warning the user
+ # that, in an invocation where only linking and no compilation is
+ # taking place, the -pthread option has no effect ("argument unused
+ # during compilation"). They expect -pthread to be passed in only
+ # when source code is being compiled.
+ #
+ # Problem is, this is at odds with the way Automake and most other
+ # C build frameworks function, which is that the same flags used in
+ # compilation (CFLAGS) are also used in linking. Many systems
+ # supported by AX_PTHREAD require exactly this for POSIX threads
+ # support, and in fact it is often not straightforward to specify a
+ # flag that is used only in the compilation phase and not in
+ # linking. Such a scenario is extremely rare in practice.
+ #
+ # Even though use of the -pthread flag in linking would only print
+ # a warning, this can be a nuisance for well-run software projects
+ # that build with -Werror. So if the active version of Clang has
+ # this misfeature, we search for an option to squash it.
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread" >&5
+$as_echo_n "checking whether Clang needs flag to prevent \"argument unused\" warning when linking with -pthread... " >&6; }
+if ${ax_cv_PTHREAD_CLANG_NO_WARN_FLAG+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ax_cv_PTHREAD_CLANG_NO_WARN_FLAG=unknown
+ # Create an alternate version of $ac_link that compiles and
+ # links in two steps (.c -> .o, .o -> exe) instead of one
+ # (.c -> exe), because the warning occurs only in the second
+ # step
+ ax_pthread_save_ac_link="$ac_link"
+ ax_pthread_sed='s/conftest\.\$ac_ext/conftest.$ac_objext/g'
+ ax_pthread_link_step=`$as_echo "$ac_link" | sed "$ax_pthread_sed"`
+ ax_pthread_2step_ac_link="($ac_compile) && (echo ==== >&5) && ($ax_pthread_link_step)"
+ ax_pthread_save_CFLAGS="$CFLAGS"
+ for ax_pthread_try in '' -Qunused-arguments -Wno-unused-command-line-argument unknown; do
+ if test "x$ax_pthread_try" = "xunknown"; then :
+ break
+fi
+ CFLAGS="-Werror -Wunknown-warning-option $ax_pthread_try -pthread $ax_pthread_save_CFLAGS"
+ ac_link="$ax_pthread_save_ac_link"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int main(void){return 0;}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_link="$ax_pthread_2step_ac_link"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+int main(void){return 0;}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ break
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ done
+ ac_link="$ax_pthread_save_ac_link"
+ CFLAGS="$ax_pthread_save_CFLAGS"
+ if test "x$ax_pthread_try" = "x"; then :
+ ax_pthread_try=no
+fi
+ ax_cv_PTHREAD_CLANG_NO_WARN_FLAG="$ax_pthread_try"
+
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&5
+$as_echo "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" >&6; }
+
+ case "$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG" in
+ no | unknown) ;;
+ *) PTHREAD_CFLAGS="$ax_cv_PTHREAD_CLANG_NO_WARN_FLAG $PTHREAD_CFLAGS" ;;
+ esac
+
+fi # $ax_pthread_clang = yes
+
+
+
# Various other checks:
if test "x$ax_pthread_ok" = "xyes"; then
ax_pthread_save_CFLAGS="$CFLAGS"
main ()
{
int i = PTHREAD_PRIO_INHERIT;
+ return i;
;
return 0;
}
if test "x$ax_pthread_ok" = "xyes"; then
systhread_support=true
otherlibraries="$otherlibraries systhreads"
- case $host in #(
- *-*-haiku*) :
- pthread_link="" ;; #(
- *-*-android*) :
- pthread_link="" ;; #(
- *) :
- pthread_link="-lpthread" ;;
-esac
- common_cppflags="$common_cppflags -D_REENTRANT"
+ common_cflags="$common_cflags $PTHREAD_CFLAGS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: the POSIX threads library is supported" >&5
$as_echo "$as_me: the POSIX threads library is supported" >&6;}
saved_CFLAGS="$CFLAGS"
saved_LIBS="$LIBS"
CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
- LIBS="$LIBS $pthread_link"
+ LIBS="$LIBS $PTHREAD_LIBS"
ac_fn_c_check_func "$LINENO" "sigwait" "ac_cv_func_sigwait"
if test "x$ac_cv_func_sigwait" = xyes; then :
$as_echo "#define HAS_SIGWAIT 1" >>confdefs.h
saved_CC="$CC"
saved_CFLAGS="$CFLAGS"
saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
saved_ac_ext="$ac_ext"
saved_ac_compile="$ac_compile"
# Move the content of confdefs.h to another file so it does not
CPPFLAGS="$saved_CPPFLAGS"
CFLAGS="$saved_CFLAGS"
CC="$saved_CC"
+ LIBS="$saved_LIBS"
saved_CC="$CC"
saved_CFLAGS="$CFLAGS"
saved_CPPFLAGS="$CPPFLAGS"
+ saved_LIBS="$LIBS"
saved_ac_ext="$ac_ext"
saved_ac_compile="$ac_compile"
# Move the content of confdefs.h to another file so it does not
CPPFLAGS="$saved_CPPFLAGS"
CFLAGS="$saved_CFLAGS"
CC="$saved_CC"
+ LIBS="$saved_LIBS"
if $aspp_ok && $as_ok; then :
case "$arch","$system" in #(
amd64,linux|amd64,macosx \
|amd64,openbsd|amd64,win64 \
- |amd64,freebsd|amd64,solaris) :
+ |amd64,freebsd|amd64,solaris \
+ |arm64,linux|arm64,macosx) :
naked_pointers_checker=true
$as_echo "#define NAKED_POINTERS_CHECKER 1" >>confdefs.h
;; #(
ocamldoc=ocamldoc
fi
-case $enable_ocamltest,4.12.1 in #(
+documentation_tool_cmd=''
+
+# Check whether --with-odoc was given.
+if test "${with_odoc+set}" = set; then :
+ withval=$with_odoc; case $withval in #(
+ yes) :
+ documentation_tool='odoc' ;; #(
+ no) :
+ documentation_tool='ocamldoc' ;; #(
+ *) :
+ documentation_tool_cmd="$withval"
+ documentation_tool='odoc' ;;
+esac
+else
+ documentation_tool='ocamldoc'
+fi
+
+if test "x$documentation_tool_cmd" = 'x'
+ documentation_tool_cmd="$documentation_tool"; then :
+
+fi
+
+
+
+case $enable_ocamltest,4.13.0 in #(
yes,*|,*+dev*) :
ocamltest='ocamltest' ;; #(
*) :
flambda_invariants=false
fi
+if test x"$enable_cmm_invariants" = "xyes"; then :
+ cmm_invariants=true
+else
+ cmm_invariants=false
+fi
+
if test x"$enable_flat_float_array" = "xno"; then :
flat_float_array=false
else
bytecclibs="advapi32.lib ws2_32.lib version.lib"
nativecclibs="advapi32.lib ws2_32.lib version.lib" ;; #(
*) :
- bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs"
+ bytecclibs="$cclibs $DLLIBS $PTHREAD_LIBS"
nativecclibs="$cclibs $DLLIBS" ;;
esac
windows_unicode=0 ;;
esac
-# Define flexlink chain and flags correctly for the different Windows ports
-case $host in #(
- i686-w64-mingw32) :
- flexdll_chain='mingw'
- flexlink_flags="-chain $flexdll_chain -stack 16777216" ;; #(
- x86_64-w64-mingw32) :
- flexdll_chain='mingw64'
- flexlink_flags="-chain $flexdll_chain -stack 33554432" ;; #(
- i686-pc-windows) :
- flexdll_chain='msvc'
- flexlink_flags="-merge-manifest -stack 16777216" ;; #(
- x86_64-pc-windows) :
- flexdll_chain='msvc64'
- flexlink_flags="-x64 -merge-manifest -stack 33554432" ;; #(
- *) :
- ;;
-esac
-
# Define default prefix correctly for the different Windows ports
if test x"$prefix" = "xNONE"; then :
case $host in #(
&& test "$host_vendor-$host_os" != "$build_vendor-$build_os" ; then :
case $build in #(
*-pc-cygwin) :
- prefix=`cygpath -m "$prefix"` ;; #(
+ prefix="$(LC_ALL=C.UTF-8 cygpath -m "$prefix")" ;; #(
*) :
;;
esac
# but whose value is not guessed properly by configure
# (all this should be understood and fixed)
case $host in #(
- *-*-mingw32|*-pc-windows) :
+ *-*-mingw32) :
+ $as_echo "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
+
+ $as_echo "#define HAS_STRERROR 1" >>confdefs.h
+
+ $as_echo "#define HAS_NICE 1" >>confdefs.h
+ ;; #(
+ *-pc-windows) :
$as_echo "#define HAS_BROKEN_PRINTF 1" >>confdefs.h
$as_echo "#define HAS_STRERROR 1" >>confdefs.h
stdlib_manpages=false
fi
+# Do not permanently cache the result of flexdll.h
+unset ac_cv_header_flexdll_h
+
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by OCaml $as_me 4.12.1, which was
+This file was extended by OCaml $as_me 4.13.0, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-OCaml config.status 4.12.1
+OCaml config.status 4.13.0
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
libraries_man_section=3
# Command to build executalbes
-# In general this command is supposed to use the CFLAGs-related variables
-# ($OC_CFLAGS and $CFLAGS), but at the moment they are not taken into
-# account on Windows, because flexlink, which is used to build
-# executables on this platform, can not handle them.
-mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS)"
+# In general this command is supposed to use the CFLAGs- and LDFLAGS-
+# related variables (OC_CFLAGS and OC_LDFLAGS for ocaml-specific
+# flags, CFLAGS and LDFLAGS for generic flags chosen by the user), but
+# at the moment they are not taken into account on Windows, because
+# flexlink, which is used to build executables on this platform, can
+# not handle them.
+mkexe="\$(CC) \$(OC_CFLAGS) \$(CFLAGS) \$(OC_LDFLAGS) \$(LDFLAGS)"
# Flags for building executable files with debugging symbols
mkexedebugflag="-g"
oc_dll_ldflags=""
with_sharedlibs=true
ostype="Unix"
-iflexdir=""
SO="so"
toolchain="cc"
profinfo=false
profinfo_width=0
extralibs=
instrumented_runtime=false
-instrumented_runtime_ldlibs=""
+instrumented_runtime_libs=""
+bootstrapping_flexdll=false
# Information about the package
AC_SUBST([nativecclibs])
AC_SUBST([ocamlc_cflags])
AC_SUBST([ocamlc_cppflags])
-AC_SUBST([iflexdir])
+AC_SUBST([flexdir])
+AC_SUBST([bootstrapping_flexdll])
AC_SUBST([long_shebang])
AC_SUBST([shebangscripts])
AC_SUBST([AR])
AC_SUBST([cmxs])
AC_SUBST([debug_runtime])
AC_SUBST([instrumented_runtime])
+AC_SUBST([instrumented_runtime_libs])
AC_SUBST([has_monotonic_clock])
AC_SUBST([otherlibraries])
AC_SUBST([cc_has_debug_prefix_map])
AC_SUBST([with_debugger]) # TODO: rename this variable
AC_SUBST([with_camltex])
AC_SUBST([ocamldoc])
+AC_SUBST([documentation_tool])
+AC_SUBST([documentation_tool_cmd])
AC_SUBST([ocamltest])
-AC_SUBST([pthread_link])
-AC_SUBST([x_includes])
-AC_SUBST([x_libraries])
AC_SUBST([ASPP])
AC_SUBST([endianness])
AC_SUBST([AS])
AC_SUBST([frame_pointers])
AC_SUBST([flambda])
AC_SUBST([flambda_invariants])
+AC_SUBST([cmm_invariants])
AC_SUBST([windows_unicode])
AC_SUBST([flat_float_array])
AC_SUBST([function_sections])
[],
[ocamldoc=auto])
+AC_ARG_WITH([odoc],
+ [AS_HELP_STRING([--with-odoc],
+ [build documentation with odoc])])
+
+
AC_ARG_ENABLE([ocamltest],
[AS_HELP_STRING([--disable-ocamltest],
[do not build the ocamltest driver])])
[AS_HELP_STRING([--disable-cfi],
[disable the CFI directives in assembly files])])
+AC_ARG_ENABLE([imprecise-c99-float-ops],
+ [AS_HELP_STRING([--enable-imprecise-c99-float-ops],
+ [enables potentially imprecise replacement implementations
+ of C99 float ops if unavailable on this platform])])
+
AC_ARG_ENABLE([installing-source-artifacts],
[AS_HELP_STRING([--enable-installing-source-artifacts],
[install *.cmt* and *.mli files])])
[AS_HELP_STRING([--enable-flambda-invariants],
[enable invariants checks in flambda])])
+AC_ARG_ENABLE([cmm-invariants],
+ [AS_HELP_STRING([--enable-cmm-invariants],
+ [enable invariants checks in Cmm])])
+
AC_ARG_WITH([target-bindir],
[AS_HELP_STRING([--with-target-bindir],
[location of binary programs on target system])])
[AS_HELP_STRING([--with-afl],
[use the AFL fuzzer])])
+AC_ARG_WITH([flexdll],
+ [AS_HELP_STRING([--with-flexdll],
+ [bootstrap FlexDLL from the given sources])],
+ [AS_IF([test x"$withval" = 'xyes'],[with_flexdll=flexdll])])
+
AS_IF([test x"$enable_unix_lib" = "xno"],
[AS_IF([test x"$enable_debugger" = "xyes"],
[AC_MSG_ERROR([replay debugger requires the unix library])],
## Find vendor of the C compiler
OCAML_CC_VENDOR
+## In cross-compilation mode, can we run executables produced?
+# At the moment, it's required, but the fact is used in C99 function detection
+OCAML_HOST_IS_EXECUTABLE
+
# Determine how to call the C preprocessor directly.
# Most of the time, calling the C preprocessor through the C compiler is
# desirable and even important.
# [*-pc-windows],
# [enable_shared=yes])
-AS_IF([test x"$enable_shared" = "xno"],[with_sharedlibs=false])
+AS_IF([test x"$enable_shared" = "xno"],
+ [with_sharedlibs=false
+ AS_CASE([$host],
+ [*-pc-windows|*-w64-mingw32],
+ [AC_MSG_ERROR([Cannot build native Win32 with --disable-shared])])])
+
+# Define flexlink chain and flags correctly for the different Windows ports
+AS_CASE([$host],
+ [i686-*-cygwin],
+ [flexdll_chain='cygwin'
+ flexlink_flags="-chain $flexdll_chain -merge-manifest -stack 16777216"],
+ [x86_64-*-cygwin],
+ [flexdll_chain='cygwin64'
+ flexlink_flags="-chain $flexdll_chain -merge-manifest -stack 16777216"],
+ [*-*-cygwin*],
+ [AC_MSG_ERROR([unknown cygwin variant])],
+ [i686-w64-mingw32],
+ [flexdll_chain='mingw'
+ flexlink_flags="-chain $flexdll_chain -stack 16777216"],
+ [x86_64-w64-mingw32],
+ [flexdll_chain='mingw64'
+ flexlink_flags="-chain $flexdll_chain -stack 33554432"],
+ [i686-pc-windows],
+ [flexdll_chain='msvc'
+ flexlink_flags="-merge-manifest -stack 16777216"],
+ [x86_64-pc-windows],
+ [flexdll_chain='msvc64'
+ flexlink_flags="-x64 -merge-manifest -stack 33554432"])
+
+AS_IF([test x"$enable_shared" != 'xno'], [
+ AC_MSG_CHECKING([for flexdll sources])
+ AS_IF([test x"$with_flexdll" = "xno"],
+ [flexdir=''
+ AC_MSG_RESULT([disabled])],
+ [flexmsg=''
+ AS_CASE([$target],
+ [*-*-cygwin*|*-w64-mingw32|*-pc-windows],
+ [AS_IF([test x"$with_flexdll" = 'x' -o x"$with_flexdll" = 'xflexdll'],
+ [AS_IF([test -f 'flexdll/flexdll.h'],
+ [flexdir=flexdll
+ iflexdir='$(ROOTDIR)/flexdll'
+ with_flexdll="$iflexdir"],
+ [AS_IF([test x"$with_flexdll" != 'x'],
+ [AC_MSG_RESULT([requested but not available])
+ AC_MSG_ERROR([exiting])])])],
+ [rm -rf flexdll-sources
+ AS_IF([test -f "$with_flexdll/flexdll.h"],
+ [mkdir -p flexdll-sources
+ cp -r "$with_flexdll"/* flexdll-sources/
+ flexdir='flexdll-sources'
+ iflexdir='$(ROOTDIR)/flexdll-sources'
+ flexmsg=" (from $with_flexdll)"],
+ [AC_MSG_RESULT([requested but not available])
+ AC_MSG_ERROR([exiting])])])
+ AS_IF([test x"$flexdir" = 'x'],
+ [AC_MSG_RESULT([no])],
+ [AC_MSG_RESULT([$iflexdir$flexmsg])
+ bootstrapping_flexdll=true
+ # The submodule should be searched *before* any other -I paths
+ internal_cppflags="-I $iflexdir $internal_cppflags"])],
+ [AS_IF([test x"$with_flexdll" != 'x'],
+ [AC_MSG_RESULT([requested but not supported])
+ AC_MSG_ERROR([exiting])])])])
+
+ AC_CHECK_PROG([flexlink],[flexlink],[flexlink])
+
+ AS_IF([test -n "$flexlink" -a -z "$flexdir"],[
+ OCAML_TEST_FLEXLINK([$flexlink], [$flexdll_chain],
+ [$internal_cppflags], [$host])
+
+ AS_CASE([$host],
+ [*-w64-mingw32|*-pc-windows],
+ [flexlink_where="$(cmd /c "$flexlink" -where 2>/dev/null)"
+ AS_IF([test -z "$flexlink_where"],
+ [AC_MSG_ERROR([$flexlink is not executable from a native Win32 process])
+ ])])
+ ])
+
+ OCAML_TEST_FLEXDLL_H([$flexdir])
+
+ AS_IF([test -n "$flexlink" -a x"$have_flexdll_h" = 'xno'],
+ [OCAML_TEST_FLEXLINK_WHERE([$flexlink])
+ AS_IF([test "x$have_flexdll_h" = 'xyes'],
+ [internal_cppflags="$internal_cppflags -I \"$flexlink_where\""])
+ ])
+])
+
+AS_IF([test x"$have_flexdll_h" = 'xno'],
+ [AS_CASE([$host],
+ [*-*-cygwin*],
+ [AS_IF([$with_sharedlibs],
+ [with_sharedlibs=false
+ AC_MSG_WARN([flexdll.h not found: shared library support disabled.])
+ ])],
+ [*-w64-mingw32|*-pc-windows],
+ [AC_MSG_ERROR([flexdll.h is required for native Win32])])])
+
+AS_IF([test -z "$flexdir" -o x"$have_flexdll_h" = 'xno'],
+ [AS_CASE([$host],
+ [*-*-cygwin*],
+ [AS_IF([$with_sharedlibs],
+ [AS_IF([test -z "$flexlink"],
+ [with_sharedlibs=false
+ AC_MSG_WARN(
+ [flexlink/flexdll.h not found: shared library support disabled.])
+ ])])],
+ [*-w64-mingw32|*-pc-windows],
+ [AS_IF([test -z "$flexlink"],
+ [AC_MSG_ERROR([flexlink is required for native Win32])])])])
AS_CASE([$CC,$host],
[*,*-*-darwin*],
AC_DEFINE([HAS_ARCH_CODE32], [1])],
[*,*-*-haiku*], [mathlib=""],
[*,*-*-cygwin*],
- [AS_CASE([$target],
- [i686-*], [flavor=cygwin],
- [x86_64-*], [flavor=cygwin64],
- [AC_MSG_ERROR([unknown cygwin variant])])
- common_cppflags="$common_cppflags -U_WIN32"
+ [common_cppflags="$common_cppflags -U_WIN32"
AS_IF([$with_sharedlibs],
- [flexlink="flexlink -chain $flavor -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- AS_IF([test -z "$flexdir"],
- [AC_MSG_WARN(
- [flexlink not found: native shared libraries won't be available.]
- )
- with_sharedlibs=false],
- [iflexdir="-I\"$flexdir\""
- mkexe="$flexlink -exe"
- mkexedebugflag="-link -g"]
- )]
- )
- AS_IF([! $with_sharedlibs],
+ [mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
+ mkexedebugflag="-link -g"],
[mkexe="$mkexe -Wl,--stack,16777216"
oc_ldflags="-Wl,--stack,16777216"]
)
ostype="Cygwin"],
[*,*-*-mingw32],
- [AS_IF([$with_sharedlibs],
- [AS_CASE([$host],
- [i686-*-*], [flexdll_chain="mingw"; oc_dll_ldflags="-static-libgcc"],
- [x86_64-*-*], [flexdll_chain="mingw64"])
- flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll'])
- iflexdir="-I\"$flexdir\""
- mkexedebugflag="-link -g"])
+ [AS_CASE([$host],
+ [i686-*-*], [oc_dll_ldflags="-static-libgcc"])
+ mkexedebugflag="-link -g"
ostype="Win32"
toolchain="mingw"
mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
ostype="Win32"
mkexe='$(FLEXLINK) -exe $(if $(OC_LDFLAGS),-link "$(OC_LDFLAGS)")'
oc_ldflags='/ENTRY:wmainCRTStartup'
- AS_CASE([$host],
- [i686-pc-windows], [flexdll_chain=msvc],
- [x86_64-pc-windows], [flexdll_chain=msvc64])
- AS_IF([$with_sharedlibs],
- [flexlink="flexlink -chain $flexdll_chain -merge-manifest -stack 16777216"
- flexdir=`$flexlink -where | tr -d '\015'`
- AS_IF([test -z "$flexdir"], [flexdir='$(ROOTDIR)/flexdll'])
- iflexdir="-I\"$flexdir\""
- mkexedebugflag=''])],
+ mkexedebugflag=''],
[*,x86_64-*-linux*],
AC_DEFINE([HAS_ARCH_CODE32], [1]),
[xlc*,powerpc-ibm-aix*],
AS_IF([test x"$enable_shared" != "xno"],
[AS_CASE([$host],
[*-apple-darwin*],
- [mksharedlib="$CC -shared -flat_namespace -undefined suppress \
- -Wl,-no_compact_unwind"
+ [mksharedlib="$CC -shared \
+ -flat_namespace -undefined suppress -Wl,-no_compact_unwind \
+ \$(LDFLAGS)"
shared_libraries_supported=true],
[*-*-mingw32],
[mksharedlib='$(FLEXLINK)'
mkmaindll='$(FLEXLINK) -maindll'
shared_libraries_supported=$with_sharedlibs],
[*-*-cygwin*],
- [mksharedlib="$flexlink"
- mkmaindll="$flexlink -maindll"
- shared_libraries_supported=true],
+ [mksharedlib='$(FLEXLINK)'
+ mkmaindll='$(FLEXLINK) -maindll'
+ shared_libraries_supported=$with_sharedlibs],
[powerpc-ibm-aix*],
[AS_CASE([$ocaml_cv_cc_vendor],
[xlc*],
- [mksharedlib="$CC -qmkshrobj -G"
+ [mksharedlib="$CC -qmkshrobj -G \$(LDFLAGS)"
shared_libraries_supported=true])],
[*-*-solaris*],
[sharedlib_cflags="-fPIC"
|*-*-openbsd*|*-*-netbsd*|*-*-dragonfly*|*-*-gnu*|*-*-haiku*]],
[sharedlib_cflags="-fPIC"
AS_CASE([$CC,$host],
- [gcc*,powerpc-*-linux*], [mksharedlib="$CC -shared -mbss-plt"],
- [mksharedlib="$CC -shared"])
+ [gcc*,powerpc-*-linux*],
+ [mksharedlib="$CC -shared -mbss-plt \$(LDFLAGS)"],
+ [mksharedlib="$CC -shared \$(LDFLAGS)"])
oc_ldflags="$oc_ldflags -Wl,-E"
rpath="-Wl,-rpath,"
mksharedlibrpath="-Wl,-rpath,"
natdynlink=false
-AS_IF([test x"$enable_shared" != "xno"],
+AS_IF([test x"$shared_libraries_supported" = 'xtrue'],
[AS_CASE(["$host"],
[*-*-cygwin*], [natdynlink=true],
[*-*-mingw32], [natdynlink=true],
[arch=power; AS_IF([$arch64],[model=ppc64],[model=ppc]); system=elf],
[[s390x*-*-linux*]],
[arch=s390x; model=z10; system=elf],
- [armv6*-*-linux-gnueabihf],
+ # expected to match "gnueabihf" as well as "musleabihf"
+ [armv6*-*-linux-*eabihf],
[arch=arm; model=armv6; system=linux_eabihf],
- [armv7*-*-linux-gnueabihf],
+ [armv7*-*-linux-*eabihf],
[arch=arm; model=armv7; system=linux_eabihf],
- [armv8*-*-linux-gnueabihf],
+ [armv8*-*-linux-*eabihf],
[arch=arm; model=armv8; system=linux_eabihf],
- [armv8*-*-linux-gnueabi],
+ [armv8*-*-linux-*eabi],
[arch=arm; model=armv8; system=linux_eabi],
- [armv7*-*-linux-gnueabi],
+ [armv7*-*-linux-*eabi],
[arch=arm; model=armv7; system=linux_eabi],
- [armv6t2*-*-linux-gnueabi],
+ [armv6t2*-*-linux-*eabi],
[arch=arm; model=armv6t2; system=linux_eabi],
- [armv6*-*-linux-gnueabi],
+ [armv6*-*-linux-*eabi],
[arch=arm; model=armv6; system=linux_eabi],
[armv6*-*-freebsd*],
[arch=arm; model=armv6; system=freebsd],
[arch=arm; model=armv6; system=netbsd],
[earmv7*-*-netbsd*],
[arch=arm; model=armv7; system=netbsd],
- [armv5te*-*-linux-gnueabi],
+ [armv5te*-*-linux-*eabi],
[arch=arm; model=armv5te; system=linux_eabi],
- [armv5*-*-linux-gnueabi],
+ [armv5*-*-linux-*eabi],
[arch=arm; model=armv5; system=linux_eabi],
- [arm*-*-linux-gnueabihf],
+ [arm*-*-linux-*eabihf],
[arch=arm; system=linux_eabihf],
- [arm*-*-linux-gnueabi],
+ [arm*-*-linux-*eabi],
[arch=arm; system=linux_eabi],
[arm*-*-openbsd*],
[arch=arm; system=bsd],
# ocamlopt generates PIC code or doesn't generate code at all
[],
[AS_CASE([$host],
- [*-linux-musl],
+ # expected to match "*-linux-musl" as well as "*-linux-musleabi*"
+ [*-linux-musl*],
# Alpine and other musl-based Linux distributions
[common_cflags="-no-pie $common_cflags"],
[])])
# Assembler
-AS_IF([test -n "$host_alias"], [toolpref="${host_alias}-"], [toolpref=""])
-
-# We first compute default values for as and aspp
-# If values have been given by the user then they take precedence over
-# those just computed
-# One may want to check whether the user provided values first
-# and only compute values if none has been provided
-
-AC_CHECK_TOOL([SYSTEM_AS],[as])
-
-AS_CASE(["$arch,$system"],
- [i386,win32],
- [default_as="ml -nologo -coff -Cp -c -Fo"],
- [amd64,win64],
- [default_as="ml64 -nologo -Cp -c -Fo"],
- [amd64,macosx],
- [AS_CASE([$ocaml_cv_cc_vendor],
- [clang-*],
- [default_as='clang -arch x86_64 -Wno-trigraphs -c'
- default_aspp='clang -arch x86_64 -Wno-trigraphs -c'],
- [default_as="${toolpref}as -arch x86_64"
- default_aspp="${toolpref}gcc -arch x86_64 -c"])],
- [amd64,solaris],
- [AS_CASE([$ocaml_cv_cc_vendor],
- [sunc-*],
- [AS_IF([test x"$SYSTEM_AS" = "x"],
- [AC_MSG_ERROR([GNU as assembler is required.])],
- [default_as="${toolpref}as --64"
- default_aspp="${toolpref}cc -m64 -c"])],
- [gcc-*],
- [AS_IF([test x"$SYSTEM_AS" = "x"],
- [default_as="${toolpref}gcc -m64 -c"
- default_aspp="${toolpref}gcc -m64 -c"],
- [default_as="${toolpref}as --64"
- default_aspp="${toolpref}gcc -m64 -c"])])],
- [power,elf],
- [AS_CASE([$model],
- [ppc64le],
- [default_as="${toolpref}as -a64 -mpower8"
- default_aspp="${toolpref}gcc -m64 -mcpu=powerpc64le -c"],
- [ppc64],
- [default_as="${toolpref}as -a64 -mppc64"
- default_aspp="${toolpref}gcc -m64 -c"],
- [ppc],
- [default_as="${toolpref}as -mppc"
- default_aspp="${toolpref}gcc -m32 -c"])],
- [s390x,elf],
- [default_as="${toolpref}as -m 64 -march=$model"
- default_aspp="${toolpref}gcc -c -Wa,-march=$model"],
- [*,freebsd],
- [default_as="${toolpref}cc -c -Wno-trigraphs"
- default_aspp="${toolpref}cc -c -Wno-trigraphs"],
- [*,dragonfly],
- [default_as="${toolpref}as"
- default_aspp="${toolpref}cc -c"],
- [amd64,*|arm,*|arm64,*|i386,*|riscv,*],
- [AS_CASE([$ocaml_cv_cc_vendor],
- [clang-*], [default_as="${toolpref}clang -c -Wno-trigraphs"
- default_aspp="${toolpref}clang -c -Wno-trigraphs"],
- [default_as="${toolpref}as"
- default_aspp="${toolpref}gcc -c"])])
+AS_IF([test -n "$target_alias"],
+ [toolpref="${target_alias}-"
+ as_target="$target"
+ as_cpu="$target_cpu"],
+ [AS_IF([test -n "$host_alias"],
+ [toolpref="${host_alias}-"
+ as_target="$host"
+ as_cpu="$host_cpu"],
+ [toolpref=""
+ as_target="$build"
+ as_cpu="$build_cpu"])])
+
+# Finding the assembler
+# The OCaml build system distinguishes two different assemblers:
+# 1. AS, used to assemble the code generated by the ocamlopt native compiler
+# 2. ASPP, to assemble other assembly files that may require preprocessing
+# In general, "$CC -c" is used as a default value for both AS and ASPP.
+# On a few platforms (Windows) both values are overriden.
+# On other platforms, (Linux with GCC) the assembler AS is called directly
+# to avoiding forking a C compiler process for each compilation by ocamlopt.
+# Both AS and ASPP can be overriden by the user.
+
+default_as="$CC -c"
+default_aspp="$CC -c"
+
+AS_CASE([$as_target,$ocaml_cv_cc_vendor],
+ [*-*-linux*,gcc-*],
+ [AS_CASE([$as_cpu],
+ [x86_64|arm*|aarch64*|i[[3-6]]86|riscv*],
+ [default_as="${toolpref}as"])],
+ [i686-pc-windows,*],
+ [default_as="ml -nologo -coff -Cp -c -Fo"
+ default_aspp="$default_as"],
+ [x86_64-pc-windows,*],
+ [default_as="ml64 -nologo -Cp -c -Fo"
+ default_aspp="$default_as"],
+ [*-*-darwin*,clang-*],
+ [default_as="$default_as -Wno-trigraphs"
+ default_aspp="$default_as"],
+ [])
AS_IF([test "$with_pic"],
[fpic=true
## Check for C99 float ops
-# Note: this was disabled on Windows but the autoconf-generated script
-# does find the function it is looking for.
-# however the fma test does not pass so we disable the feature
-# for the moment, to be backward-compatible
-
-AS_CASE([$host],
- [*-*-mingw32|*-pc-windows], [],
- [has_c99_float_ops=true
- AC_CHECK_FUNC([expm1], [], [has_c99_float_ops=false])
- AS_IF([$has_c99_float_ops],
- [AC_CHECK_FUNC([log1p], [], [has_c99_float_ops=false])])
- AS_IF([$has_c99_float_ops],
- [AC_CHECK_FUNC([hypot], [], [has_c99_float_ops=false])])
- AS_IF([$has_c99_float_ops],
- [AC_CHECK_FUNC([fma], [
- AS_CASE([$target],[x86_64-*-cygwin],[],[AC_DEFINE([HAS_WORKING_FMA])])],
- [has_c99_float_ops=false])])
- AS_IF([$has_c99_float_ops],
- [AC_CHECK_FUNC([copysign], [AC_DEFINE([HAS_C99_FLOAT_OPS])])])])
+has_c99_float_ops=true
+AC_CHECK_FUNCS(m4_normalize([expm1 log1p hypot fma exp2 log2 cbrt acosh asinh
+ atanh erf erfc trunc round copysign]), [], [has_c99_float_ops=false])
+
+AS_IF([$has_c99_float_ops],
+ [AC_DEFINE([HAS_C99_FLOAT_OPS])
+ # Check whether round works (known bug in mingw-w64)
+ OCAML_C99_CHECK_ROUND
+ # Check whether fma works (regressed in mingw-w64 8.0.0; present, but broken,
+ # in VS2013-2017 and present but unimplemented in Cygwin64)
+ OCAML_C99_CHECK_FMA],
+ [AS_IF([test x"$enable_imprecise_c99_float_ops" != "xyes" ],
+ [AS_CASE([$enable_imprecise_c99_float_ops,$ocaml_cv_cc_vendor],
+ [no,*], [hard_error=true],
+ [,msvc-*], [AS_IF([test "${ocaml_cv_cc_vendor#msvc-}" -lt 1800 ],
+ [hard_error=false],
+ [hard_error=true])],
+ [hard_error=true])
+ AS_IF([test x"$hard_error" = 'xtrue'],
+ [AC_MSG_ERROR(m4_normalize([
+ C99 float ops unavailable, enable replacements
+ with --enable-imprecise-c99-float-ops]))],
+ [AC_MSG_WARN(m4_normalize([
+ C99 float ops unavailable, replacements enabled
+ (ancient Visual Studio)]))])])])
## getrusage
AC_CHECK_FUNC([getrusage], [AC_DEFINE([HAS_GETRUSAGE])])
[
instrumented_runtime=true
AS_IF([test "x$ac_cv_search_clock_gettime" = "xnone required"],
- [instrumented_runtime_ldlibs=""],
- [instrumented_runtime_ldlibs=$ac_cv_search_clock_gettime]
+ [instrumented_runtime_libs=""],
+ [instrumented_runtime_libs=$ac_cv_search_clock_gettime]
)
],
[yes,false,*],
## TODO: check whether the different libraries are really useful
-sockets=false
+sockets=true
AS_CASE([$host],
[*-*-mingw32|*-pc-windows],
[cclibs="$cclibs -lws2_32"
- sockets=true],
+ AC_SEARCH_LIBS([socket], [ws2_32])],
[*-*-haiku],
[cclibs="$cclibs -lnetwork"
- sockets=true],
+ AC_SEARCH_LIBS([socket], [network])],
[*-*-solaris*],
[cclibs="$cclibs -lsocket -lnsl"
- sockets=true],
+ AC_SEARCH_LIBS([socket], [socket])
+ AC_SEARCH_LIBS([inet_ntop], [nsl])],
[
- AC_CHECK_FUNC([socket])
- AC_CHECK_FUNC([socketpair])
- AC_CHECK_FUNC([bind])
- AC_CHECK_FUNC([listen])
- AC_CHECK_FUNC([accept])
- AC_CHECK_FUNC([connect])
- sockets=true
+ AC_CHECK_FUNCS(
+ [socket socketpair bind listen accept connect],
+ [],
+ [sockets=false])
]
)
AS_IF([$sockets], [AC_DEFINE([HAS_SOCKETS])])
-## socklen_t in sys/socket.h
+## socklen_t
-AC_CHECK_TYPE(
- [socklen_t],
- [AC_DEFINE([HAS_SOCKLEN_T])], [],
- [#include <sys/socket.h>])
+AS_CASE([$host],
+ [*-*-mingw32|*-pc-windows],
+ [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T])], [],
+ [#include <ws2tcpip.h>])],
+ [AC_CHECK_TYPE([socklen_t], [AC_DEFINE([HAS_SOCKLEN_T])], [],
+ [#include <sys/socket.h>])])
AC_CHECK_FUNC([inet_aton], [AC_DEFINE([HAS_INET_ATON])])
ipv6=true
-AC_CHECK_TYPE(
- [struct sockaddr_in6], [], [ipv6=false],
+AS_CASE([$host],
+ [*-*-mingw32|*-pc-windows],
+ [AC_CHECK_TYPE(
+ [struct sockaddr_in6], [], [ipv6=false], [#include <ws2tcpip.h>])],
+ [AC_CHECK_TYPE(
+ [struct sockaddr_in6], [], [ipv6=false],
[
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
]
+ )]
)
AS_IF([$ipv6],
[AC_CHECK_FUNC([readlink],
[AC_CHECK_FUNC([lstat], [AC_DEFINE([HAS_SYMLINK])])])])
+AC_CHECK_FUNC([realpath], [AC_DEFINE([HAS_REALPATH])])
+
# wait
AC_CHECK_FUNC(
[waitpid],
## shared library support
AS_IF([$shared_libraries_supported],
[AS_CASE([$host],
- [*-*-mingw32|*-pc-windows],
+ [*-*-mingw32|*-pc-windows|*-*-cygwin*],
[supports_shared_libraries=$shared_libraries_supported; DLLIBS=""],
[AC_CHECK_FUNC([dlopen],
[supports_shared_libraries=true DLLIBS=""],
AS_CASE([$arch,$system],
[i386,linux_elf|amd64,linux|amd64,macosx \
- |amd64,openbsd|i386,bsd_elf],
+ |amd64,openbsd|i386,bsd_elf|arm64,linux|arm64,macosx],
[AC_DEFINE([HAS_STACK_OVERFLOW_DETECTION])
AC_MSG_RESULT([yes])],
[AC_MSG_RESULT([no])])
[AX_PTHREAD(
[systhread_support=true
otherlibraries="$otherlibraries systhreads"
- AS_CASE([$host],
- [*-*-haiku*], [pthread_link=""],
- [*-*-android*], [pthread_link=""],
- [pthread_link="-lpthread"])
- common_cppflags="$common_cppflags -D_REENTRANT"
+ common_cflags="$common_cflags $PTHREAD_CFLAGS"
AC_MSG_NOTICE([the POSIX threads library is supported])
saved_CFLAGS="$CFLAGS"
saved_LIBS="$LIBS"
CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
- LIBS="$LIBS $pthread_link"
+ LIBS="$LIBS $PTHREAD_LIBS"
AC_CHECK_FUNC([sigwait], [AC_DEFINE([HAS_SIGWAIT])])
LIBS="$saved_LIBS"
CFLAGS="$saved_CFLAGS"],
AS_CASE(["$arch","$system"],
[amd64,linux|amd64,macosx \
|amd64,openbsd|amd64,win64 \
- |amd64,freebsd|amd64,solaris],
+ |amd64,freebsd|amd64,solaris \
+ |arm64,linux|arm64,macosx],
[naked_pointers_checker=true
AC_DEFINE([NAKED_POINTERS_CHECKER])],
[*],
[ocamldoc=""],
[ocamldoc=ocamldoc])
+documentation_tool_cmd=''
+AC_ARG_WITH([odoc],
+ [AS_HELP_STRING([--with-odoc])],
+ [AS_CASE([$withval],
+ [yes],[documentation_tool='odoc'],
+ [no],[documentation_tool='ocamldoc'],
+ [documentation_tool_cmd="$withval"
+ documentation_tool='odoc'])],
+ [documentation_tool='ocamldoc'])
+AS_IF([test "x$documentation_tool_cmd" = 'x']
+ [documentation_tool_cmd="$documentation_tool"])
+
+
+
AS_CASE([$enable_ocamltest,AC_PACKAGE_VERSION],
[yes,*|,*+dev*],[ocamltest='ocamltest'],
[ocamltest=''])
[flambda=false
flambda_invariants=false])
+AS_IF([test x"$enable_cmm_invariants" = "xyes"],
+ [cmm_invariants=true],
+ [cmm_invariants=false])
+
AS_IF([test x"$enable_flat_float_array" = "xno"],
[flat_float_array=false],
[AC_DEFINE([FLAT_FLOAT_ARRAY])
[*-pc-windows],
[bytecclibs="advapi32.lib ws2_32.lib version.lib"
nativecclibs="advapi32.lib ws2_32.lib version.lib"],
- [bytecclibs="$cclibs $DLLIBS $pthread_link $instrumented_runtime_ldlibs"
+ [bytecclibs="$cclibs $DLLIBS $PTHREAD_LIBS"
nativecclibs="$cclibs $DLLIBS"])
AS_IF([test x"$libdir" = x'${exec_prefix}/lib'],
[AC_MSG_ERROR([unexpected windows unicode mode])])],
[windows_unicode=0])
-# Define flexlink chain and flags correctly for the different Windows ports
-AS_CASE([$host],
- [i686-w64-mingw32],
- [flexdll_chain='mingw'
- flexlink_flags="-chain $flexdll_chain -stack 16777216"],
- [x86_64-w64-mingw32],
- [flexdll_chain='mingw64'
- flexlink_flags="-chain $flexdll_chain -stack 33554432"],
- [i686-pc-windows],
- [flexdll_chain='msvc'
- flexlink_flags="-merge-manifest -stack 16777216"],
- [x86_64-pc-windows],
- [flexdll_chain='msvc64'
- flexlink_flags="-x64 -merge-manifest -stack 33554432"])
-
# Define default prefix correctly for the different Windows ports
AS_IF([test x"$prefix" = "xNONE"],
[AS_CASE([$host],
[AS_IF([test x"$unix_or_win32" = "xwin32" \
&& test "$host_vendor-$host_os" != "$build_vendor-$build_os" ],
[AS_CASE([$build],
- [*-pc-cygwin], [prefix=`cygpath -m "$prefix"`])])])
+ [*-pc-cygwin], [prefix="$(LC_ALL=C.UTF-8 cygpath -m "$prefix")"])])])
# Define a few macros that were defined in config/m-nt.h
# but whose value is not guessed properly by configure
# (all this should be understood and fixed)
AS_CASE([$host],
- [*-*-mingw32|*-pc-windows],
+ [*-*-mingw32],
+ [AC_DEFINE([HAS_BROKEN_PRINTF])
+ AC_DEFINE([HAS_STRERROR])
+ AC_DEFINE([HAS_NICE])],
+ [*-pc-windows],
[AC_DEFINE([HAS_BROKEN_PRINTF])
AC_DEFINE([HAS_STRERROR])
AC_DEFINE([HAS_IPV6])
AS_IF([test x"$enable_stdlib_manpages" != "xno"],
[stdlib_manpages=true],[stdlib_manpages=false])
+# Do not permanently cache the result of flexdll.h
+unset ac_cv_header_flexdll_h
+
AC_OUTPUT
DYNLINKDIR=$(ROOTDIR)/otherlibs/dynlink
UNIXDIR=$(ROOTDIR)/otherlibs/$(UNIXLIB)
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
CAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
-COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48-70 -warn-error +A \
-safe-string -strict-sequence -strict-formats
LINKFLAGS=-linkall -I $(UNIXDIR) -I $(DYNLINKDIR)
-CAMLLEX=$(BEST_OCAMLLEX)
CAMLDEP=$(BEST_OCAMLDEP)
DEPFLAGS=-slash
DEPINCLUDES=$(INCLUDES)
rm -f ocamldebug ocamldebug.exe
rm -f *.cmo *.cmi
-.SUFFIXES:
-.SUFFIXES: .ml .cmo .mli .cmi
-
-.ml.cmo:
+%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) $<
-.mli.cmi:
+%.cmi: %.mli
$(CAMLC) -c $(COMPFLAGS) $<
depend: beforedepend
$(CAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mli *.ml \
| sed -e 's,$(UNIXDIR)/,$$(UNIXDIR)/,' > .depend
-debugger_lexer.ml: debugger_lexer.mll
- $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
clean::
rm -f debugger_lexer.ml
beforedepend:: debugger_lexer.ml
-debugger_parser.ml debugger_parser.mli: debugger_parser.mly
- $(CAMLYACC) debugger_parser.mly
clean::
rm -f debugger_parser.ml debugger_parser.mli
beforedepend:: debugger_parser.ml debugger_parser.mli
1
| None ->
begin try
- max 1 (line - 10)
+ Int.max 1 (line - 10)
with Out_of_range ->
1
end
let
{c_time = t} = find_checkpoint_before (pre64 time_max)
in
- go_to (max time t);
+ go_to (Int64.max time t);
let (new_time, break) = find_last_breakpoint time_max in
if break <> None || (new_time <= time) then begin
go_to new_time;
let step_backward duration =
let time = current_time () in
if time > _0 then
- back_to (max _0 (time -- duration)) time
+ back_to (Int64.max _0 (time -- duration)) time
(* Run the program from current time. *)
(* Stop at the first breakpoint, or at the end of the program. *)
because they are not understood by some versions of OCaml. *)
let can_discard = ref []
+let parse_warnings error v =
+ Option.iter Location.(prerr_alert none) @@ Warnings.parse_options error v
+
let read_one_param ppf position name v =
let set name options s = setter ppf (fun b -> b) name options s in
let clear name options s = setter ppf (fun b -> not b) name options s in
| "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v
(* warn-errors *)
- | "we" | "warn-error" -> Warnings.parse_options true v
+ | "we" | "warn-error" -> parse_warnings true v
(* warnings *)
- | "w" -> Warnings.parse_options false v
+ | "w" -> parse_warnings false v
(* warn-errors *)
- | "wwe" -> Warnings.parse_options false v
+ | "wwe" -> parse_warnings false v
(* alerts *)
| "alert" -> Warnings.parse_alert_option v
set "flambda-verbose" [ dump_flambda_verbose ] v
| "flambda-invariants" ->
set "flambda-invariants" [ flambda_invariant_checks ] v
+ | "cmm-invariants" ->
+ set "cmm-invariants" [ cmm_invariants ] v
| "linscan" ->
set "linscan" [ use_linscan ] v
| "insn-sched" -> set "insn-sched" [ insn_sched ] v
else
List.rev !objfiles
+let has_linker_inputs = ref false
| ProcessCFile name ->
readenv ppf (Before_compile name);
Location.input_name := name;
- if Ccomp.compile_file name <> 0 then raise (Exit_with_status 2);
- ccobjs := c_object_of_filename name :: !ccobjs
+ let obj_name = match !output_name with
+ | None -> c_object_of_filename name
+ | Some n -> n
+ in
+ if Ccomp.compile_file ?output:!output_name name <> 0
+ then raise (Exit_with_status 2);
+ ccobjs := obj_name :: !ccobjs
| ProcessObjects names ->
ccobjs := names @ !ccobjs
| ProcessDLLs names ->
else if Filename.check_suffix name ".cmi" && !make_package then
objfiles := name :: !objfiles
else if Filename.check_suffix name Config.ext_obj
- || Filename.check_suffix name Config.ext_lib then
+ || Filename.check_suffix name Config.ext_lib then begin
+ has_linker_inputs := true;
ccobjs := name :: !ccobjs
+ end
else if not !native_code && Filename.check_suffix name Config.ext_dll then
dllibs := name :: !dllibs
else
begin
match final_output_name with
| None -> ()
- | Some output_name ->
+ | Some _output_name ->
if !compile_only then begin
- if List.filter (function
- | ProcessCFile name -> c_object_of_filename name <> output_name
- | _ -> false) !deferred_actions <> [] then
- fatal "Options -c and -o are incompatible when compiling C files";
-
if List.length (List.filter (function
+ | ProcessCFile _
| ProcessImplementation _
| ProcessInterface _ -> true
| _ -> false) !deferred_actions) > 1 then
!print_types ||
match !stop_after with
| None -> false
- | Some p -> Clflags.Compiler_pass.is_compilation_pass p;
+ | Some p -> Clflags.Compiler_pass.is_compilation_pass p
+
+(* This function is almost the same as [Arg.parse_expand], except
+ that [Arg.parse_expand] could not be used because it does not take a
+ reference for [arg_spec].
+ We use a marker \000 for Arg.parse_and_expand_argv_dynamic
+ so we can split out error message from usage options, because
+ it always concatenates
+ error message with usage options *)
+let parse_arguments ?(current=ref 0) argv f program =
+ try
+ Arg.parse_and_expand_argv_dynamic current argv Clflags.arg_spec f "\000"
+ with
+ | Arg.Bad err_msg ->
+ let usage_msg = create_usage_msg program in
+ let err_msg = err_msg
+ |> String.split_on_char '\000'
+ |> List.hd
+ |> String.trim in
+ Printf.eprintf "%s\n%s\n" err_msg usage_msg;
+ raise (Exit_with_status 2)
+ | Arg.Help msg ->
+ let err_msg =
+ msg
+ |> String.split_on_char '\000'
+ |> String.concat "" in
+ let help_msg =
+ Printf.sprintf "Usage: %s <options> <files>\nOptions are:" program in
+ Printf.printf "%s\n%s" help_msg err_msg;
+ raise (Exit_with_status 0)
val first_objfiles : string list ref
val stop_early : bool ref
+val has_linker_inputs : bool ref
type filename = string
string * (* ocaml module extension *)
string -> (* ocaml library extension *)
unit
+(* [parse_arguments ?current argv anon_arg program] will parse the arguments,
+ using the arguments provided in [Clflags.arg_spec].
+*)
+val parse_arguments : ?current:(int ref)
+ -> string array ref -> Arg.anon_fun -> string -> unit
(** Bytecode compilation backend for .ml files. *)
-let to_bytecode i (typedtree, coercion) =
- (typedtree, coercion)
+let to_bytecode i Typedtree.{structure; coercion; _} =
+ (structure, coercion)
|> Profile.(record transl)
(Translmod.transl_implementation i.module_name)
|> Profile.(record ~accumulate:true generate)
val to_bytecode :
Compile_common.info ->
- Typedtree.structure * Typedtree.module_coercion ->
+ Typedtree.implementation ->
Instruct.instruction list * Ident.Set.t
(** [to_bytecode info typed] takes a typechecked implementation
and returns its bytecode.
val parse_impl : info -> Parsetree.structure
(** [parse_impl info] parses an implementation (usually an [.ml] file). *)
-val typecheck_impl :
- info -> Parsetree.structure -> Typedtree.structure * Typedtree.module_coercion
+val typecheck_impl : info -> Parsetree.structure -> Typedtree.implementation
(** [typecheck_impl info parsetree] typechecks an implementation and returns
- the typedtree of the associated module, along with a coercion against
- its public interface.
+ the typedtree of the associated module, its public interface, and a
+ coercion against that public interface.
*)
val implementation :
- info ->
- backend:(info -> Typedtree.structure * Typedtree.module_coercion -> unit) ->
- unit
+ info -> backend:(info -> Typedtree.implementation -> unit) -> unit
(** The complete compilation pipeline for implementations. *)
(** {2 Build artifacts} *)
let mk_config_var f =
"-config-var", Arg.String f,
- " Print the value of a configuration variable, a newline, and exit\n\
+ " Print the value of a configuration variable, without a newline, and exit\n\
\ (print nothing and exit with error value if the variable does not exist)"
;;
let mk_match_context_rows f =
"-match-context-rows", Arg.Int f,
- let[@manual.ref "s:comp-options"] chapter, section = 9, 2 in
+ let[@manual.ref "s:comp-options"] chapter, section = 11, 2 in
Printf.sprintf
"<n> (advanced, see manual section %d.%d.)" chapter section
;;
"-dcamlprimc", Arg.Unit f, " (undocumented)"
;;
+let mk_dcmm_invariants f =
+ "-dcmm-invariants", Arg.Unit f, " Extra sanity checks on Cmm"
+;;
+
let mk_dcmm f =
"-dcmm", Arg.Unit f, " (undocumented)"
;;
"-dlive", Arg.Unit f, " (undocumented)"
;;
-let mk_davail f =
- "-davail", Arg.Unit f, " Print register availability info when printing \
- liveness"
-;;
-
-let mk_drunavail f =
- "-drunavail", Arg.Unit f, " Run register availability pass (for testing \
- only; needs -g)"
-;;
-
let mk_dspill f =
"-dspill", Arg.Unit f, " (undocumented)"
;;
val _dflambda_verbose : unit -> unit
val _drawclambda : unit -> unit
val _dclambda : unit -> unit
+ val _dcmm_invariants : unit -> unit
val _dcmm : unit -> unit
val _dsel : unit -> unit
val _dcombine : unit -> unit
val _dcse : unit -> unit
val _dlive : unit -> unit
- val _davail : unit -> unit
- val _drunavail : unit -> unit
val _dspill : unit -> unit
val _dsplit : unit -> unit
val _dinterf : unit -> unit
mk_dlambda F._dlambda;
mk_drawclambda F._drawclambda;
mk_dclambda F._dclambda;
+ mk_dcmm_invariants F._dcmm_invariants;
mk_dflambda F._dflambda;
mk_drawflambda F._drawflambda;
mk_dflambda_invariants F._dflambda_invariants;
mk_dcombine F._dcombine;
mk_dcse F._dcse;
mk_dlive F._dlive;
- mk_davail F._davail;
- mk_drunavail F._drunavail;
mk_dspill F._dspill;
mk_dsplit F._dsplit;
mk_dinterf F._dinterf;
mk_drawlambda F._drawlambda;
mk_drawclambda F._drawclambda;
mk_dclambda F._dclambda;
+ mk_dcmm_invariants F._dcmm_invariants;
mk_drawflambda F._drawflambda;
mk_dflambda F._dflambda;
mk_dcmm F._dcmm;
mk_dcombine F._dcombine;
mk_dcse F._dcse;
mk_dlive F._dlive;
- mk_davail F._davail;
- mk_drunavail F._drunavail;
mk_dspill F._dspill;
mk_dsplit F._dsplit;
mk_dinterf F._dinterf;
let _strict_sequence = set strict_sequence
let _unboxed_types = set unboxed_types
let _unsafe_string = set unsafe_string
- let _w s = Warnings.parse_options false s
+ let _w s =
+ Warnings.parse_options false s |> Option.iter Location.(prerr_alert none)
let anonymous = Compenv.anonymous
let _nopervasives = set nopervasives
let _ppx s = Compenv.first_ppx := (s :: (!Compenv.first_ppx))
let _unsafe = set unsafe
- let _warn_error s = Warnings.parse_options true s
+ let _warn_error s =
+ Warnings.parse_options true s |> Option.iter Location.(prerr_alert none)
let _warn_help = Warnings.help_warnings
end
let _classic_inlining () = classic_inlining := true
let _compact = clear optimize_for_speed
let _dalloc = set dump_regalloc
- let _davail () = dump_avail := true
let _dclambda = set dump_clambda
let _dcmm = set dump_cmm
+ let _dcmm_invariants = set cmm_invariants
let _dcombine = set dump_combine
let _dcse = set dump_cse
let _dflambda = set dump_flambda
let _drawclambda = set dump_rawclambda
let _drawflambda = set dump_rawflambda
let _dreload = set dump_reload
- let _drunavail () = debug_runavail := true
let _dscheduling = set dump_scheduling
let _dsel = set dump_selection
let _dspill = set dump_spill
val _dflambda_verbose : unit -> unit
val _drawclambda : unit -> unit
val _dclambda : unit -> unit
+ val _dcmm_invariants : unit -> unit
val _dcmm : unit -> unit
val _dsel : unit -> unit
val _dcombine : unit -> unit
val _dcse : unit -> unit
val _dlive : unit -> unit
- val _davail : unit -> unit
- val _drunavail : unit -> unit
val _dspill : unit -> unit
val _dsplit : unit -> unit
val _dinterf : unit -> unit
open Clflags
-let usage = "Usage: ocamlc <options> <files>\nOptions are:"
module Options = Main_args.Make_bytecomp_options (Main_args.Default.Main)
let main argv ppf =
+ let program = "ocamlc" in
Clflags.add_arguments __LOC__ Options.list;
Clflags.add_arguments __LOC__
["-depend", Arg.Unit Makedepend.main_from_option,
"<options> Compute dependencies (use 'ocamlc -depend -help' for details)"];
match
Compenv.readenv ppf Before_args;
- Clflags.parse_arguments argv Compenv.anonymous usage;
+ Compenv.parse_arguments (ref argv) Compenv.anonymous program;
Compmisc.read_clflags_from_env ();
if !Clflags.plugin then
Compenv.fatal "-plugin is only supported up to OCaml 4.08.0";
with Arg.Bad msg ->
begin
prerr_endline msg;
- Clflags.print_arguments usage;
+ Clflags.print_arguments program;
exit 2
end
end;
let dep_args_rev : dep_arg list ref = ref [] in
let add_dep_arg f s = dep_args_rev := (f s) :: !dep_args_rev in
Clflags.classic := false;
- Compenv.readenv ppf Before_args;
- Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *)
- Clflags.add_arguments __LOC__ [
- "-absname", Arg.Set Clflags.absname,
+ try
+ Compenv.readenv ppf Before_args;
+ Clflags.reset_arguments (); (* reset arguments from ocamlc/ocamlopt *)
+ Clflags.add_arguments __LOC__ [
+ "-absname", Arg.Set Clflags.absname,
" Show absolute filenames in error messages";
- "-all", Arg.Set all_dependencies,
+ "-all", Arg.Set all_dependencies,
" Generate dependencies on all files";
- "-allow-approx", Arg.Set allow_approximation,
+ "-allow-approx", Arg.Set allow_approximation,
" Fallback to a lexer-based approximation on unparsable files";
- "-as-map", Arg.Set Clflags.transparent_modules,
- " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)";
- (* "compiler uses -no-alias-deps, and no module is coerced"; *)
- "-debug-map", Arg.Set debug,
+ "-as-map", Arg.Set Clflags.transparent_modules,
+ " Omit delayed dependencies for module aliases (-no-alias-deps -w -49)";
+ (* "compiler uses -no-alias-deps, and no module is coerced"; *)
+ "-debug-map", Arg.Set debug,
" Dump the delayed dependency map for each map file";
- "-I", Arg.String (add_to_list Clflags.include_dirs),
+ "-I", Arg.String (add_to_list Clflags.include_dirs),
"<dir> Add <dir> to the list of include directories";
- "-nocwd", Arg.Set nocwd,
+ "-nocwd", Arg.Set nocwd,
" Do not add current working directory to \
the list of include directories";
- "-impl", Arg.String (add_dep_arg (fun f -> Src (f, Some ML))),
+ "-impl", Arg.String (add_dep_arg (fun f -> Src (f, Some ML))),
"<f> Process <f> as a .ml file";
- "-intf", Arg.String (add_dep_arg (fun f -> Src (f, Some MLI))),
+ "-intf", Arg.String (add_dep_arg (fun f -> Src (f, Some MLI))),
"<f> Process <f> as a .mli file";
- "-map", Arg.String (add_dep_arg (fun f -> Map f)),
+ "-map", Arg.String (add_dep_arg (fun f -> Map f)),
"<f> Read <f> and propagate delayed dependencies to following files";
- "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
+ "-ml-synonym", Arg.String(add_to_synonym_list ml_synonyms),
"<e> Consider <e> as a synonym of the .ml extension";
- "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),
+ "-mli-synonym", Arg.String(add_to_synonym_list mli_synonyms),
"<e> Consider <e> as a synonym of the .mli extension";
- "-modules", Arg.Set raw_dependencies,
+ "-modules", Arg.Set raw_dependencies,
" Print module dependencies in raw form (not suitable for make)";
- "-native", Arg.Set native_only,
+ "-native", Arg.Set native_only,
" Generate dependencies for native-code only (no .cmo files)";
- "-bytecode", Arg.Set bytecode_only,
+ "-bytecode", Arg.Set bytecode_only,
" Generate dependencies for bytecode-code only (no .cmx files)";
- "-one-line", Arg.Set one_line,
+ "-one-line", Arg.Set one_line,
" Output one line per file, regardless of the length";
- "-open", Arg.String (add_to_list Clflags.open_modules),
+ "-open", Arg.String (add_to_list Clflags.open_modules),
"<module> Opens the module <module> before typing";
- "-plugin", Arg.String(fun _p -> Clflags.plugin := true),
-
"<plugin> (no longer supported)";
- "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
- "<cmd> Pipe sources through preprocessor <cmd>";
- "-ppx", Arg.String (add_to_list Compenv.first_ppx),
- "<cmd> Pipe abstract syntax trees through preprocessor <cmd>";
- "-shared", Arg.Set shared,
- " Generate dependencies for native plugin files (.cmxs targets)";
- "-slash", Arg.Set Clflags.force_slash,
- " (Windows) Use forward slash / instead of backslash \\ in file paths";
- "-sort", Arg.Set sort_files,
+ "-plugin", Arg.String(fun _p -> Clflags.plugin := true),
+ "<plugin> (no longer supported)";
+ "-pp", Arg.String(fun s -> Clflags.preprocessor := Some s),
+ "<cmd> Pipe sources through preprocessor <cmd>";
+ "-ppx", Arg.String (add_to_list Compenv.first_ppx),
+ "<cmd> Pipe abstract syntax trees through preprocessor <cmd>";
+ "-shared", Arg.Set shared,
+ " Generate dependencies for native plugin files (.cmxs targets)";
+ "-slash", Arg.Set Clflags.force_slash,
+ " (Windows) Use forward slash / instead of backslash \\ in file paths";
+ "-sort", Arg.Set sort_files,
" Sort files according to their dependencies";
- "-version", Arg.Unit print_version,
- " Print version and exit";
- "-vnum", Arg.Unit print_version_num,
- " Print version number and exit";
- "-args", Arg.Expand Arg.read_arg,
- "<file> Read additional newline separated command line arguments \n\
- \ from <file>";
- "-args0", Arg.Expand Arg.read_arg0,
- "<file> Read additional NUL separated command line arguments from \n\
- \ <file>"
- ];
- let usage =
- Printf.sprintf "Usage: %s [options] <source files>\nOptions are:"
- (Filename.basename Sys.argv.(0))
- in
- Clflags.parse_arguments argv (add_dep_arg (fun f -> Src (f, None))) usage;
- process_dep_args (List.rev !dep_args_rev);
- Compenv.readenv ppf Before_link;
- if !sort_files then sort_files_by_dependencies !files
- else List.iter print_file_dependencies (List.sort compare !files);
- exit (if Error_occurred.get () then 2 else 0)
+ "-version", Arg.Unit print_version,
+ " Print version and exit";
+ "-vnum", Arg.Unit print_version_num,
+ " Print version number and exit";
+ "-args", Arg.Expand Arg.read_arg,
+ "<file> Read additional newline separated command line arguments \n\
+ \ from <file>";
+ "-args0", Arg.Expand Arg.read_arg0,
+ "<file> Read additional NUL separated command line arguments from \n\
+ \ <file>"
+ ];
+ let program = Filename.basename Sys.argv.(0) in
+ Compenv.parse_arguments (ref argv)
+ (add_dep_arg (fun f -> Src (f, None))) program;
+ process_dep_args (List.rev !dep_args_rev);
+ Compenv.readenv ppf Before_link;
+ if !sort_files then sort_files_by_dependencies !files
+ else List.iter print_file_dependencies (List.sort compare !files);
+ (if Error_occurred.get () then 2 else 0)
+ with
+ | Compenv.Exit_with_status n ->
+ n
+ | exn ->
+ Location.report_exception ppf exn;
+ 2
+
let main () =
- run_main Sys.argv
+ exit (run_main Sys.argv)
let main_from_option () =
if Sys.argv.(1) <> "-depend" then begin
Array.concat [ [| Sys.argv.(0) ^ " -depend" |];
Array.sub Sys.argv 2 (Array.length Sys.argv - 2) ] in
Sys.argv.(0) <- args.(0);
- run_main args
+ exit (run_main args)
(** Native compilation backend for .ml files. *)
-let flambda i backend typed =
+let flambda i backend Typedtree.{structure; coercion; _} =
if !Clflags.classic_inlining then begin
Clflags.default_simplify_rounds := 1;
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
Clflags.unbox_free_vars_of_closures := false;
Clflags.unbox_specialised_args := false
end;
- typed
+ (structure, coercion)
|> Profile.(record transl)
(Translmod.transl_implementation_flambda i.module_name)
|> Profile.(record generate)
in
Asmgen.compile_implementation
~backend
- ~filename:i.source_file
~prefixname:i.output_prefix
~middle_end:Flambda_middle_end.lambda_to_clambda
~ppf_dump:i.ppf_dump
program);
Compilenv.save_unit_info (cmx i))
-let clambda i backend typed =
+let clambda i backend Typedtree.{structure; coercion; _} =
Clflags.use_inlining_arguments_set Clflags.classic_arguments;
- typed
+ (structure, coercion)
|> Profile.(record transl)
(Translmod.transl_store_implementation i.module_name)
|> print_if i.ppf_dump Clflags.dump_rawlambda Printlambda.program
|> print_if i.ppf_dump Clflags.dump_lambda Printlambda.program
|> Asmgen.compile_implementation
~backend
- ~filename:i.source_file
~prefixname:i.output_prefix
~middle_end:Closure_middle_end.lambda_to_clambda
~ppf_dump:i.ppf_dump;
val clambda :
Compile_common.info ->
(module Backend_intf.S) ->
- Typedtree.structure * Typedtree.module_coercion -> unit
+ Typedtree.implementation -> unit
(** [clambda info typed] applies the regular compilation pipeline to the
given typechecked implementation and outputs the resulting files.
*)
val flambda :
Compile_common.info ->
(module Backend_intf.S) ->
- Typedtree.structure * Typedtree.module_coercion -> unit
+ Typedtree.implementation -> unit
(** [flambda info backend typed] applies the Flambda compilation pipeline to the
given typechecked implementation and outputs the resulting files.
*)
end
let backend = (module Backend : Backend_intf.S)
-let usage = "Usage: ocamlopt <options> <files>\nOptions are:"
module Options = Main_args.Make_optcomp_options (Main_args.Default.Optmain)
let main argv ppf =
native_code := true;
+ let program = "ocamlopt" in
match
Compenv.readenv ppf Before_args;
Clflags.add_arguments __LOC__ (Arch.command_line_options @ Options.list);
["-depend", Arg.Unit Makedepend.main_from_option,
"<options> Compute dependencies \
(use 'ocamlopt -depend -help' for details)"];
- Clflags.parse_arguments argv Compenv.anonymous usage;
+ Compenv.parse_arguments (ref argv) Compenv.anonymous program;
Compmisc.read_clflags_from_env ();
if !Clflags.plugin then
Compenv.fatal "-plugin is only supported up to OCaml 4.08.0";
with Arg.Bad msg ->
begin
prerr_endline msg;
- Clflags.print_arguments usage;
+ Clflags.print_arguments program;
exit 2
end
end;
(Compenv.get_objfiles ~with_ocamlparam:false) target);
Warnings.check_fatal ();
end
- else if not !Compenv.stop_early && !objfiles <> [] then begin
+ else if not !Compenv.stop_early &&
+ (!objfiles <> [] || !Compenv.has_linker_inputs) then begin
let target =
if !output_c_object then
let s = Compenv.extract_output !output_name in
(copy_files# bytecomp/*.ml{,i})
(copy_files# driver/*.ml{,i})
(copy_files# asmcomp/*.ml{,i})
-(copy_files# asmcomp/debug/*.ml{,i})
(copy_files# file_formats/*.ml{,i})
(copy_files# lambda/*.ml{,i})
(copy_files# middle_end/*.ml{,i})
config build_path_prefix_map misc identifiable numbers arg_helper clflags
profile terminfo ccomp warnings consistbl strongly_connected_components
targetint load_path int_replace_polymorphic_compare binutils local_store
+ lazy_backtrack diffing
;; PARSING
location longident docstrings syntaxerr ast_helper camlinternalMenhirLib
;; TYPING
ident path primitive types btype oprint subst predef datarepr
- cmi_format persistent_env env type_immediacy
+ cmi_format persistent_env env type_immediacy errortrace
typedtree printtyped ctype printtyp includeclass mtype envaux includecore
- tast_iterator tast_mapper cmt_format untypeast includemod
+ tast_iterator tast_mapper signature_group cmt_format untypeast
+ includemod includemod_errorprinter
typetexp patterns printpat parmatch stypes typedecl typeopt rec_check
typecore
typeclass typemod typedecl_variance typedecl_properties typedecl_immediacy
bytegen bytelibrarian bytelink bytepackager emitcode printinstr
;; driver/
- errors compile
+ errors compile maindriver
))
(library
(wrapped false)
(flags (:standard -principal -nostdlib))
(libraries stdlib ocamlcommon ocamlmiddleend)
- (modules_without_implementation x86_ast)
+ (modules_without_implementation x86_ast emitenv)
(modules
;; asmcomp/
afl_instrument arch asmgen asmlibrarian asmlink asmpackager branch_relaxation
branch_relaxation_intf cmm_helpers cmm cmmgen cmmgen_state coloring comballoc
+ cmm_invariants
CSE CSEgen
- deadcode domainstate emit emitaux interf interval linear linearize linscan
+ dataflow deadcode domainstate
+ emit emitaux emitenv
+ interf interval
+ linear linearize linscan
liveness mach printcmm printlinear printmach proc reg reload reloadgen
schedgen scheduling selectgen selection spill split
strmatch x86_ast x86_dsl x86_gas x86_masm x86_proc
- ;; asmcomp/debug/
- reg_availability_set compute_ranges_intf available_regs reg_with_debug_info
- compute_ranges
+ ;; file_formats/
+ linear_format
;; driver/
- optcompile opterrors
+ optcompile opterrors optmaindriver
)
)
#* *
#**************************************************************************
+# #10332: the meaning of character range a-z depends on the locale, so force C
+# locale throughout.
+export LC_ALL=C
echo 'let builtin_exceptions = [|'
tr -d '\r' < "$1" | sed -n -e 's|.*/\* \("[A-Za-z_]*"\) \*/$| \1;|p'
echo '|]'
| Unsafe
type primitive =
- | Pidentity
| Pbytes_to_string
| Pbytes_of_string
| Pignore
- | Prevapply
- | Pdirapply
(* Globals *)
| Pgetglobal of Ident.t
| Psetglobal of Ident.t
| Raise_reraise
| Raise_notrace
-let equal_boxed_integer x y =
- match x, y with
- | Pnativeint, Pnativeint
- | Pint32, Pint32
- | Pint64, Pint64 ->
- true
- | (Pnativeint | Pint32 | Pint64), _ ->
- false
+let equal_boxed_integer = Primitive.equal_boxed_integer
let equal_primitive =
(* Should be implemented like [equal_value_kind] of [equal_boxed_integer],
type function_kind = Curried | Tupled
-type let_kind = Strict | Alias | StrictOpt | Variable
+type let_kind = Strict | Alias | StrictOpt
type meth_kind = Self | Public | Cached
type lambda =
Lvar of Ident.t
+ | Lmutvar of Ident.t
| Lconst of structured_constant
| Lapply of lambda_apply
| Lfunction of lfunction
| Llet of let_kind * value_kind * Ident.t * lambda * lambda
+ | Lmutlet of value_kind * Ident.t * lambda * lambda
| Lletrec of (Ident.t * lambda) list * lambda
| Lprim of primitive * lambda list * scoped_location
| Lswitch of lambda * lambda_switch * scoped_location
incr count ;
if !count > max_raw then raise Not_simple ; (* Too big ! *)
match e with
- | Lvar id ->
+ | Lvar id
+ | Lmutvar id ->
begin
try Ident.find_same id env
with Not_found -> e
let ex = tr_rec env ex in
let y = make_key x in
Llet (str,k,y,ex,tr_rec (Ident.add x (Lvar y) env) e)
+ | Lmutlet (k,x,ex,e) ->
+ let ex = tr_rec env ex in
+ let y = make_key x in
+ Lmutlet (k,y,ex,tr_rec (Ident.add x (Lmutvar y) env) e)
| Lprim (p,es,_) ->
Lprim (p,tr_recs env es, Loc_unknown)
| Lswitch (e,sw,loc) ->
let shallow_iter ~tail ~non_tail:f = function
Lvar _
+ | Lmutvar _
| Lconst _ -> ()
| Lapply{ap_func = fn; ap_args = args} ->
f fn; List.iter f args
| Lfunction{body} ->
f body
- | Llet(_str, _k, _id, arg, body) ->
+ | Llet(_, _k, _id, arg, body)
+ | Lmutlet(_k, _id, arg, body) ->
f arg; tail body
| Lletrec(decl, body) ->
tail body;
List.iter (fun (_id, exp) -> f exp) decl
- | Lprim (Pidentity, [l], _) ->
- tail l
| Lprim (Psequand, [l1; l2], _)
| Lprim (Psequor, [l1; l2], _) ->
f l1;
shallow_iter ~tail:f ~non_tail:f l
let rec free_variables = function
- | Lvar id -> Ident.Set.singleton id
+ | Lvar id
+ | Lmutvar id -> Ident.Set.singleton id
| Lconst _ -> Ident.Set.empty
| Lapply{ap_func = fn; ap_args = args} ->
free_variables_list (free_variables fn) args
| Lfunction{body; params} ->
Ident.Set.diff (free_variables body)
(Ident.Set.of_list (List.map fst params))
- | Llet(_str, _k, id, arg, body) ->
+ | Llet(_, _k, id, arg, body)
+ | Lmutlet(_k, id, arg, body) ->
Ident.Set.union
(free_variables arg)
(Ident.Set.remove id (free_variables body))
to [l]; it is a free variable of the input term. *)
begin try Ident.Map.find id s with Not_found -> lam end
end
+ | Lmutvar id as lam ->
+ begin match Ident.Map.find id l with
+ | id' -> Lmutvar id'
+ | exception Not_found ->
+ (* Note: a mutable [id] should not appear in [s].
+ Keeping the behavior of Lvar case for now. *)
+ begin try Ident.Map.find id s with Not_found -> lam end
+ end
| Lconst _ as l -> l
| Lapply ap ->
Lapply{ap with ap_func = subst s l ap.ap_func;
| Llet(str, k, id, arg, body) ->
let id, l' = bind id l in
Llet(str, k, id, subst s l arg, subst s l' body)
+ | Lmutlet(k, id, arg, body) ->
+ let id, l' = bind id l in
+ Lmutlet(k, id, subst s l arg, subst s l' body)
| Lletrec(decl, body) ->
let decl, l' = bind_many decl l in
Lletrec(List.map (subst_decl s l') decl, subst s l' body)
let shallow_map f = function
| Lvar _
+ | Lmutvar _
| Lconst _ as lam -> lam
| Lapply { ap_func; ap_args; ap_loc; ap_tailcall;
ap_inlined; ap_specialised } ->
Lfunction { kind; params; return; body = f body; attr; loc; }
| Llet (str, k, v, e1, e2) ->
Llet (str, k, v, f e1, f e2)
+ | Lmutlet (k, v, e1, e2) ->
+ Lmutlet (k, v, f e1, f e2)
| Lletrec (idel, e2) ->
Lletrec (List.map (fun (v, e) -> (v, f e)) idel, f e2)
| Lprim (p, el, loc) ->
| Unsafe
type primitive =
- | Pidentity
| Pbytes_to_string
| Pbytes_of_string
| Pignore
- | Prevapply
- | Pdirapply
(* Globals *)
| Pgetglobal of Ident.t
| Psetglobal of Ident.t
type function_kind = Curried | Tupled
-type let_kind = Strict | Alias | StrictOpt | Variable
+type let_kind = Strict | Alias | StrictOpt
(* Meaning of kinds for let x = e in e':
Strict: e may have side-effects; always evaluate e first
(If e is a simple expression, e.g. a variable or constant,
in e'
StrictOpt: e does not have side-effects, but depend on the store;
we can discard e if x does not appear in e'
- Variable: the variable x is assigned later in e'
*)
type meth_kind = Self | Public | Cached
type lambda =
Lvar of Ident.t
+ | Lmutvar of Ident.t
| Lconst of structured_constant
| Lapply of lambda_apply
| Lfunction of lfunction
| Llet of let_kind * value_kind * Ident.t * lambda * lambda
+ | Lmutlet of value_kind * Ident.t * lambda * lambda
| Lletrec of (Ident.t * lambda) list * lambda
| Lprim of primitive * lambda list * scoped_location
| Lswitch of lambda * lambda_switch * scoped_location
{ h with pat_desc = Record (Array.to_list lbl_all) }
| _ -> h
+let bind_alias p id ~arg ~action =
+ let k = Typeopt.value_kind p.pat_env p.pat_type in
+ bind_with_value_kind Alias (id, k) arg action
+
let head_loc ~scopes head =
Scoped_location.of_location ~scopes head.pat_loc
| `Any -> stop p `Any
| `Var (id, s) -> continue p (`Alias (Patterns.omega, id, s))
| `Alias (p, id, _) ->
- let k = Typeopt.value_kind p.pat_env p.pat_type in
aux
( (General.view p, patl),
- bind_with_value_kind Alias (id, k) arg action )
+ bind_alias p id ~arg ~action )
| `Record ([], _) as view -> stop p view
| `Record (lbls, closed) ->
let full_view = `Record (all_record_args lbls, closed) in
val head : pattern -> Patterns.Head.t
val explode_or_pat :
- Half_simple.pattern * Typedtree.pattern list ->
- arg_id:Ident.t option ->
+ arg:lambda ->
+ Half_simple.pattern ->
mk_action:(vars:Ident.t list -> lambda) ->
- vars:Ident.t list ->
- clause list ->
- clause list
- (** If the toplevel pattern is given a name, but the scrutinee is not named
- (i.e. [arg_id = None]), which happens (only) when matching a literal
- tuple, then [Cannot_flatten] is raised. *)
+ patbound_action_vars:Ident.t list ->
+ (pattern * lambda) list
end = struct
include Patterns.Simple
in
{ p with pat_desc }
- let mk_alpha_env arg_id aliases ids =
- List.map
- (fun id ->
- ( id,
- if List.mem id aliases then
- match arg_id with
- | Some v -> v
- | _ -> raise Cannot_flatten
- else
- Ident.create_local (Ident.name id) ))
- ids
+ (* Consider the following matching problem involving a half-simple pattern,
+ with an or-pattern and as-patterns below it:
+
+ match arg, other-args with
+ | (Foo(y, z) as x | Bar(x, y) as z), other-pats -> action[x,y,z]
+
+ (action[x,y,z] is some right-hand-side expression using x, y and z,
+ but we assume that it uses no variables from [other-pats]).
+
+ [explode_or_pat] explodes this into the following:
+
+ match arg, other-args with
+ | Foo(y1, z1), other-pats -> let x1 = arg in action[x1,y1,z1]
+ | Bar(x2, y2), other-pats -> let z2 = arg in action[x2,y2,z2]
+
+ notice that the binding occurrences of x,y,z are alpha-renamed with
+ fresh variables x1,y1,z1 and x2,y2,z2.
- let explode_or_pat ((p : Half_simple.pattern), patl) ~arg_id ~mk_action ~vars
- (rem : clause list) : clause list =
+ We assume that it is fine to duplicate the argument [arg] in each
+ exploded branch; in most cases it is a variable (in which case
+ the bindings [let x1 = arg] are inlined on the fly), except when
+ compiling in [do_for_multiple_match] where it is a tuple of
+ variables.
+ *)
+ let explode_or_pat ~arg (p : Half_simple.pattern)
+ ~mk_action ~patbound_action_vars
+ : (pattern * lambda) list =
let rec explode p aliases rem =
let split_explode p aliases rem = explode (General.view p) aliases rem in
match p.pat_desc with
{ p with pat_desc = `Alias (Patterns.omega, id, str) }
aliases rem
| #view as view ->
- let env = mk_alpha_env arg_id aliases vars in
- ( (alpha env { p with pat_desc = view }, patl),
- mk_action ~vars:(List.map snd env) )
- :: rem
+ (* We are doing two things here:
+ - we freshen the variables of the pattern, to
+ avoid reusing the same identifier in distinct exploded
+ branches
+ - we bind the variables in [aliases] to the argument [arg]
+ (the other variables are bound by [view]); to avoid
+ code duplication if [arg] is itself not a variable, we
+ generate a binding for it, but only if the binding is
+ needed.
+
+ We are careful to avoid binding [arg] if not needed due
+ to the {!do_for_multiple_match} usage, which tries to
+ compile a tuple pattern [match e1, .. en with ...]
+ without allocating the tuple [(e1, .., en)].
+ *)
+ let rec fresh_clause arg_id action_vars renaming_env = function
+ | [] ->
+ let fresh_pat = alpha renaming_env { p with pat_desc = view } in
+ let fresh_action = mk_action ~vars:(List.rev action_vars) in
+ (fresh_pat, fresh_action)
+ | pat_id :: rem_vars ->
+ if not (List.mem pat_id aliases) then begin
+ let fresh_id = Ident.rename pat_id in
+ let action_vars = fresh_id :: action_vars in
+ let renaming_env = ((pat_id, fresh_id) :: renaming_env) in
+ fresh_clause arg_id action_vars renaming_env rem_vars
+ end else begin match arg_id, arg with
+ | Some id, _
+ | None, Lvar id ->
+ let action_vars = id :: action_vars in
+ fresh_clause arg_id action_vars renaming_env rem_vars
+ | None, _ ->
+ (* [pat_id] is a name used locally to refer to the argument,
+ so it makes sense to reuse it (refreshed) *)
+ let id = Ident.rename pat_id in
+ let action_vars = (id :: action_vars) in
+ let pat, action =
+ fresh_clause (Some id) action_vars renaming_env rem_vars
+ in
+ pat, bind_alias pat id ~arg ~action
+ end
+ in
+ fresh_clause None [] [] patbound_action_vars :: rem
in
- explode (p : Half_simple.pattern :> General.pattern) [] rem
+ explode (p : Half_simple.pattern :> General.pattern) [] []
end
let expand_record_simple : Simple.pattern -> Simple.pattern =
let rec flatten_pat_line size p k =
match p.pat_desc with
- | Tpat_any -> Patterns.omegas size :: k
+ | Tpat_any | Tpat_var _ -> Patterns.omegas size :: k
| Tpat_tuple args -> args :: k
| Tpat_or (p1, p2, _) ->
flatten_pat_line size p1 (flatten_pat_line size p2 k)
| Tpat_alias (p, _, _) ->
- (* Note: if this 'as' pat is here, then this is a
- useless binding, solves PR#3780 *)
+ (* Note: we are only called from flatten_matrix,
+ which is itself only ever used in places
+ where variables do not matter (default environments,
+ "provenance", etc.). *)
flatten_pat_line size p k
| _ -> fatal_error "Matching.flatten_pat_line"
pm : initial_clause pattern_matching
}
-type 'head_pat pm_or_compiled = {
+type ('head_pat, 'matrix) pm_or_compiled = {
body : 'head_pat Non_empty_row.t clause pattern_matching;
handlers : handler list;
- or_matrix : matrix
+ or_matrix : 'matrix
}
(* Pattern matching after application of both the or-pat rule and the
mixture rule *)
type pm_half_compiled =
- | PmOr of Simple.pattern pm_or_compiled
+ | PmOr of (Simple.pattern, matrix) pm_or_compiled
| PmVar of { inside : pm_half_compiled }
| Pm of Simple.clause pattern_matching
*)
-let rec split_or ~arg_id (cls : Half_simple.clause list) args def =
+let rec split_or ~arg (cls : Half_simple.clause list) args def =
let rec do_split (rev_before : Simple.clause list) rev_ors rev_no = function
| [] ->
cons_next (List.rev rev_before) (List.rev rev_ors) (List.rev rev_no)
in
match yesor with
| [] -> split_no_or yes args def nexts
- | _ -> precompile_or ~arg_id yes yesor args def nexts
+ | _ -> precompile_or ~arg yes yesor args def nexts
in
do_split [] [] [] cls
cls
and var_def = Default_environment.pop_column def in
let { me = first; matrix }, nexts =
- split_or ~arg_id:(Some v) var_cls var_args var_def
+ split_or ~arg:(Lvar v) var_cls var_args var_def
in
(* Compute top information *)
match nexts with
},
k )
-and precompile_or ~arg_id (cls : Simple.clause list) ors args def k =
+and precompile_or ~arg (cls : Simple.clause list) ors args def k =
+ (* Example: if [cls] is a single-row matrix
+
+ s11 p12 .. p1n -> act1
+
+ and [ors] has three rows
+
+ (s21|s'21) p22 .. p2n -> act2
+ (s31|s'31) p32 .. p3n -> act3
+ s41 p42 .. p4n -> act4
+
+ where the first and second rows start with disjoint or-patterns
+ of simple patterns, binding the variables x2, y2, z2 and x3, y3
+ respectively, we precompile into the following:
+
+ catch
+ ( match arg1 .. argn with
+ | s11 p12 .. p1n -> act1
+ | s21 _ .. _ -> exit 2 x2 y2 z2
+ | s'21 _ .. _ -> exit 2 x2 y2 z2
+ | s31 _ .. _ -> exit 3 x3 y3
+ | s'31 _ .. _ -> exit 3 x3 y3
+ | s41 p42 .. p4n -> act4 )
+ with
+ | exit 2 x2 y2 z2 ->
+ ( match arg2 .. argn with
+ | p22 .. p2n -> act2 )
+ | exit 3 x3 y3 ->
+ ( match arg2 .. argn with
+ | p32 .. p3n -> act3 )
+
+ Note that if arg1 matches s21 or s'21, we exit to a submatrix
+ that will never try any of the following rows; this relies on the
+ disjointness-like properties documented in the {!Or_matrix}
+ module.
+
+ The code below builds this catch/exit structure, The splitting of
+ the or-patterns is done in [Simple.explode_or_pat] -- it turns
+ half-simple clauses into simple clauses.
+ *)
let rec do_cases = function
| [] -> ([], [])
| ((p, patl), action) :: rem -> (
}
in
let pm_fv = pm_free_variables orpm in
- let vars =
- (* bound variables of the or-pattern and used in the orpm
- actions *)
+ let patbound_action_vars =
+ (* variables bound in the or-pattern
+ that are used in the orpm actions *)
Typedtree.pat_bound_idents_full orp
|> List.filter (fun (id, _, _) -> Ident.Set.mem id pm_fv)
|> List.map (fun (id, _, ty) ->
let mk_new_action ~vars =
Lstaticraise (or_num, List.map (fun v -> Lvar v) vars)
in
- let rem_cases, rem_handlers = do_cases rem in
- let cases =
- Simple.explode_or_pat (p, new_patl) ~arg_id
- ~mk_action:mk_new_action ~vars:(List.map fst vars) rem_cases
- in
+ let new_cases =
+ Simple.explode_or_pat ~arg p
+ ~mk_action:mk_new_action
+ ~patbound_action_vars:(List.map fst patbound_action_vars)
+ |> List.map (fun (p, act) -> ((p, new_patl), act)) in
let handler =
{ provenance = [ [ orp ] ];
exit = or_num;
- vars;
+ vars = patbound_action_vars;
pm = orpm
}
in
- (cases, handler :: rem_handlers)
+ let rem_cases, rem_handlers = do_cases rem in
+ (new_cases @ rem_cases, handler :: rem_handlers)
)
in
let cases, handlers = do_cases ors in
dbg_split_and_precompile pm next nexts;
(next, nexts)
-let split_and_precompile_half_simplified ~arg_id pm =
- let { me = next }, nexts = split_or ~arg_id pm.cases pm.args pm.default in
+let split_and_precompile_half_simplified ~arg pm =
+ let { me = next }, nexts = split_or ~arg pm.cases pm.args pm.default in
dbg_split_and_precompile pm next nexts;
(next, nexts)
-let split_and_precompile ~arg_id ~arg_lambda pm =
- let pm =
- { pm with cases = List.map (half_simplify_clause ~arg:arg_lambda) pm.cases }
- in
- split_and_precompile_half_simplified ~arg_id pm
-
(* General divide functions *)
type cell = {
(* Matching against a constructor *)
let get_key_constr = function
- | { pat_desc = Tpat_construct (_, cstr, _) } -> cstr
+ | { pat_desc = Tpat_construct (_, cstr, _, _) } -> cstr
| _ -> assert false
let get_pat_args_constr p rem =
match p with
- | { pat_desc = Tpat_construct (_, _, args) } -> args @ rem
+ | { pat_desc = Tpat_construct (_, _, args, _) } -> args @ rem
| _ -> assert false
let get_expr_args_constr ~scopes head (arg, _mut) rem =
let complete_pats_constrs = function
| constr :: _ as constrs ->
- let tag_of_constr constr =
- constr.pat_desc.cstr_tag in
+ let constr_of_pat cstr_pat =
+ cstr_pat.pat_desc in
let pat_of_constr cstr =
let open Patterns.Head in
to_omega_pattern { constr with pat_desc = Construct cstr } in
List.map pat_of_constr
- (complete_constrs constr (List.map tag_of_constr constrs))
+ (complete_constrs constr (List.map constr_of_pat constrs))
| _ -> assert false
(*
let cases = List.map (half_simplify_nonempty ~arg:newarg) m.cases in
let m = { m with args; cases } in
let first_match, rem =
- split_and_precompile_half_simplified ~arg_id:(Some v) m in
+ split_and_precompile_half_simplified ~arg:newarg m in
combine_handlers ~scopes repr partial ctx (v, str, arg) first_match rem
| _ -> assert false
Lstaticcatch (lambda, (i, []),
failure_handler ~scopes loc ~failer ())
-let compile_matching ~scopes loc ~failer repr arg pat_act_list partial =
- let partial = check_partial pat_act_list partial in
+let toplevel_handler ~scopes loc ~failer partial args cases compile_fun =
match partial with
- | Partial -> (
- let raise_num = next_raise_count () in
- let pm =
- { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
- args = [ (arg, Strict) ];
- default =
- Default_environment.(cons [ [ Patterns.omega ] ] raise_num empty)
- }
- in
- try
- let lambda, total =
- compile_match ~scopes repr partial (Context.start 1) pm in
- check_total ~scopes loc ~failer total lambda raise_num
- with Unused -> assert false
- (* ; handler_fun() *)
- )
| Total ->
- let pm =
- { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
- args = [ (arg, Strict) ];
- default = Default_environment.empty
- }
- in
- let lambda, total =
- compile_match ~scopes repr partial (Context.start 1) pm in
+ let default = Default_environment.empty in
+ let pm = { args; cases; default } in
+ let (lam, total) = compile_fun Total pm in
assert (Jumps.is_empty total);
- lambda
+ lam
+ | Partial ->
+ let raise_num = next_raise_count () in
+ let default =
+ Default_environment.cons [ Patterns.omega_list args ] raise_num
+ Default_environment.empty in
+ let pm = { args; cases; default } in
+ begin match compile_fun Partial pm with
+ | exception Unused -> assert false
+ | (lam, total) ->
+ check_total ~scopes loc ~failer total lam raise_num
+ end
+
+let compile_matching ~scopes loc ~failer repr arg pat_act_list partial =
+ let partial = check_partial pat_act_list partial in
+ let args = [ (arg, Strict) ] in
+ let rows = map_on_rows (fun pat -> (pat, [])) pat_act_list in
+ toplevel_handler ~scopes loc ~failer partial args rows (fun partial pm ->
+ compile_match_nonempty ~scopes repr partial (Context.start 1) pm)
let for_function ~scopes loc repr param pat_act_list partial =
compile_matching ~scopes loc ~failer:Raise_match_failure
let rec map_return f = function
| Llet (str, k, id, l1, l2) -> Llet (str, k, id, l1, map_return f l2)
+ | Lmutlet (k, id, l1, l2) -> Lmutlet (k, id, l1, map_return f l2)
| Lletrec (l1, l2) -> Lletrec (l1, map_return f l2)
| Lifthenelse (lcond, lthen, lelse) ->
Lifthenelse (lcond, map_return f lthen, map_return f lelse)
Option.map (map_return f) def,
loc )
| (Lstaticraise _ | Lprim (Praise _, _, _)) as l -> l
- | ( Lvar _ | Lconst _ | Lapply _ | Lfunction _ | Lsend _ | Lprim _ | Lwhile _
- | Lfor _ | Lassign _ | Lifused _ ) as l ->
+ | ( Lvar _ | Lmutvar _ | Lconst _ | Lapply _ | Lfunction _ | Lsend _ | Lprim _
+ | Lwhile _ | Lfor _ | Lassign _ | Lifused _ ) as l ->
f l
(* The 'opt' reference indicates if the optimization is worthy.
(* Easy case since variables are available *)
let for_tupled_function ~scopes loc paraml pats_act_list partial =
let partial = check_partial_list pats_act_list partial in
- let raise_num = next_raise_count () in
- let omega_params = [ Patterns.omega_list paraml ] in
- let pm =
- { cases = pats_act_list;
- args = List.map (fun id -> (Lvar id, Strict)) paraml;
- default = Default_environment.(cons omega_params raise_num empty)
- }
- in
- try
- let lambda, total =
- compile_match ~scopes None partial
- (Context.start (List.length paraml)) pm
- in
- check_total ~scopes loc ~failer:Raise_match_failure
- total lambda raise_num
- with Unused ->
- failure_handler ~scopes loc ~failer:Raise_match_failure ()
+ let args = List.map (fun id -> (Lvar id, Strict)) paraml in
+ let handler =
+ toplevel_handler ~scopes loc ~failer:Raise_match_failure
+ partial args pats_act_list in
+ handler (fun partial pm ->
+ compile_match ~scopes None partial
+ (Context.start (List.length paraml)) pm
+ )
let flatten_pattern size p =
match p.pat_desc with
{ handler with provenance = flatten_matrix size handler.provenance }
type pm_flattened =
- | FPmOr of pattern pm_or_compiled
+ | FPmOr of (pattern, unit) pm_or_compiled
| FPm of pattern Non_empty_row.t clause pattern_matching
let flatten_precompiled size args pmh =
match pmh with
| Pm pm -> FPm (flatten_pm size args pm)
- | PmOr { body = b; handlers = hs; or_matrix = m } ->
+ | PmOr { body = b; handlers = hs; or_matrix = _ } ->
FPmOr
{ body = flatten_pm size args b;
handlers = List.map (flatten_handler size) hs;
- or_matrix = flatten_matrix size m
+ or_matrix = ();
}
| PmVar _ -> assert false
let do_for_multiple_match ~scopes loc paraml pat_act_list partial =
let repr = None in
- let partial = check_partial pat_act_list partial in
- let raise_num, arg, pm1 =
- let raise_num, default =
- match partial with
- | Partial ->
- let raise_num = next_raise_count () in
- ( raise_num,
- Default_environment.(cons [ [ Patterns.omega ] ] raise_num empty)
- )
- | Total -> (-1, Default_environment.empty)
+ let arg =
+ let sloc = Scoped_location.of_location ~scopes loc in
+ Lprim (Pmakeblock (0, Immutable, None), paraml, sloc) in
+ let handler =
+ let partial = check_partial pat_act_list partial in
+ let rows = map_on_rows (fun p -> (p, [])) pat_act_list in
+ toplevel_handler ~scopes loc ~failer:Raise_match_failure
+ partial [ (arg, Strict) ] rows in
+ handler (fun partial pm1 ->
+ let pm1_half =
+ { pm1 with cases = List.map (half_simplify_nonempty ~arg) pm1.cases }
in
- let loc = Scoped_location.of_location ~scopes loc in
- let arg = Lprim (Pmakeblock (0, Immutable, None), paraml, loc) in
- ( raise_num,
- arg,
- { cases = List.map (fun (pat, act) -> ([ pat ], act)) pat_act_list;
- args = [ (arg, Strict) ];
- default
- } )
- in
- try
- match split_and_precompile ~arg_id:None ~arg_lambda:arg pm1 with
- | exception Cannot_flatten ->
- (* One pattern binds the whole tuple, flattening is not possible.
- We need to allocate the scrutinee. *)
- let lambda, total =
- compile_match ~scopes None partial (Context.start 1) pm1 in
- begin match partial with
- | Partial ->
- check_total ~scopes loc ~failer:Raise_match_failure
- total lambda raise_num
- | Total ->
- assert (Jumps.is_empty total);
- lambda
- end
- | next, nexts ->
- let size = List.length paraml
- and idl = List.map (fun _ -> Ident.create_local "*match*") paraml in
- let args = List.map (fun id -> (Lvar id, Alias)) idl in
- let flat_next = flatten_precompiled size args next
- and flat_nexts =
- List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
- in
- let lam, total =
- comp_match_handlers (compile_flattened ~scopes repr) partial
- (Context.start size) flat_next flat_nexts
- in
- List.fold_right2 (bind Strict) idl paraml
- ( match partial with
- | Partial ->
- check_total ~scopes loc ~failer:Raise_match_failure
- total lam raise_num
- | Total ->
- assert (Jumps.is_empty total);
- lam
- )
- with Unused -> assert false
-
-(* ; partial_function loc () *)
+ let next, nexts = split_and_precompile_half_simplified ~arg pm1_half in
+ let size = List.length paraml
+ and idl = List.map (function
+ | Lvar id -> id
+ | _ -> Ident.create_local "*match*") paraml in
+ let args = List.map (fun id -> (Lvar id, Alias)) idl in
+ let flat_next = flatten_precompiled size args next
+ and flat_nexts =
+ List.map (fun (e, pm) -> (e, flatten_precompiled size args pm)) nexts
+ in
+ let lam, total =
+ comp_match_handlers (compile_flattened ~scopes repr) partial
+ (Context.start size) flat_next flat_nexts
+ in
+ List.fold_right2 (bind Strict) idl paraml lam, total
+ )
(* PR#4828: Believe it or not, the 'paraml' argument below
may not be side effect free. *)
| CFnge -> fprintf ppf "!>=."
let primitive ppf = function
- | Pidentity -> fprintf ppf "id"
| Pbytes_to_string -> fprintf ppf "bytes_to_string"
| Pbytes_of_string -> fprintf ppf "bytes_of_string"
| Pignore -> fprintf ppf "ignore"
- | Prevapply -> fprintf ppf "revapply"
- | Pdirapply -> fprintf ppf "dirapply"
| Pgetglobal id -> fprintf ppf "global %a" Ident.print id
| Psetglobal id -> fprintf ppf "setglobal %a" Ident.print id
| Pmakeblock(tag, Immutable, shape) ->
| Popaque -> fprintf ppf "opaque"
let name_of_primitive = function
- | Pidentity -> "Pidentity"
| Pbytes_of_string -> "Pbytes_of_string"
| Pbytes_to_string -> "Pbytes_to_string"
| Pignore -> "Pignore"
- | Prevapply -> "Prevapply"
- | Pdirapply -> "Pdirapply"
| Pgetglobal _ -> "Pgetglobal"
| Psetglobal _ -> "Psetglobal"
| Pmakeblock _ -> "Pmakeblock"
let rec lam ppf = function
| Lvar id ->
Ident.print ppf id
+ | Lmutvar id ->
+ fprintf ppf "*%a" Ident.print id
| Lconst cst ->
struct_const ppf cst
| Lapply ap ->
fprintf ppf ")" in
fprintf ppf "@[<2>(function%a@ %a%a%a)@]" pr_params params
function_attribute attr return_kind return lam body
- | Llet(str, k, id, arg, body) ->
- let kind = function
- Alias -> "a" | Strict -> "" | StrictOpt -> "o" | Variable -> "v"
+ | Llet(_, k, id, arg, body)
+ | Lmutlet(k, id, arg, body) as l ->
+ let let_kind = begin function
+ | Llet(str,_,_,_,_) ->
+ begin match str with
+ Alias -> "a" | Strict -> "" | StrictOpt -> "o"
+ end
+ | Lmutlet _ -> "mut"
+ | _ -> assert false
+ end
in
let rec letbody = function
- | Llet(str, k, id, arg, body) ->
- fprintf ppf "@ @[<2>%a =%s%a@ %a@]"
- Ident.print id (kind str) value_kind k lam arg;
- letbody body
+ | Llet(_, k, id, arg, body)
+ | Lmutlet(k, id, arg, body) as l ->
+ fprintf ppf "@ @[<2>%a =%s%a@ %a@]"
+ Ident.print id (let_kind l) value_kind k lam arg;
+ letbody body
| expr -> expr in
fprintf ppf "@[<2>(let@ @[<hv 1>(@[<2>%a =%s%a@ %a@]"
- Ident.print id (kind str) value_kind k lam arg;
+ Ident.print id (let_kind l) value_kind k lam arg;
let expr = letbody body in
fprintf ppf ")@]@ %a)@]" lam expr
| Lletrec(id_arg_list, body) ->
let rec eliminate_ref id = function
Lvar v as lam ->
if Ident.same v id then raise Real_reference else lam
- | Lconst _ as lam -> lam
+ | Lmutvar _ | Lconst _ as lam -> lam
| Lapply ap ->
Lapply{ap with ap_func = eliminate_ref id ap.ap_func;
ap_args = List.map (eliminate_ref id) ap.ap_args}
else lam
| Llet(str, kind, v, e1, e2) ->
Llet(str, kind, v, eliminate_ref id e1, eliminate_ref id e2)
+ | Lmutlet(kind, v, e1, e2) ->
+ Lmutlet(kind, v, eliminate_ref id e1, eliminate_ref id e2)
| Lletrec(idel, e2) ->
Lletrec(List.map (fun (v, e) -> (v, eliminate_ref id e)) idel,
eliminate_ref id e2)
| Lprim(Pfield 0, [Lvar v], _) when Ident.same v id ->
- Lvar id
+ Lmutvar id
| Lprim(Psetfield(0, _, _), [Lvar v; e], _) when Ident.same v id ->
Lassign(id, eliminate_ref id e)
| Lprim(Poffsetref delta, [Lvar v], loc) when Ident.same v id ->
- Lassign(id, Lprim(Poffsetint delta, [Lvar id], loc))
+ Lassign(id, Lprim(Poffsetint delta, [Lmutvar id], loc))
| Lprim(p, el, loc) ->
Lprim(p, List.map (eliminate_ref id) el, loc)
| Lswitch(e, sw, loc) ->
(* Count occurrences of (exit n ...) statements *)
let exits = Hashtbl.create 17 in
- let try_depth = ref 0 in
-
let get_exit i =
try Hashtbl.find exits i
with Not_found -> {count = 0; max_depth = 0}
match Hashtbl.find_opt exits i with
| Some r ->
r.count <- r.count + nb;
- r.max_depth <- max r.max_depth d
+ r.max_depth <- Int.max r.max_depth d
| None ->
let r = {count = nb; max_depth = d} in
Hashtbl.add exits i r
in
- let rec count = function
- | (Lvar _| Lconst _) -> ()
- | Lapply ap -> count ap.ap_func; List.iter count ap.ap_args
- | Lfunction {body} -> count body
- | Llet(_str, _kind, _v, l1, l2) ->
- count l2; count l1
+ let rec count ~try_depth = function
+ | (Lvar _| Lmutvar _ | Lconst _) -> ()
+ | Lapply ap ->
+ count ~try_depth ap.ap_func;
+ List.iter (count ~try_depth) ap.ap_args
+ | Lfunction {body} -> count ~try_depth body
+ | Llet(_, _kind, _v, l1, l2)
+ | Lmutlet(_kind, _v, l1, l2) ->
+ count ~try_depth l2; count ~try_depth l1
| Lletrec(bindings, body) ->
- List.iter (fun (_v, l) -> count l) bindings;
- count body
- | Lprim(_p, ll, _) -> List.iter count ll
+ List.iter (fun (_v, l) -> count ~try_depth l) bindings;
+ count ~try_depth body
+ | Lprim(_p, ll, _) -> List.iter (count ~try_depth) ll
| Lswitch(l, sw, _loc) ->
- count_default sw ;
- count l;
- List.iter (fun (_, l) -> count l) sw.sw_consts;
- List.iter (fun (_, l) -> count l) sw.sw_blocks
+ count_default ~try_depth sw ;
+ count ~try_depth l;
+ List.iter (fun (_, l) -> count ~try_depth l) sw.sw_consts;
+ List.iter (fun (_, l) -> count ~try_depth l) sw.sw_blocks
| Lstringswitch(l, sw, d, _) ->
- count l;
- List.iter (fun (_, l) -> count l) sw;
+ count ~try_depth l;
+ List.iter (fun (_, l) -> count ~try_depth l) sw;
begin match d with
| None -> ()
| Some d -> match sw with
- | []|[_] -> count d
- | _ -> count d; count d (* default will get replicated *)
+ | []|[_] -> count ~try_depth d
+ | _ -> (* default will get replicated *)
+ count ~try_depth d; count ~try_depth d
end
- | Lstaticraise (i,ls) -> incr_exit i 1 !try_depth; List.iter count ls
+ | Lstaticraise (i,ls) ->
+ incr_exit i 1 try_depth;
+ List.iter (count ~try_depth) ls
| Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
(* i will be replaced by j in l1, so each occurrence of i in l1
increases j's ref count *)
- count l1 ;
+ count ~try_depth l1 ;
let ic = get_exit i in
- incr_exit j ic.count (max !try_depth ic.max_depth)
+ incr_exit j ic.count (Int.max try_depth ic.max_depth)
| Lstaticcatch(l1, (i,_), l2) ->
- count l1;
+ count ~try_depth l1;
(* If l1 does not contain (exit i),
l2 will be removed, so don't count its exits *)
if (get_exit i).count > 0 then
- count l2
- | Ltrywith(l1, _v, l2) -> incr try_depth; count l1; decr try_depth; count l2
- | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
- | Lsequence(l1, l2) -> count l1; count l2
- | Lwhile(l1, l2) -> count l1; count l2
- | Lfor(_, l1, l2, _dir, l3) -> count l1; count l2; count l3
- | Lassign(_v, l) -> count l
- | Lsend(_k, m, o, ll, _) -> List.iter count (m::o::ll)
- | Levent(l, _) -> count l
- | Lifused(_v, l) -> count l
-
- and count_default sw = match sw.sw_failaction with
+ count ~try_depth l2
+ | Ltrywith(l1, _v, l2) ->
+ count ~try_depth:(try_depth+1) l1;
+ count ~try_depth l2;
+ | Lifthenelse(l1, l2, l3) ->
+ count ~try_depth l1;
+ count ~try_depth l2;
+ count ~try_depth l3
+ | Lsequence(l1, l2) -> count ~try_depth l1; count ~try_depth l2
+ | Lwhile(l1, l2) -> count ~try_depth l1; count ~try_depth l2
+ | Lfor(_, l1, l2, _dir, l3) ->
+ count ~try_depth l1;
+ count ~try_depth l2;
+ count ~try_depth l3
+ | Lassign(_v, l) -> count ~try_depth l
+ | Lsend(_k, m, o, ll, _) -> List.iter (count ~try_depth) (m::o::ll)
+ | Levent(l, _) -> count ~try_depth l
+ | Lifused(_v, l) -> count ~try_depth l
+
+ and count_default ~try_depth sw = match sw.sw_failaction with
| None -> ()
| Some al ->
let nconsts = List.length sw.sw_consts
if
nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
then begin (* default action will occur twice in native code *)
- count al ; count al
+ count ~try_depth al ; count ~try_depth al
end else begin (* default action will occur once *)
assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
- count al
+ count ~try_depth al
end
in
- count lam;
- assert(!try_depth = 0);
+ count ~try_depth:0 lam;
(*
Second pass simplify ``catch body with (i ...) handler''
*)
let subst = Hashtbl.create 17 in
-
- let rec simplif = function
- | (Lvar _|Lconst _) as l -> l
+ let rec simplif ~try_depth = function
+ | (Lvar _| Lmutvar _ | Lconst _) as l -> l
| Lapply ap ->
- Lapply{ap with ap_func = simplif ap.ap_func;
- ap_args = List.map simplif ap.ap_args}
+ Lapply{ap with ap_func = simplif ~try_depth ap.ap_func;
+ ap_args = List.map (simplif ~try_depth) ap.ap_args}
| Lfunction{kind; params; return; body = l; attr; loc} ->
- Lfunction{kind; params; return; body = simplif l; attr; loc}
- | Llet(str, kind, v, l1, l2) -> Llet(str, kind, v, simplif l1, simplif l2)
+ Lfunction{kind; params; return; body = simplif ~try_depth l; attr; loc}
+ | Llet(str, kind, v, l1, l2) ->
+ Llet(str, kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
+ | Lmutlet(kind, v, l1, l2) ->
+ Lmutlet(kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
| Lletrec(bindings, body) ->
- Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
+ Lletrec(List.map (fun (v, l) -> (v, simplif ~try_depth l)) bindings,
+ simplif ~try_depth body)
| Lprim(p, ll, loc) -> begin
- let ll = List.map simplif ll in
+ let ll = List.map (simplif ~try_depth) ll in
match p, ll with
- (* Simplify %revapply, for n-ary functions with n > 1 *)
- | Prevapply, [x; Lapply ap]
- | Prevapply, [x; Levent (Lapply ap,_)] ->
- Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
- | Prevapply, [x; f] ->
- Lapply {
- ap_loc=loc;
- ap_func=f;
- ap_args=[x];
- ap_tailcall=Default_tailcall;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise;
- }
- (* Simplify %apply, for n-ary functions with n > 1 *)
- | Pdirapply, [Lapply ap; x]
- | Pdirapply, [Levent (Lapply ap,_); x] ->
- Lapply {ap with ap_args = ap.ap_args @ [x]; ap_loc = loc}
- | Pdirapply, [f; x] ->
- Lapply {
- ap_loc=loc;
- ap_func=f;
- ap_args=[x];
- ap_tailcall=Default_tailcall;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise;
- }
- (* Simplify %identity *)
- | Pidentity, [e] -> e
-
(* Simplify Obj.with_tag *)
| Pccall { Primitive.prim_name = "caml_obj_with_tag"; _ },
[Lconst (Const_base (Const_int tag));
| _ -> Lprim(p, ll, loc)
end
| Lswitch(l, sw, loc) ->
- let new_l = simplif l
- and new_consts = List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
- and new_blocks = List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
- and new_fail = Option.map simplif sw.sw_failaction in
+ let new_l = simplif ~try_depth l
+ and new_consts =
+ List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_consts
+ and new_blocks =
+ List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_blocks
+ and new_fail = Option.map (simplif ~try_depth) sw.sw_failaction in
Lswitch
(new_l,
{sw with sw_consts = new_consts ; sw_blocks = new_blocks;
loc)
| Lstringswitch(l,sw,d,loc) ->
Lstringswitch
- (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
- Option.map simplif d,loc)
+ (simplif ~try_depth l,List.map (fun (s,l) -> s,simplif ~try_depth l) sw,
+ Option.map (simplif ~try_depth) d,loc)
| Lstaticraise (i,[]) as l ->
begin try
let _,handler = Hashtbl.find subst i in
| Not_found -> l
end
| Lstaticraise (i,ls) ->
- let ls = List.map simplif ls in
+ let ls = List.map (simplif ~try_depth) ls in
begin try
let xs,handler = Hashtbl.find subst i in
let ys = List.map (fun (x, k) -> Ident.rename x, k) xs in
(fun (x, _) (y, _) env -> Ident.Map.add x y env)
xs ys Ident.Map.empty
in
- List.fold_right2
- (fun (y, kind) l r -> Llet (Strict, kind, y, l, r))
- ys ls (Lambda.rename env handler)
+ (* The evaluation order for Lstaticraise arguments is currently
+ right-to-left in all backends.
+ To preserve this, we use fold_left2 instead of fold_right2
+ (the first argument is inserted deepest in the expression,
+ so will be evaluated last).
+ *)
+ List.fold_left2
+ (fun r (y, kind) l -> Llet (Strict, kind, y, l, r))
+ (Lambda.rename env handler) ys ls
with
| Not_found -> Lstaticraise (i,ls)
end
| Lstaticcatch (l1,(i,[]),(Lstaticraise (_j,[]) as l2)) ->
- Hashtbl.add subst i ([],simplif l2) ;
- simplif l1
+ Hashtbl.add subst i ([],simplif ~try_depth l2) ;
+ simplif ~try_depth l1
| Lstaticcatch (l1,(i,xs),l2) ->
let {count; max_depth} = get_exit i in
if count = 0 then
(* Discard staticcatch: not matching exit *)
- simplif l1
- else if count = 1 && max_depth <= !try_depth then begin
+ simplif ~try_depth l1
+ else if
+ count = 1 && max_depth <= try_depth then begin
(* Inline handler if there is a single occurrence and it is not
nested within an inner try..with *)
- assert(max_depth = !try_depth);
- Hashtbl.add subst i (xs,simplif l2);
- simplif l1
+ assert(max_depth = try_depth);
+ Hashtbl.add subst i (xs,simplif ~try_depth l2);
+ simplif ~try_depth l1
end else
- Lstaticcatch (simplif l1, (i,xs), simplif l2)
+ Lstaticcatch (simplif ~try_depth l1, (i,xs), simplif ~try_depth l2)
| Ltrywith(l1, v, l2) ->
- incr try_depth;
- let l1 = simplif l1 in
- decr try_depth;
- Ltrywith(l1, v, simplif l2)
- | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif l1, simplif l2, simplif l3)
- | Lsequence(l1, l2) -> Lsequence(simplif l1, simplif l2)
- | Lwhile(l1, l2) -> Lwhile(simplif l1, simplif l2)
+ let l1 = simplif ~try_depth:(try_depth + 1) l1 in
+ Ltrywith(l1, v, simplif ~try_depth l2)
+ | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif ~try_depth l1,
+ simplif ~try_depth l2, simplif ~try_depth l3)
+ | Lsequence(l1, l2) -> Lsequence(simplif ~try_depth l1, simplif ~try_depth l2)
+ | Lwhile(l1, l2) -> Lwhile(simplif ~try_depth l1, simplif ~try_depth l2)
| Lfor(v, l1, l2, dir, l3) ->
- Lfor(v, simplif l1, simplif l2, dir, simplif l3)
- | Lassign(v, l) -> Lassign(v, simplif l)
+ Lfor(v, simplif ~try_depth l1, simplif ~try_depth l2, dir,
+ simplif ~try_depth l3)
+ | Lassign(v, l) -> Lassign(v, simplif ~try_depth l)
| Lsend(k, m, o, ll, loc) ->
- Lsend(k, simplif m, simplif o, List.map simplif ll, loc)
- | Levent(l, ev) -> Levent(simplif l, ev)
- | Lifused(v, l) -> Lifused (v,simplif l)
+ Lsend(k, simplif ~try_depth m, simplif ~try_depth o,
+ List.map (simplif ~try_depth) ll, loc)
+ | Levent(l, ev) -> Levent(simplif ~try_depth l, ev)
+ | Lifused(v, l) -> Lifused (v,simplif ~try_depth l)
in
- simplif lam
+ simplif ~try_depth:0 lam
(* Compile-time beta-reduction of functions immediately applied:
Lapply(Lfunction(Curried, params, body), args, loc) ->
let rec count bv = function
| Lconst _ -> ()
| Lvar v ->
- use_var bv v 1
+ use_var bv v 1
+ | Lmutvar _ -> ()
| Lapply{ap_func = ll; ap_args = args} ->
let no_opt () = count bv ll; List.iter (count bv) args in
begin match ll with
count (bind_var bv v) l2;
(* If v is unused, l1 will be removed, so don't count its variables *)
if str = Strict || count_var v > 0 then count bv l1
+ | Lmutlet(_kind, _v, l1, l2) ->
+ count bv l1;
+ count bv l2
| Lletrec(bindings, body) ->
List.iter (fun (_v, l) -> count bv l) bindings;
count bv body
(* This (small) optimisation is always legal, it may uncover some
tail call later on. *)
- let mklet str kind v e1 e2 = match e2 with
- | Lvar w when optimize && Ident.same v w -> e1
- | _ -> Llet (str, kind,v,e1,e2) in
+ let mklet str kind v e1 e2 =
+ match e2 with
+ | Lvar w when optimize && Ident.same v w -> e1
+ | _ -> Llet (str, kind,v,e1,e2)
+ in
+ let mkmutlet kind v e1 e2 =
+ match e2 with
+ | Lmutvar w when optimize && Ident.same v w -> e1
+ | _ -> Lmutlet (kind,v,e1,e2)
+ in
let rec simplif = function
Lvar v as l ->
with Not_found ->
l
end
- | Lconst _ as l -> l
+ | Lmutvar _ | Lconst _ as l -> l
| Lapply ({ap_func = ll; ap_args = args} as ap) ->
let no_opt () =
Lapply {ap with ap_func = simplif ap.ap_func;
| Some [field_kind] -> field_kind
| Some _ -> assert false
in
- mklet Variable kind v slinit (eliminate_ref v slbody)
+ mkmutlet kind v slinit (eliminate_ref v slbody)
with Real_reference ->
mklet Strict kind v (Lprim(prim, [slinit], loc)) slbody
end
| _ -> mklet StrictOpt kind v (simplif l1) (simplif l2)
end
| Llet(str, kind, v, l1, l2) -> mklet str kind v (simplif l1) (simplif l2)
+ | Lmutlet(kind, v, l1, l2) -> mkmutlet kind v (simplif l1) (simplif l2)
| Lletrec(bindings, body) ->
Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
| Lprim(p, ll, loc) -> Lprim(p, List.map simplif ll, loc)
let rec emit_tail_infos is_tail lambda =
match lambda with
| Lvar _ -> ()
+ | Lmutvar _ -> ()
| Lconst _ -> ()
| Lapply ap ->
begin
list_emit_tail_infos false ap.ap_args
| Lfunction {body = lam} ->
emit_tail_infos true lam
- | Llet (_str, _k, _, lam, body) ->
+ | Llet (_, _k, _, lam, body)
+ | Lmutlet (_k, _, lam, body) ->
emit_tail_infos false lam;
emit_tail_infos is_tail body
| Lletrec (bindings, body) ->
List.iter (fun (_, lam) -> emit_tail_infos false lam) bindings;
emit_tail_infos is_tail body
- | Lprim (Pidentity, [arg], _) ->
- emit_tail_infos is_tail arg
| Lprim ((Pbytes_to_string | Pbytes_of_string), [arg], _) ->
emit_tail_infos is_tail arg
| Lprim (Psequand, [arg1; arg2], _)
| Lsend _ -> ()
| Lfunction{params} ->
List.iter (fun (param, _) -> fv := Ident.Set.remove param !fv) params
- | Llet(_str, _k, id, _arg, _body) ->
+ | Llet(_, _k, id, _arg, _body)
+ | Lmutlet(_k, id, _arg, _body) ->
fv := Ident.Set.remove id !fv
| Lletrec(decl, _body) ->
List.iter (fun (id, _exp) -> fv := Ident.Set.remove id !fv) decl
| Lfor(v, _e1, _e2, _dir, _e3) ->
fv := Ident.Set.remove v !fv
| Lassign _
- | Lvar _ | Lconst _ | Lapply _
+ | Lvar _ | Lmutvar _ | Lconst _ | Lapply _
| Lprim _ | Lswitch _ | Lstringswitch _ | Lstaticraise _
| Lifthenelse _ | Lsequence _ | Lwhile _
| Levent _ | Lifused _ -> ()
| Bind_value of value_binding list
| Bind_module of Ident.t * string option loc * module_presence * module_expr
-let rec push_defaults loc bindings cases partial =
+let wrap_bindings bindings exp =
+ List.fold_left
+ (fun exp binds ->
+ {exp with exp_desc =
+ match binds with
+ | Bind_value binds -> Texp_let(Nonrecursive, binds, exp)
+ | Bind_module (id, name, pres, mexpr) ->
+ Texp_letmodule (Some id, name, pres, mexpr, exp)})
+ exp bindings
+
+let rec trivial_pat pat =
+ match pat.pat_desc with
+ Tpat_var _
+ | Tpat_any -> true
+ | Tpat_construct (_, cd, [], _) ->
+ not cd.cstr_generalized && cd.cstr_consts = 1 && cd.cstr_nonconsts = 0
+ | Tpat_tuple patl ->
+ List.for_all trivial_pat patl
+ | _ -> false
+
+let rec push_defaults loc bindings use_lhs cases partial =
match cases with
[{c_lhs=pat; c_guard=None;
c_rhs={exp_desc = Texp_function { arg_label; param; cases; partial; } }
- as exp}] ->
- let cases = push_defaults exp.exp_loc bindings cases partial in
+ as exp}] when bindings = [] || trivial_pat pat ->
+ let cases = push_defaults exp.exp_loc bindings false cases partial in
[{c_lhs=pat; c_guard=None;
c_rhs={exp with exp_desc = Texp_function { arg_label; param; cases;
partial; }}}]
| [{c_lhs=pat; c_guard=None;
c_rhs={exp_attributes=[{Parsetree.attr_name = {txt="#default"};_}];
exp_desc = Texp_let
- (Nonrecursive, binds, ({exp_desc = Texp_function _} as e2))}}] ->
- push_defaults loc (Bind_value binds :: bindings)
+ (Nonrecursive, binds,
+ ({exp_desc = Texp_function _} as e2))}}] ->
+ push_defaults loc (Bind_value binds :: bindings) true
[{c_lhs=pat;c_guard=None;c_rhs=e2}]
partial
| [{c_lhs=pat; c_guard=None;
exp_desc = Texp_letmodule
(Some id, name, pres, mexpr,
({exp_desc = Texp_function _} as e2))}}] ->
- push_defaults loc (Bind_module (id, name, pres, mexpr) :: bindings)
+ push_defaults loc (Bind_module (id, name, pres, mexpr) :: bindings) true
[{c_lhs=pat;c_guard=None;c_rhs=e2}]
partial
- | [case] ->
- let exp =
- List.fold_left
- (fun exp binds ->
- {exp with exp_desc =
- match binds with
- | Bind_value binds -> Texp_let(Nonrecursive, binds, exp)
- | Bind_module (id, name, pres, mexpr) ->
- Texp_letmodule (Some id, name, pres, mexpr, exp)})
- case.c_rhs bindings
- in
- [{case with c_rhs=exp}]
+ | [{c_lhs=pat; c_guard=None; c_rhs=exp} as case]
+ when use_lhs || trivial_pat pat && exp.exp_desc <> Texp_unreachable ->
+ [{case with c_rhs = wrap_bindings bindings exp}]
| {c_lhs=pat; c_rhs=exp; c_guard=_} :: _ when bindings <> [] ->
let param = Typecore.name_cases "param" cases in
let desc =
(Path.Pident param, mknoloc (Longident.Lident name), desc)},
cases, partial) }
in
- push_defaults loc bindings
- [{c_lhs={pat with pat_desc = Tpat_var (param, mknoloc name)};
- c_guard=None; c_rhs=exp}]
- Total
+ [{c_lhs = {pat with pat_desc = Tpat_var (param, mknoloc name)};
+ c_guard = None; c_rhs= wrap_bindings bindings exp}]
| _ ->
cases
+let push_defaults loc = push_defaults loc [] false
+
(* Insertion of debugging events *)
let event_before ~scopes exp lam =
let ((kind, params, return), body) =
event_function ~scopes e
(function repr ->
- let pl = push_defaults e.exp_loc [] cases partial in
+ let pl = push_defaults e.exp_loc cases partial in
let return_kind = function_return_value_kind e.exp_env e.exp_type in
transl_curried_function ~scopes e.exp_loc return_kind
repr partial param pl)
let report_error loc = function
| Circular_dependency cycle ->
- let[@manual.ref "s:recursive-modules"] chapter, section = 8, 2 in
+ let[@manual.ref "s:recursive-modules"] chapter, section = 10, 2 in
Location.errorf ~loc ~sub:(List.map explanation_submsg cycle)
"Cannot safely evaluate the definition of the following cycle@ \
of recursively-defined modules:@ %a.@ \
| Send
| Send_self
| Send_cache
+ | Frame_pointers
+ | Identity
+ | Apply
+ | Revapply
let used_primitives = Hashtbl.create 7
let add_used_primitive loc env path =
let primitives_table =
create_hashtable 57 [
- "%identity", Primitive (Pidentity, 1);
+ "%identity", Identity;
"%bytes_to_string", Primitive (Pbytes_to_string, 1);
"%bytes_of_string", Primitive (Pbytes_of_string, 1);
"%ignore", Primitive (Pignore, 1);
- "%revapply", Primitive (Prevapply, 2);
- "%apply", Primitive (Pdirapply, 2);
+ "%revapply", Revapply;
+ "%apply", Apply;
"%loc_LOC", Loc Loc_LOC;
"%loc_FILE", Loc Loc_FILE;
"%loc_LINE", Loc Loc_LINE;
"%ostype_unix", Primitive ((Pctconst Ostype_unix), 1);
"%ostype_win32", Primitive ((Pctconst Ostype_win32), 1);
"%ostype_cygwin", Primitive ((Pctconst Ostype_cygwin), 1);
+ "%frame_pointers", Frame_pointers;
"%negint", Primitive (Pnegint, 1);
"%succint", Primitive ((Poffsetint 1), 1);
"%predint", Primitive ((Poffsetint(-1)), 1);
| Send_self, [obj; meth] ->
Lsend(Self, meth, obj, [], loc)
| Send_cache, [obj; meth; cache; pos] ->
- Lsend(Cached, meth, obj, [cache; pos], loc)
+ (* Cached mode only works in the native backend *)
+ if !Clflags.native_code then
+ Lsend(Cached, meth, obj, [cache; pos], loc)
+ else
+ Lsend(Public, meth, obj, [], loc)
+ | Frame_pointers, [] ->
+ let frame_pointers =
+ if !Clflags.native_code && Config.with_frame_pointers then 1 else 0
+ in
+ Lconst (const_int frame_pointers)
+ | Identity, [arg] -> arg
+ | Apply, [func; arg]
+ | Revapply, [arg; func] ->
+ Lapply {
+ ap_func = func;
+ ap_args = [arg];
+ ap_loc = loc;
+ (* CR-someday lwhite: it would be nice to be able to give
+ application attributes to functions applied with the application
+ operators. *)
+ ap_tailcall = Default_tailcall;
+ ap_inlined = Default_inline;
+ ap_specialised = Default_specialise;
+ }
| (Raise _ | Raise_with_backtrace
| Lazy_force | Loc _ | Primitive _ | Comparison _
- | Send | Send_self | Send_cache), _ ->
+ | Send | Send_self | Send_cache | Frame_pointers | Identity
+ | Apply | Revapply), _ ->
raise(Error(to_location loc, Wrong_arity_builtin_primitive prim_name))
let check_primitive_arity loc p =
| Loc _ -> p.prim_arity = 1 || p.prim_arity = 0
| Send | Send_self -> p.prim_arity = 2
| Send_cache -> p.prim_arity = 4
+ | Frame_pointers -> p.prim_arity = 0
+ | Identity -> p.prim_arity = 1
+ | Apply | Revapply -> p.prim_arity = 2
in
if not ok then raise(Error(loc, Wrong_arity_builtin_primitive p.prim_name))
body; }
let lambda_primitive_needs_event_after = function
- | Prevapply | Pdirapply (* PR#6920 *)
(* We add an event after any primitive resulting in a C call that
may raise an exception or allocate. These are places where we may
collect the call stack. *)
| Pbigstring_set_16 _ | Pbigstring_set_32 _ | Pbigstring_set_64 _
| Pbbswap _ -> true
- | Pidentity | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _
+ | Pbytes_to_string | Pbytes_of_string | Pignore | Psetglobal _
| Pgetglobal _ | Pmakeblock _ | Pfield _ | Pfield_computed | Psetfield _
| Psetfield_computed _ | Pfloatfield _ | Psetfloatfield _ | Praise _
| Psequor | Psequand | Pnot | Pnegint | Paddint | Psubint | Pmulint
| External _ -> true
| Comparison(comp, knd) ->
lambda_primitive_needs_event_after (comparison_primitive comp knd)
- | Lazy_force | Send | Send_self | Send_cache -> true
- | Raise _ | Raise_with_backtrace | Loc _ -> false
+ | Lazy_force | Send | Send_self | Send_cache
+ | Apply | Revapply -> true
+ | Raise _ | Raise_with_backtrace | Loc _ | Frame_pointers | Identity -> false
let transl_primitive_application loc p env ty path exp args arg_exps =
let prim =
ROOTDIR = ..
+# NOTE: it is important that OCAMLLEX is defined *before* Makefile.common
+# gets included, so that its definition here takes precedence
+# over the one there.
+OCAMLLEX ?= $(BOOT_OCAMLLEX)
+
include $(ROOTDIR)/Makefile.common
-CAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
+OCAMLYACCFLAGS = -v
CAMLC = $(BOOT_OCAMLC) -strict-sequence -nostdlib \
-I $(ROOTDIR)/boot -use-prims $(ROOTDIR)/runtime/primitives
-CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -nostdlib -I $(ROOTDIR)/stdlib
-COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+CAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -nostdlib -I $(ROOTDIR)/stdlib
+COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48-70 -warn-error +A \
-safe-string -strict-sequence -strict-formats -bin-annot
LINKFLAGS =
-CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
CAMLDEP = $(BOOT_OCAMLC) -depend
DEPFLAGS = -slash
DEPINCLUDES =
rm -f $(programs) $(programs:=.exe)
rm -f *.cmo *.cmi *.cmx *.cmt *.cmti *.o *.obj
-parser.ml parser.mli: parser.mly
- $(CAMLYACC) -v parser.mly
-
clean::
rm -f parser.ml parser.mli parser.output
beforedepend:: parser.ml parser.mli
-lexer.ml: lexer.mll
- $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
-
clean::
rm -f lexer.ml
beforedepend:: lexer.ml
-.SUFFIXES:
-.SUFFIXES: .ml .cmo .mli .cmi .cmx
-
-.ml.cmo:
+%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) $<
-.mli.cmi:
+%.cmi: %.mli
$(CAMLC) -c $(COMPFLAGS) $<
-.ml.cmx:
+%.cmx: %.ml
$(CAMLOPT) -c $(COMPFLAGS) $<
depend: beforedepend
let copy_chars_unix ic oc start stop =
let n = ref (stop - start) in
while !n > 0 do
- let m = input ic copy_buffer 0 (min !n 1024) in
+ let m = input ic copy_buffer 0 (Int.min !n 1024) in
output oc copy_buffer 0 m;
n := !n - m
done
else if c2' < c1 then
inter l r'
else if c2 < c2' then
- (max c1 c1', c2)::inter r l'
+ (Int.max c1 c1', c2)::inter r l'
else
- (max c1 c1', c2')::inter l r'
+ (Int.max c1 c1', c2')::inter l r'
let rec diff l l' = match l, l' with
_, [] -> l
let id_compare (id1,_) (id2,_) = String.compare id1 id2
-let tag_compare t1 t2 = Stdlib.compare t1 t2
+let tag_compare
+ {id=id1; start=start1; action=action1}
+ {id=id2; start=start2; action=action2} =
+ let c = String.compare id1 id2 in
+ if c <> 0 then c else
+ let c = Bool.compare start1 start2 in
+ if c <> 0 then c else
+ Int.compare action1 action2
module Tags = Set.Make(struct type t = tag_info let compare = tag_compare end)
Alt(reg, Seq(r, Action count)),
(count, m ,act) :: actions,
(succ count),
- max loc_ntags ntags)
+ Int.max loc_ntags ntags)
(Empty, [], 0, 0)
casedef in
r
option is given, specify the name of the
packed object file produced. If the
.B \-output\-obj
+or
+.B \-output\-complete\-obj
option is given,
specify the name of the output file produced.
This can also be used when compiling an interface or implementation
option can also be used to produce a C source file (.c extension) or
a compiled shared/dynamic library (.so extension).
.TP
+.B \-output\-complete\-obj
+Same as
+.B \-output\-obj
+except when creating an object file where it includes the runtime and
+autolink libraries.
+.TP
.B \-pack
Build a bytecode object file (.cmo file) and its associated compiled
interface (.cmi) that combines the object
.IP
The default setting is
-.BR \-w\ +a\-4\-6\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66\-67\-68 .
+.BR \-w\ +a\-4\-7\-9\-27\-29\-30\-32..42\-44\-45\-48\-50\-60\-66..70 .
Note that warnings
.BR 5 \ and \ 10
are not always triggered, depending on the internals of the type checker.
option.
This option can also be used to produce a compiled shared/dynamic
library (.so extension).
+.B \-output\-complete\-obj
+Same as
+.B \-output\-obj
+except the object file produced includes the runtime and
+autolink libraries.
+.TP
.TP
.B \-pack
Build an object file (.cmx and .o files) and its associated compiled
.BR a \ (allocation_policy)
The policy used for allocating in the OCaml heap. Possible values
are 0 for the next-fit policy, 1 for the first-fit
-policy, and 2 for the best-fit policy. Best-fit is still experimental,
-but probably the best of the three. The default is 0.
+policy, and 2 for the best-fit policy. The default is 2.
See the Gc module documentation for details.
.TP
.BR s \ (minor_heap_size)
$(MAKE) -C tests tools
manual: tools
- $(MAKE) -C manual all
+ $(MAKE) -C src all
html: tools
- $(MAKE) -C manual html
+ $(MAKE) -C src html
web: tools
- $(MAKE) -C manual web
+ $(MAKE) -C src web
release:
- $(MAKE) -C manual release
+ $(MAKE) -C src release
# The pregen-etex target generates the latex files from the .etex
# files to ensure that this phase of the manual build process, which
# may execute OCaml fragments and expect certain outputs, is correct
pregen-etex: tools
- $(MAKE) -C manual etex-files
+ $(MAKE) -C src etex-files
# pregen builds both .etex files and the documentation of the standard library
pregen: tools
- $(MAKE) -C manual files
+ $(MAKE) -C src files
.PHONY: tests manual tools
.PHONY: clean
clean:
- $(MAKE) -C manual clean
+ $(MAKE) -C src clean
$(MAKE) -C tools clean
$(MAKE) -C tests clean
.PHONY: distclean
-distclean:
- $(MAKE) -C manual distclean
+distclean: clean
+ $(MAKE) -C src distclean
Prerequisites
-------------
-- Any prerequisites required to build OCaml from sources.
+- Any prerequisites required to build the OCaml compiler from sources.
- A LaTeX installation.
package manager may not do this for you. Run `kpsewhich hevea.sty` to check.
-Building
+Building the manual
--------
-0. Install the OCaml distribution.
+0. Build the OCaml compiler (including the native one) from sources.
-1. Run `make` in the manual.
+You don't need to install the compiler since the manual is built using
+the one from the source tree.
+
+1. Run `make` in the manual directory.
NB: If you already set `LD_LIBRARY_PATH` (OS X: `DYLD_LIBRARY_PATH`)
- in your environment don't forget to add
- `otherlibs/unix:otherlibs/str` to it in an absolute way.
+ in your environment don't forget to append the absolute paths to
+ `otherlibs/unix` and `otherlibs/str` to it.
Outputs
-------
Source files
------------
-The manual is written in an extended dialect of latex and is split in many
-source files. During the build process, the sources files are converted into
-classical latex file using the tools available in `tools`. These files are
-then converted to the different output formats using either latex or hevea.
+The manual is written in an extended dialect of LaTeX and is split across many
+source files. During the build process, these source files are converted into
+classical LaTeX files using the tools available in the `manual/tools`
+directory. These files are then converted to the different output
+formats using either LaTeX or hevea.
Each part of the manual corresponds to a specific directory, and each distinct
chapters (or sometimes sections) are mapped to a distinct `.etex` file:
- Advanced examples with classes and modules: `advexamples.etex`
- Part II, The OCaml language: `refman`
- This part is separated in two very distinct chapters; the
+ This part is divided in two very distinct chapters; the
`OCaml language` chapter and the `Language extensions` chapter.
- The OCaml language: `refman.etex`
This chapter consists in a technical description of the OCaml language.
- Each section of this chapter is mapped to a separated latex file:
+ Each section of this chapter is mapped to a separate LaTeX file:
- `lex.etex`, `values.etex`, `names.etex`, `types.etex`, `const.etex`,
`patterns.etex`, `expr.etex`, `typedecl.etex`, `classes.etex`,
`modtypes.etex`, `compunit.etex`
### Caml environments
-The tool `tools/caml-tex` is used to generate the latex code for the examples
+The tool `tools/caml-tex` is used to generate the LaTeX code for the examples
in the introduction and language extension parts of the manual. It implements
two pseudo-environments: `caml_example` and `caml_eval`.
The pseudo-environment `caml_example` evaluates its contents using an ocaml
interpreter and then translates both the input code and the interpreter output
-to latex code, e.g.
+to LaTeX code, e.g.
```latex
\begin{caml_example}{toplevel}
let f x = x;;
+++ /dev/null
-allfiles.tex
-biblio.tex
-foreword.tex
-version.tex
-warnings.etex
-warnings.tex
-foreword.htex
-manual.html
-webman
+++ /dev/null
-SRC = $(abspath ../..)
-
-export LD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
-export DYLD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
-SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_LIBRARY_PATH)
-
-OCAMLDOC = $(if $(wildcard $(SRC)/ocamldoc/ocamldoc.opt),\
- $(SRC)/ocamldoc/ocamldoc.opt,\
- $(SET_LD_PATH) $(SRC)/runtime/ocamlrun $(SRC)/ocamldoc/ocamldoc)\
- -hide Stdlib -lib Stdlib -nostdlib \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk"
-
-
-# Import the list of mli files for the library docs
-include $(SRC)/ocamldoc/Makefile.docfiles
-
-TEXQUOTE = $(SRC)/runtime/ocamlrun ../tools/texquote2
-
-
-FILES = allfiles.tex biblio.tex foreword.tex version.tex warnings-help.etex
-
-TEXINPUTS = ".:..:../refman:../library:../cmds:../tutorials:../../styles:"
-RELEASE = $$HOME/release/$${RELEASENAME}
-HEVEA = hevea
-HACHA = hacha
-# We suppress warnings in info and text mode (with -s) because hevea listings emit
-# DIV blocks that the text modes do not know how to interpret.
-INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 -s
-HTML_FLAGS = -fix -exec xxdate.exe -O
-TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s
-
-
-manual: files
- cd texstuff \
- && TEXINPUTS=$(TEXINPUTS) pdflatex manual.tex
-
-index:
- cd texstuff \
- && sh ../../tools/fix_index.sh manual.idx \
- && makeindex manual.idx \
- && makeindex manual.kwd.idx
-
-
-# libref/style.css and comilerlibref/style.css are used as witness
-# for the generation of the html stdlib and compilerlibs reference.
-html: htmlman/libref/style.css htmlman/compilerlibref/style.css etex-files
- cd htmlman \
- && $(HEVEA) $(HTML_FLAGS) \
- -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
- -I ../../styles -I ../texstuff \
- manual.hva -e macros.tex ../manual.tex \
- && $(HACHA) -tocter manual.html
-
-htmlman/libref/style.css: style.css $(STDLIB_MLIS) $(DOC_STDLIB_TEXT)
- mkdir -p htmlman/libref
- $(OCAMLDOC) -colorize-code -sort -html \
- -charset "UTF-8" \
- -d htmlman/libref \
- $(DOC_STDLIB_INCLUDES) \
- $(DOC_STDLIB_TEXT:%=-text %) \
- $(STDLIB_MLIS)
- cp style.css $@
-
-COMPILERLIBS_MODULES=$(shell echo $(basename $(notdir $(COMPILERLIBS_MLIS))) \
-| sed "s/\<./\U&/g")
-
-library/compiler_libs.txt: library/compiler_libs.mld
- cp $< $@ && echo "{!modules:$(COMPILERLIBS_MODULES)}" >> $@
-
-
-htmlman/compilerlibref/style.css: library/compiler_libs.txt style.css \
- $(COMPILERLIBS_MLIS)
- mkdir -p htmlman/compilerlibref
- $(OCAMLDOC) -colorize-code -sort -html \
- -charset "UTF-8" \
- -d htmlman/compilerlibref \
- -I $(SRC)/stdlib \
- $(DOC_COMPILERLIBS_INCLUDES) \
- -intro library/compiler_libs.txt \
- library/compiler_libs.txt \
- $(COMPILERLIBS_MLIS)
- cp style.css $@
-
-
-info: files
- cd infoman \
- && rm -f ocaml.info* \
- && $(HEVEA) $(INFO_FLAGS) -o ocaml.info.body \
- -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
- -I ../../styles -I ../texstuff \
- ../manual.inf -e macros.tex ../manual.tex
- cat manual.info.header infoman/ocaml.info.body > infoman/ocaml.info
- cd infoman \
- && rm -f ocaml.info.tmp ocaml.info.body \
- && gzip -9 ocaml.info*
-
-text: files
- cd textman \
- && $(HEVEA) $(TEXT_FLAGS) \
- -I .. -I ../cmds -I ../library -I ../refman -I ../tutorials \
- -I ../../styles -I ../texstuff \
- ../manual.inf -e macros.tex ../manual.tex
-
-
-all:
- $(MAKE) html text info manual
- $(MAKE) manual
- $(MAKE) index
- $(MAKE) manual
-
-release: all
- cp htmlman/manual.html $(RELEASE)refman.html
- rm -f htmlman/manual.{html,haux,hmanual*,htoc}
- tar zcf $(RELEASE)refman-html.tar.gz \
- htmlman/*.* htmlman/libref htmlman/compilerlibref htmlman/fonts
- zip -8 $(RELEASE)refman-html.zip \
- htmlman/*.* htmlman/libref/*.* htmlman/compilerlibref/*.* \
- htmlman/fonts/*.*
- cp texstuff/manual.pdf $(RELEASE)refman.pdf
- cp textman/manual.txt $(RELEASE)refman.txt
- tar cf - infoman/ocaml.info* | gzip > $(RELEASE)refman.info.tar.gz
-
-web: html
- $(MAKE) -C html_processing all
-
-files: $(FILES)
- $(MAKE) -C cmds all
- $(MAKE) -C library all
- $(MAKE) -C refman all
- $(MAKE) -C tutorials all
-
-etex-files: $(FILES)
- $(MAKE) -C cmds etex-files
- $(MAKE) -C library etex-files
- $(MAKE) -C refman etex-files
- $(MAKE) -C tutorials etex-files
-
-
-%.tex: %.etex
- $(TEXQUOTE) < $< > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-version.tex: $(SRC)/VERSION
- sed -n -e '1s/^\([0-9]*\.[0-9]*\).*$$/\\def\\ocamlversion{\1}/p' $< > $@
-
-warnings-help.etex: $(SRC)/utils/warnings.ml $(SRC)/ocamlc
- (echo "% This file is generated from (ocamlc -warn-help)";\
- echo "% according to a rule in manual/manual/Makefile.";\
- echo "% In particular, the reference to documentation sections";\
- echo "% are inserted through the Makefile, which should be updated";\
- echo "% when a new warning is documented.";\
- echo "%";\
- $(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
- | sed -e 's/^ *\([0-9][0-9]*\) *\[\([a-z][a-z-]*\)\]\(.*\)/\\item[\1 "\2"] \3/' \
- -e 's/^ *\([0-9A-Z][0-9]*\) *\([^]].*\)/\\item[\1] \2/'\
- ) >$@
-# sed --inplace is not portable, emulate
- for i in 52 57; do\
- sed\
- s'/\\item\[\('$$i'[^]]*\)\]/\\item\[\1 (see \\ref{ss:warn'$$i'})\]/'\
- $@ > $@.tmp;\
- mv $@.tmp $@;\
- done
-
-
-.PHONY: clean
-clean:
- rm -f $(FILES) *.texquote_error
- $(MAKE) -C cmds clean
- $(MAKE) -C library clean
- $(MAKE) -C refman clean
- $(MAKE) -C tutorials clean
- $(MAKE) -C html_processing clean
- -rm -f texstuff/*
- cd htmlman; rm -rf libref compilerlibref index.html \
- manual*.html *.haux *.hind *.svg
- cd textman; rm -f manual.txt *.haux *.hind
- cd infoman; rm -f ocaml.info ocaml.info-* *.haux *.hind
+++ /dev/null
-\makeindex{\jobname}
-\makeindex{\jobname.kwd}
-
-\setlength{\emergencystretch}{50pt} % pour que TeX resolve les overfull hbox lui-meme
-
-\begin{document}
-
-\thispagestyle{empty}
-\begin{maintitle}
-~\vfill
-\Huge The OCaml system \\
- release \ocamlversion \\[1cm]
-\Large Documentation and user's manual \\[1cm]
-\large Xavier Leroy, \\
- Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon \\[1cm]
- \today \\
- ~
-\vfill
-\normalsize Copyright \copyright\ \number\year\ Institut National de
- Recherche en Informatique et en Automatique
-\end{maintitle}
-\cleardoublepage
-\setcounter{page}{1}
-
-\begin{htmlonly}
-\begin{maintitle}
-\vspace*{2ex}
-This manual is also available in
-\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF},
-\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.txt}{plain text},
-as a
-\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman-html.tar.gz}{bundle of HTML files},
-and as a
-\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.info.tar.gz}{bundle of Emacs Info files}.
-\end{maintitle}
-\end{htmlonly}
-
-\tableofcontents
-
-\input{foreword.tex}
-
-\part{An introduction to OCaml}
-\label{p:tutorials}
-\input{coreexamples.tex}
-\input{moduleexamples.tex}
-\input{objectexamples.tex}
-\input{lablexamples.tex}
-\input{polymorphism.tex}
-\input{advexamples.tex}
-
-\part{The OCaml language}
-\label{p:refman}
-\input{refman.tex}
-\input{exten.tex}
-
-\part{The OCaml tools}
-\label{p:commands}
-
-\input{comp.tex}
-\input{top.tex}
-\input{runtime.tex}
-\input{native.tex}
-\input{lexyacc.tex}
-\input{ocamldep.tex}
-\input{ocamldoc.tex}
-\input{debugger.tex}
-\input{profil.tex}
-\input{intf-c.tex}
-\input{flambda.tex}
-\input{afl-fuzz.tex}
-\input{instrumented-runtime.tex}
-
-\part{The OCaml library}
-\label{p:library}
-\input{core.tex}
-\input{stdlib-blurb.tex}
-\input{compilerlibs.tex}
-\input{libunix.tex}
-\input{libstr.tex}
-\input{libthreads.tex}
-\input{libdynlink.tex}
-\input{old.tex}
-
-\part{Indexes}
-\label{p:indexes}
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/index_modules.html}{Index of modules}
-\item \ahref{libref/index_module_types.html}{Index of module types}
-\item \ahref{libref/index_types.html}{Index of types}
-\item \ahref{libref/index_exceptions.html}{Index of exceptions}
-\item \ahref{libref/index_values.html}{Index of values}
-\end{links}
-\else
-\printindex{\jobname}{Index to the library}
-\fi
-\printindex{\jobname.kwd}{Index of keywords}
-
-\end{document}
+++ /dev/null
-%hevea book class with anchor links in headers
-\input{bookcommon.hva}
-\newcommand{\@book@attr}[1]{\@secid\envclass@attr{#1}}
-\newcommand{\@titlesecanchor}{\@open{a}{class="section-anchor" href="\#\@sec@id@attr" aria-hidden="true"}\@print@u{xfeff}\@close{a}}
-\@makesection
- {\part}{-2}{part}
- {\@opencell{class="center"}{}{}\@open{h1}{\@book@attr{part}}}%
- {\partname~\thepart}{\\}%
- {\@close{h1}\@closecell}
-\newstyle{.part}{margin:2ex auto;text-align:center}
-\@makesection
- {\chapter}{-1}{chapter}
- {\@open{h1}{\@book@attr{chapter}}}{\chaptername~\thechapter}{\quad}{\@close{h1}}
-\@makesection
- {\section}{0}{section}
- {\@open{h2}{\@book@attr{section}}\@titlesecanchor}{\thesection}{\quad}{\@close{h2}}%
-\@makesection
- {\subsection}{1}{subsection}
- {\@open{h3}{\@book@attr{subsection}}\@titlesecanchor}{\thesubsection}{\quad}{\@close{h3}}%
-\@makesection
- {\subsubsection}{2}{subsubsection}
- {\@open{h4}{\@book@attr{subsubsection}}\@titlesecanchor}{\thesubsubsection}{\quad}{\@close{h4}}%
-\@makesection
- {\paragraph}{3}{paragraph}
- {\@open{h5}{\@book@attr{paragraph}}\@titlesecanchor}{\theparagraph}{\quad}{\@close{h5}}%
-\@makesection
- {\subparagraph}{4}{subparagraph}
- {\@open{h6}{\@book@attr{subparagraph}}\@titlesecanchor}{\thesubparagraph}{\quad}{\@close{h6}}%
-\newcommand{\hacha@style}{book}%
-\styleloadedtrue
+++ /dev/null
-\chapter{Further reading}
-
-For the interested reader, we list below some references to books and
-reports related (sometimes loosely) to Caml Light.
-
-\section{Programming in ML}
-
-The books below are programming courses taught in ML. Their main goal
-is to teach programming, not to describe ML in full details --- though
-most contain fairly good introductions to the ML language. Some of
-those books use the Standard ML dialect instead of the Caml dialect,
-so you will have to keep in mind the differences in syntax and in
-semantics.
-
-\begin{itemize}
-
-\item Pierre Weis and Xavier Leroy. {\it Le langage Caml.}
-InterÉditions, 1993.
-
-The natural companion to this manual, provided you read French. This
-book is a step-by-step introduction to programming in Caml, and
-presents many realistic examples of Caml programs.
-
-\item Guy Cousineau and Michel Mauny. {\it Approche fonctionnelle de
-la programmation}. Ediscience, 1995.
-
-Another Caml programming course written in French, with many original
-examples.
-
-\item Lawrence C.\ Paulson. {\it ML for the working programmer.}
-Cambridge University Press, 1991.
-
-A good introduction to programming in Standard ML. Develops a
-theorem prover as a complete example. Contains a presentation of
-the module system of Standard ML.
-
-\item Jeffrey D.\ Ullman. {\it Elements of ML programming.}
-Prentice Hall, 1993.
-
-Another good introduction to programming in Standard ML. No realistic
-examples, but a very detailed presentation of the language constructs.
-
-\item Ryan Stansifer. {\em ML primer.} Prentice-Hall, 1992.
-
-A short, but nice introduction to programming in Standard ML.
-
-\item Thérèse Accart Hardin and Véronique Donzeau-Gouge Viguié. {\em
-Concepts et outils de la programmation. Du fonctionnel à
-l'impératif avec Caml et Ada.} InterÉditions, 1992.
-
-A first course in programming, that first introduces the main programming
-notions in Caml, then shows them underlying Ada. Intended for
-beginners; slow-paced for the others.
-
-\item Rachel Harrison. {\em Abstract Data Types in Standard ML}.
-John Wiley \& Sons, 1993.
-
-A presentation of Standard ML from the standpoint of abstract data
-types. Uses intensively the Standard ML module system.
-
-\item Harold Abelson and Gerald Jay Sussman.
-{\em Structure and Interpretation of Computer Programs.} The MIT
-press, 1985. (French translation: {\em Structure et interprétation
-des programmes informatiques}, InterÉditions, 1989.)
-
-An outstanding course on programming, taught in Scheme, the modern
-dialect of Lisp. Well worth reading, even if you are more interested
-in ML than in Lisp.
-
-\end{itemize}
-
-\section{Descriptions of ML dialects}
-
-The books and reports below are descriptions of various programming
-languages from the ML family. They assume some familiarity with ML.
-
-\begin{itemize}
-
-\item Xavier Leroy and Pierre Weis. {\em Manuel de référence du
-langage Caml.} InterÉditions, 1993.
-
-The French edition of the present reference manual and user's manual.
-
-\item Robert Harper. {\em Introduction to Standard ML.} Technical
-report ECS-LFCS-86-14, University of Edinburgh, 1986.
-
-An overview of Standard ML, including the module system. Terse, but
-still readable.
-
-\item Robin Milner, Mads Tofte and Robert Harper. {\em The definition
-of Standard ML.} The MIT press, 1990.
-
-A complete formal definition of Standard ML, in the framework of
-structured operational semantics. This book is probably the most
-mathematically precise definition of a programming language ever
-written. It is heavy on formalism and extremely terse, so
-even readers who are thoroughly familiar with ML will have
-major difficulties with it.
-
-\item Robin Milner and Mads Tofte. {\em Commentary on Standard ML.}
-The MIT Press, 1991.
-
-A commentary on the book above, that attempts to explain the most
-delicate parts and motivate the design choices. Easier to read than the
-Definition, but still rather involving.
-
-\item Guy Cousineau and Gérard Huet. {\em The CAML primer.} Technical
-report~122, INRIA, 1990.
-
-A short description of the original Caml system, from which Caml Light
-has evolved. Some familiarity with Lisp is assumed.
-
-\item Pierre Weis et al. {\em The CAML reference manual, version
-2.6.1.} Technical report~121, INRIA, 1990.
-
-The manual for the original Caml system, from which Caml Light
-has evolved.
-
-\item Michael J.\ Gordon, Arthur J.\ Milner and Christopher P.\ Wadsworth.
-{\em Edinburgh LCF.} Lecture Notes in Computer Science
-volume~78, Springer-Verlag, 1979.
-
-This is the first published description of the ML language, at the
-time when it was nothing more than the control language for the LCF
-system, a theorem prover. This book is now obsolete, since the ML
-language has much evolved since then; but it is still of historical
-interest.
-
-\item Paul Hudak, Simon Peyton-Jones and Philip Wadler. {\em
-Report on the programming language Haskell, version 1.1.} Technical
-report, Yale University, 1991.
-
-Haskell is a purely functional language with lazy semantics that
-shares many important points with ML (full functionality, polymorphic
-typing), but has interesting features of its own (dynamic overloading,
-also called type classes).
-
-\end{itemize}
-
-\section{Implementing functional programming languages}
-
-The references below are intended for those who are curious to learn
-how a language like Caml Light is compiled and implemented.
-
-\begin{itemize}
-
-\item Xavier Leroy. {\em The ZINC experiment: an economical
-implementation of the ML language.} Technical report~117, INRIA, 1990.
-(Available by anonymous FTP on "ftp.inria.fr".)
-
-A description of the ZINC implementation, the prototype ML
-implementation that has evolved into Caml Light. Large parts of this
-report still apply to the current Caml Light system, in particular the
-description of the execution model and abstract machine. Other parts
-are now obsolete. Yet this report still gives a complete overview of the
-implementation techniques used in Caml Light.
-
-\item Simon Peyton-Jones. {\em The implementation of functional
-programming languages.} Prentice-Hall, 1987. (French translation:
-{\em Mise en \oe uvre des langages fonctionnels de programmation},
-Masson, 1990.)
-
-An excellent description of the implementation of purely functional
-languages with lazy semantics, using the technique known as graph
-reduction. The part of the book that deals with the transformation
-from ML to enriched lambda-calculus directly applies to Caml Light.
-You will find a good description of how pattern-matching is compiled
-and how types are inferred. The remainder of the book does not apply
-directly to Caml Light, since Caml Light is not purely functional (it
-has side-effects), has strict semantics, and does not use graph
-reduction at all.
-
-\item Andrew W.\ Appel. {\em Compiling with continuations.} Cambridge
-University Press, 1992.
-
-A complete description of an optimizing compiler for Standard ML,
-based on an intermediate representation called continuation-passing
-style. Shows how many advanced program optimizations can be applied to
-ML. Not directly relevant to the Caml Light system, since Caml Light
-does not use continuation-passing style at all, and makes little
-attempts at optimizing programs.
-
-\end{itemize}
-
-\section{Applications of ML}
-
-The following reports show ML at work in various, sometimes
-unexpected, areas.
-
-\begin{itemize}
-
-\item Emmanuel Chailloux and Guy Cousineau. {\em The MLgraph primer.}
-Technical report 92-15, École Normale Supérieure, 1992. (Available by
-anonymous FTP on "ftp.ens.fr".)
-%, répertoire "biblio", fichier
-% "liens-92-15.A4.300dpi.ps.Z".)
-
-Describes a Caml Light library that produces Postscript pictures
-through high-level drawing functions.
-
-\item Xavier Leroy. {\em Programmation du système Unix en Caml Light.}
-Technical report~147, INRIA, 1992. (Available by anonymous FTP on
-"ftp.inria.fr".)
-%, répertoire "INRIA/publication", fichier "RT-0147.ps.Z".)
-
-A Unix systems programming course, demonstrating the use of the Caml
-Light library that gives access to Unix system calls.
-
-\item John H.\ Reppy. {\em Concurrent programming with events --- The
-concurrent ML manual.} Cornell University, 1990.
-(Available by anonymous FTP on "research.att.com".)
-%, répertoire "dist/ml", fichier "CML-0.9.8.tar.Z".)
-
-Concurrent ML extends Standard ML of New Jersey with concurrent
-processes that communicate through channels and events.
-
-\item Jeannette M. Wing, Manuel Faehndrich, J.\ Gregory Morrisett and
-Scottt Nettles. {\em Extensions to Standard ML to support
-transactions.} Technical report CMU-CS-92-132, Carnegie-Mellon
-University, 1992. (Available by anonymous FTP on
-"reports.adm.cs.cmu.edu".)
-% , répertoire "1992", fichier "CMU-CS-92-132.ps".)
-
-How to integrate the basic database operations to Standard ML.
-
-\item Emden R.\ Gansner and John H.\ Reppy. {\em eXene.} Bell Labs,
-1991. (Available by anonymous FTP on "research.att.com".)
-%, répertoire "dist/ml", fichier "eXene-0.4.tar.Z".)
-
-An interface between Standard ML of New Jersey and the X Windows
-windowing system.
-
-%% \item Daniel de Rauglaudre. {\em X toolkit in Caml Light.} INRIA,
-%% 1992. (Included in the Caml Light distribution.)
-%% % Disponible par FTP anonyme sur
-%% % "ftp.inria.fr", répertoire "lang/caml-light", fichier "rt5.tar.Z".)
-%%
-%% An interface between Caml Light and the X Windows windowing system.
-
-\end{itemize}
+++ /dev/null
-*.tex
-*.htex
-warnings.etex
+++ /dev/null
-TOPDIR = ../../..
-include $(TOPDIR)/Makefile.tools
-
-LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
-
-TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
- -repo-root $(TOPDIR) -n 80 -v false
-TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
-
-FILES = comp.tex top.tex runtime.tex native.tex lexyacc.tex intf-c.tex \
- ocamldep.tex profil.tex debugger.tex ocamldoc.tex \
- warnings-help.tex flambda.tex \
- afl-fuzz.tex instrumented-runtime.tex unified-options.tex
-
-WITH_TRANSF = top.tex intf-c.tex flambda.tex \
- afl-fuzz.tex lexyacc.tex debugger.tex
-
-WITH_CAMLEXAMPLE = instrumented-runtime.tex ocamldoc.tex
-
-
-etex-files: $(FILES)
-all: $(FILES)
-
-
-%.tex: %.etex
- $(TEXQUOTE) < $< > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-$(WITH_TRANSF): %.tex: %.etex
- $(TRANSF) < $< > $*.transf_error.tex
- mv $*.transf_error.tex $*.transf_gen.tex
- $(TEXQUOTE) < $*.transf_gen.tex > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-$(WITH_CAMLEXAMPLE): %.tex: %.etex
- $(CAMLLATEX) $< -o $*.gen.tex
- $(TRANSF) < $*.gen.tex > $*.transf_error.tex
- mv $*.transf_error.tex $*.transf_gen.tex
- $(TEXQUOTE) < $*.transf_gen.tex > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-warnings-help.etex: ../warnings-help.etex
- cp $< $@
-
-
-.PHONY: clean
-clean:
- rm -f *.tex
- rm -f warnings-help.etex
+++ /dev/null
-\chapter{Fuzzing with afl-fuzz}
-%HEVEA\cutname{afl-fuzz.html}
-
-\section{s:afl-overview}{Overview}
-
-American fuzzy lop (``afl-fuzz'') is a {\em fuzzer}, a tool for
-testing software by providing randomly-generated inputs, searching for
-those inputs which cause the program to crash.
-
-Unlike most fuzzers, afl-fuzz observes the internal behaviour of the
-program being tested, and adjusts the test cases it generates to
-trigger unexplored execution paths. As a result, test cases generated
-by afl-fuzz cover more of the possible behaviours of the tested
-program than other fuzzers.
-
-This requires that programs to be tested are instrumented to
-communicate with afl-fuzz. The native-code compiler ``ocamlopt'' can
-generate such instrumentation, allowing afl-fuzz to be used against
-programs written in OCaml.
-
-For more information on afl-fuzz, see the website at
-\ifouthtml
-\ahref{http://lcamtuf.coredump.cx/afl/}{http://lcamtuf.coredump.cx/afl/}.
-\else
-{\tt http://lcamtuf.coredump.cx/afl/}
-\fi
-
-\section{s:afl-generate}{Generating instrumentation}
-
-The instrumentation that afl-fuzz requires is not generated by
-default, and must be explicitly enabled, by passing the {\tt
- -afl-instrument} option to {\tt ocamlopt}.
-
-To fuzz a large system without modifying build tools, OCaml's {\tt
- configure} script also accepts the {\tt afl-instrument} option. If
-OCaml is configured with {\tt afl-instrument}, then all programs
-compiled by {\tt ocamlopt} will be instrumented.
-
-\subsection{ss:afl-advanced}{Advanced options}
-
-In rare cases, it is useful to control the amount of instrumentation
-generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt
- ocamlopt} with {\tt N} less than 100, instrumentation can be
-generated for only N\% of branches. (See the afl-fuzz documentation on
-the parameter {\tt AFL\_INST\_RATIO} for the precise effect of this).
-
-\section{s:afl-example}{Example}
-
-As an example, we fuzz-test the following program, {\tt readline.ml}:
-
-\begin{verbatim}
-let _ =
- let s = read_line () in
- match Array.to_list (Array.init (String.length s) (String.get s)) with
- ['s'; 'e'; 'c'; 'r'; 'e'; 't'; ' '; 'c'; 'o'; 'd'; 'e'] -> failwith "uh oh"
- | _ -> ()
-\end{verbatim}
-
-There is a single input (the string ``secret code'') which causes this
-program to crash, but finding it by blind random search is infeasible.
-
-Instead, we compile with afl-fuzz instrumentation enabled:
-\begin{verbatim}
-ocamlopt -afl-instrument readline.ml -o readline
-\end{verbatim}
-Next, we run the program under afl-fuzz:
-\begin{verbatim}
-mkdir input
-echo asdf > input/testcase
-mkdir output
-afl-fuzz -i input -o output ./readline
-\end{verbatim}
-By inspecting instrumentation output, the fuzzer finds the crashing input quickly.
+++ /dev/null
-\chapter{Batch compilation (ocamlc)} \label{c:camlc}
-%HEVEA\cutname{comp.html}
-
-This chapter describes the OCaml batch compiler "ocamlc",
-which compiles OCaml source files to bytecode object files and links
-these object files to produce standalone bytecode executable files.
-These executable files are then run by the bytecode interpreter
-"ocamlrun".
-
-\section{s:comp-overview}{Overview of the compiler}
-
-The "ocamlc" command has a command-line interface similar to the one of
-most C compilers. It accepts several types of arguments and processes them
-sequentially, after all options have been processed:
-
-\begin{itemize}
-\item
-Arguments ending in ".mli" are taken to be source files for
-compilation unit interfaces. Interfaces specify the names exported by
-compilation units: they declare value names with their types, define
-public data types, declare abstract data types, and so on. From the
-file \var{x}".mli", the "ocamlc" compiler produces a compiled interface
-in the file \var{x}".cmi".
-
-\item
-Arguments ending in ".ml" are taken to be source files for compilation
-unit implementations. Implementations provide definitions for the
-names exported by the unit, and also contain expressions to be
-evaluated for their side-effects. From the file \var{x}".ml", the "ocamlc"
-compiler produces compiled object bytecode in the file \var{x}".cmo".
-
-If the interface file \var{x}".mli" exists, the implementation
-\var{x}".ml" is checked against the corresponding compiled interface
-\var{x}".cmi", which is assumed to exist. If no interface
-\var{x}".mli" is provided, the compilation of \var{x}".ml" produces a
-compiled interface file \var{x}".cmi" in addition to the compiled
-object code file \var{x}".cmo". The file \var{x}".cmi" produced
-corresponds to an interface that exports everything that is defined in
-the implementation \var{x}".ml".
-
-\item
-Arguments ending in ".cmo" are taken to be compiled object bytecode. These
-files are linked together, along with the object files obtained
-by compiling ".ml" arguments (if any), and the OCaml standard
-library, to produce a standalone executable program. The order in
-which ".cmo" and ".ml" arguments are presented on the command line is
-relevant: compilation units are initialized in that order at
-run-time, and it is a link-time error to use a component of a unit
-before having initialized it. Hence, a given \var{x}".cmo" file must come
-before all ".cmo" files that refer to the unit \var{x}.
-
-\item
-Arguments ending in ".cma" are taken to be libraries of object bytecode.
-A library of object bytecode packs in a single file a set of object
-bytecode files (".cmo" files). Libraries are built with "ocamlc -a"
-(see the description of the "-a" option below). The object files
-contained in the library are linked as regular ".cmo" files (see
-above), in the order specified when the ".cma" file was built. The
-only difference is that if an object file contained in a library is
-not referenced anywhere in the program, then it is not linked in.
-
-\item
-Arguments ending in ".c" are passed to the C compiler, which generates
-a ".o" object file (".obj" under Windows). This object file is linked
-with the program if the "-custom" flag is set (see the description of
-"-custom" below).
-
-\item
-Arguments ending in ".o" or ".a" (".obj" or ".lib" under Windows)
-are assumed to be C object files and libraries. They are passed to the
-C linker when linking in "-custom" mode (see the description of
-"-custom" below).
-
-\item
-Arguments ending in ".so" (".dll" under Windows)
-are assumed to be C shared libraries (DLLs). During linking, they are
-searched for external C functions referenced from the OCaml code,
-and their names are written in the generated bytecode executable.
-The run-time system "ocamlrun" then loads them dynamically at program
-start-up time.
-
-\end{itemize}
-
-The output of the linking phase is a file containing compiled bytecode
-that can be executed by the OCaml bytecode interpreter:
-the command named "ocamlrun". If "a.out" is the name of the file
-produced by the linking phase, the command
-\begin{alltt}
- ocamlrun a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
-\end{alltt}
-executes the compiled code contained in "a.out", passing it as
-arguments the character strings \nth{arg}{1} to \nth{arg}{n}.
-(See chapter~\ref{c:runtime} for more details.)
-
-On most systems, the file produced by the linking
-phase can be run directly, as in:
-\begin{alltt}
- ./a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
-\end{alltt}
-The produced file has the executable bit set, and it manages to launch
-the bytecode interpreter by itself.
-
-The compiler is able to emit some information on its internal stages.
-It can output ".cmt" files for the implementation of the compilation unit
-and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
-description of "-bin-annot" below).
-Each such file contains a typed abstract syntax tree (AST), that is produced
-during the type checking procedure. This tree contains all available information
-about the location and the specific type of each term in the source file.
-The AST is partial if type checking was unsuccessful.
-
-These ".cmt" and ".cmti" files are typically useful for code inspection tools.
-
-\section{s:comp-options}{Options}
-
-The following command-line options are recognized by "ocamlc".
-The options "-pack", "-a", "-c" and "-output-obj" are mutually exclusive.
-% Define boolean variables used by the macros in unified-options.etex
-\newif\ifcomp \comptrue
-\newif\ifnat \natfalse
-\newif\iftop \topfalse
-% unified-options gathers all options across the native/bytecode
-% compilers and toplevel
-\input{unified-options.tex}
-
-\paragraph{contextual-cli-control}{Contextual control of command-line options}
-
-The compiler command line can be modified ``from the outside''
-with the following mechanisms. These are experimental
-and subject to change. They should be used only for experimental and
-development work, not in released packages.
-
-\begin{options}
-\item["OCAMLPARAM" \rm(environment variable)]
-A set of arguments that will be inserted before or after the arguments from
-the command line. Arguments are specified in a comma-separated list
-of "name=value" pairs. A "_" is used to specify the position of
-the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
-executed before parsing the arguments, and "b=y" after. Finally,
-an alternative separator can be specified as the
-first character of the string, within the set ":|; ,".
-\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
-A mapping of file names to lists of arguments that
-will be added to the command line (and "OCAMLPARAM") arguments.
-\item["OCAML_FLEXLINK" \rm(environment variable)]
-Alternative executable to use on native
-Windows for "flexlink" instead of the
-configured value. Primarily used for bootstrapping.
-\end{options}
-
-\section{s:modules-file-system}{Modules and the file system}
-
-This short section is intended to clarify the relationship between the
-names of the modules corresponding to compilation units and the names
-of the files that contain their compiled interface and compiled
-implementation.
-
-The compiler always derives the module name by taking the capitalized
-base name of the source file (".ml" or ".mli" file). That is, it
-strips the leading directory name, if any, as well as the ".ml" or
-".mli" suffix; then, it set the first letter to uppercase, in order to
-comply with the requirement that module names must be capitalized.
-For instance, compiling the file "mylib/misc.ml" provides an
-implementation for the module named "Misc". Other compilation units
-may refer to components defined in "mylib/misc.ml" under the names
-"Misc."\var{name}; they can also do "open Misc", then use unqualified
-names \var{name}.
-
-The ".cmi" and ".cmo" files produced by the compiler have the same
-base name as the source file. Hence, the compiled files always have
-their base name equal (modulo capitalization of the first letter) to
-the name of the module they describe (for ".cmi" files) or implement
-(for ".cmo" files).
-
-When the compiler encounters a reference to a free module identifier
-"Mod", it looks in the search path for a file named "Mod.cmi" or "mod.cmi"
-and loads the compiled interface
-contained in that file. As a consequence, renaming ".cmi" files is not
-advised: the name of a ".cmi" file must always correspond to the name
-of the compilation unit it implements. It is admissible to move them
-to another directory, if their base name is preserved, and the correct
-"-I" options are given to the compiler. The compiler will flag an
-error if it loads a ".cmi" file that has been renamed.
-
-Compiled bytecode files (".cmo" files), on the other hand, can be
-freely renamed once created. That's because the linker never attempts
-to find by itself the ".cmo" file that implements a module with a
-given name: it relies instead on the user providing the list of ".cmo"
-files by hand.
-
-\section{s:comp-errors}{Common errors}
-
-This section describes and explains the most frequently encountered
-error messages.
-
-\begin{options}
-
-\item[Cannot find file \var{filename}]
-The named file could not be found in the current directory, nor in the
-directories of the search path. The \var{filename} is either a
-compiled interface file (".cmi" file), or a compiled bytecode file
-(".cmo" file). If \var{filename} has the format \var{mod}".cmi", this
-means you are trying to compile a file that references identifiers
-from module \var{mod}, but you have not yet compiled an interface for
-module \var{mod}. Fix: compile \var{mod}".mli" or \var{mod}".ml"
-first, to create the compiled interface \var{mod}".cmi".
-
-If \var{filename} has the format \var{mod}".cmo", this
-means you are trying to link a bytecode object file that does not
-exist yet. Fix: compile \var{mod}".ml" first.
-
-If your program spans several directories, this error can also appear
-because you haven't specified the directories to look into. Fix: add
-the correct "-I" options to the command line.
-
-\item[Corrupted compiled interface \var{filename}]
-The compiler produces this error when it tries to read a compiled
-interface file (".cmi" file) that has the wrong structure. This means
-something went wrong when this ".cmi" file was written: the disk was
-full, the compiler was interrupted in the middle of the file creation,
-and so on. This error can also appear if a ".cmi" file is modified after
-its creation by the compiler. Fix: remove the corrupted ".cmi" file,
-and rebuild it.
-
-\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
-This is by far the most common type error in programs. Type \nth{t}{1} is
-the type inferred for the expression (the part of the program that is
-displayed in the error message), by looking at the expression itself.
-Type \nth{t}{2} is the type expected by the context of the expression; it
-is deduced by looking at how the value of this expression is used in
-the rest of the program. If the two types \nth{t}{1} and \nth{t}{2} are not
-compatible, then the error above is produced.
-
-In some cases, it is hard to understand why the two types \nth{t}{1} and
-\nth{t}{2} are incompatible. For instance, the compiler can report that
-``expression of type "foo" cannot be used with type "foo"'', and it
-really seems that the two types "foo" are compatible. This is not
-always true. Two type constructors can have the same name, but
-actually represent different types. This can happen if a type
-constructor is redefined. Example:
-\begin{verbatim}
- type foo = A | B
- let f = function A -> 0 | B -> 1
- type foo = C | D
- f C
-\end{verbatim}
-This result in the error message ``expression "C" of type "foo" cannot
-be used with type "foo"''.
-
-\item[The type of this expression, \var{t}, contains type variables
- that cannot be generalized]
-Type variables ("'a", "'b", \ldots) in a type \var{t} can be in either
-of two states: generalized (which means that the type \var{t} is valid
-for all possible instantiations of the variables) and not generalized
-(which means that the type \var{t} is valid only for one instantiation
-of the variables). In a "let" binding "let "\var{name}" = "\var{expr},
-the type-checker normally generalizes as many type variables as
-possible in the type of \var{expr}. However, this leads to unsoundness
-(a well-typed program can crash) in conjunction with polymorphic
-mutable data structures. To avoid this, generalization is performed at
-"let" bindings only if the bound expression \var{expr} belongs to the
-class of ``syntactic values'', which includes constants, identifiers,
-functions, tuples of syntactic values, etc. In all other cases (for
-instance, \var{expr} is a function application), a polymorphic mutable
-could have been created and generalization is therefore turned off for
-all variables occurring in contravariant or non-variant branches of the
-type. For instance, if the type of a non-value is "'a list" the
-variable is generalizable ("list" is a covariant type constructor),
-but not in "'a list -> 'a list" (the left branch of "->" is
-contravariant) or "'a ref" ("ref" is non-variant).
-
-Non-generalized type variables in a type cause no difficulties inside
-a given structure or compilation unit (the contents of a ".ml" file,
-or an interactive session), but they cannot be allowed inside
-signatures nor in compiled interfaces (".cmi" file), because they
-could be used inconsistently later. Therefore, the compiler
-flags an error when a structure or compilation unit defines a value
-\var{name} whose type contains non-generalized type variables. There
-are two ways to fix this error:
-\begin{itemize}
-\item Add a type constraint or a ".mli" file to give a monomorphic
-type (without type variables) to \var{name}. For instance, instead of
-writing
-\begin{verbatim}
- let sort_int_list = List.sort Stdlib.compare
- (* inferred type 'a list -> 'a list, with 'a not generalized *)
-\end{verbatim}
-write
-\begin{verbatim}
- let sort_int_list = (List.sort Stdlib.compare : int list -> int list);;
-\end{verbatim}
-\item If you really need \var{name} to have a polymorphic type, turn
-its defining expression into a function by adding an extra parameter.
-For instance, instead of writing
-\begin{verbatim}
- let map_length = List.map Array.length
- (* inferred type 'a array list -> int list, with 'a not generalized *)
-\end{verbatim}
-write
-\begin{verbatim}
- let map_length lv = List.map Array.length lv
-\end{verbatim}
-\end{itemize}
-
-\item[Reference to undefined global \var{mod}]
-This error appears when trying to link an incomplete or incorrectly
-ordered set of files. Either you have forgotten to provide an
-implementation for the compilation unit named \var{mod} on the command line
-(typically, the file named \var{mod}".cmo", or a library containing
-that file). Fix: add the missing ".ml" or ".cmo" file to the command
-line. Or, you have provided an implementation for the module named
-\var{mod}, but it comes too late on the command line: the
-implementation of \var{mod} must come before all bytecode object files
-that reference \var{mod}. Fix: change the order of ".ml" and ".cmo"
-files on the command line.
-
-Of course, you will always encounter this error if you have mutually
-recursive functions across modules. That is, function "Mod1.f" calls
-function "Mod2.g", and function "Mod2.g" calls function "Mod1.f".
-In this case, no matter what permutations you perform on the command
-line, the program will be rejected at link-time. Fixes:
-\begin{itemize}
-\item Put "f" and "g" in the same module.
-\item Parameterize one function by the other.
-That is, instead of having
-\begin{verbatim}
-mod1.ml: let f x = ... Mod2.g ...
-mod2.ml: let g y = ... Mod1.f ...
-\end{verbatim}
-define
-\begin{verbatim}
-mod1.ml: let f g x = ... g ...
-mod2.ml: let rec g y = ... Mod1.f g ...
-\end{verbatim}
-and link "mod1.cmo" before "mod2.cmo".
-\item Use a reference to hold one of the two functions, as in :
-\begin{verbatim}
-mod1.ml: let forward_g =
- ref((fun x -> failwith "forward_g") : <type>)
- let f x = ... !forward_g ...
-mod2.ml: let g y = ... Mod1.f ...
- let _ = Mod1.forward_g := g
-\end{verbatim}
-\end{itemize}
-
-\item[The external function \var{f} is not available]
-This error appears when trying to link code that calls external
-functions written in C. As explained in
-chapter~\ref{c:intf-c}, such code must be linked with C libraries that
-implement the required \var{f} C function. If the C libraries in
-question are not shared libraries (DLLs), the code must be linked in
-``custom runtime'' mode. Fix: add the required C libraries to the
-command line, and possibly the "-custom" option.
-
-\end{options}
-
-\section{s:comp-warnings}{Warning reference}
-
-This section describes and explains in detail some warnings:
-
-\subsection{ss:warn9}{Warning 9: missing fields in a record pattern}
-
- When pattern matching on records, it can be useful to match only few
- fields of a record. Eliding fields can be done either implicitly
- or explicitly by ending the record pattern with "; _".
- However, implicit field elision is at odd with pattern matching
- exhaustiveness checks.
- Enabling warning 9 prioritizes exhaustiveness checks over the
- convenience of implicit field elision and will warn on implicit
- field elision in record patterns. In particular, this warning can
- help to spot exhaustive record pattern that may need to be updated
- after the addition of new fields to a record type.
-
-\begin{verbatim}
-type 'a point = {x : 'a; y : 'a}
-let dx { x } = x (* implicit field elision: trigger warning 9 *)
-let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *)
-\end{verbatim}
-
-\subsection{ss:warn52}{Warning 52: fragile constant pattern}
-
- Some constructors, such as the exception constructors "Failure" and
- "Invalid_argument", take as parameter a "string" value holding
- a text message intended for the user.
-
- These text messages are usually not stable over time: call sites
- building these constructors may refine the message in a future
- version to make it more explicit, etc. Therefore, it is dangerous to
- match over the precise value of the message. For example, until
- OCaml 4.02, "Array.iter2" would raise the exception
-\begin{verbatim}
- Invalid_argument "arrays must have the same length"
-\end{verbatim}
- Since 4.03 it raises the more helpful message
-\begin{verbatim}
- Invalid_argument "Array.iter2: arrays must have the same length"
-\end{verbatim}
- but this means that any code of the form
-\begin{verbatim}
- try ...
- with Invalid_argument "arrays must have the same length" -> ...
-\end{verbatim}
- is now broken and may suffer from uncaught exceptions.
-
- Warning 52 is there to prevent users from writing such fragile code
- in the first place. It does not occur on every matching on a literal
- string, but only in the case in which library authors expressed
- their intent to possibly change the constructor parameter value in
- the future, by using the attribute "ocaml.warn_on_literal_pattern"
- (see the manual section on builtin attributes in
- \ref{ss:builtin-attributes}):
-\begin{verbatim}
- type t =
- | Foo of string [@ocaml.warn_on_literal_pattern]
- | Bar of string
-
- let no_warning = function
- | Bar "specific value" -> 0
- | _ -> 1
-
- let warning = function
- | Foo "specific value" -> 0
- | _ -> 1
-
-> | Foo "specific value" -> 0
-> ^^^^^^^^^^^^^^^^
-> Warning 52: Code should not depend on the actual values of
-> this constructor's arguments. They are only for information
-> and may change in future versions. (See manual section 8.5)
-\end{verbatim}
-
- In particular, all built-in exceptions with a string argument have
- this attribute set: "Invalid_argument", "Failure", "Sys_error" will
- all raise this warning if you match for a specific string argument.
-
- Additionally, built-in exceptions with a structured argument that
- includes a string also have the attribute set: "Assert_failure" and
- "Match_failure" will raise the warning for a pattern that uses a
- literal string to match the first element of their tuple argument.
-
- If your code raises this warning, you should {\em not} change the
- way you test for the specific string to avoid the warning (for
- example using a string equality inside the right-hand-side instead
- of a literal pattern), as your code would remain fragile. You should
- instead enlarge the scope of the pattern by matching on all possible
- values.
-
-\begin{verbatim}
-
-let warning = function
- | Foo _ -> 0
- | _ -> 1
-\end{verbatim}
-
- This may require some care: if the scrutinee may return several
- different cases of the same pattern, or raise distinct instances of
- the same exception, you may need to modify your code to separate
- those several cases.
-
- For example,
-\begin{verbatim}
-try (int_of_string count_str, bool_of_string choice_str) with
- | Failure "int_of_string" -> (0, true)
- | Failure "bool_of_string" -> (-1, false)
-\end{verbatim}
- should be rewritten into more atomic tests. For example,
- using the "exception" patterns documented in Section~\ref{sss:exception-match},
- one can write:
-\begin{verbatim}
-match int_of_string count_str with
- | exception (Failure _) -> (0, true)
- | count ->
- begin match bool_of_string choice_str with
- | exception (Failure _) -> (-1, false)
- | choice -> (count, choice)
- end
-\end{verbatim}
-
-The only case where that transformation is not possible is if a given
-function call may raise distinct exceptions with the same constructor
-but different string values. In this case, you will have to check for
-specific string values. This is dangerous API design and it should be
-discouraged: it's better to define more precise exception constructors
-than store useful information in strings.
-
-\subsection{ss:warn57}{Warning 57: Ambiguous or-pattern variables under guard}
-
- The semantics of or-patterns in OCaml is specified with
- a left-to-right bias: a value \var{v} matches the pattern \var{p} "|" \var{q}
- if it matches \var{p} or \var{q}, but if it matches both,
- the environment captured by the match is the environment captured by
- \var{p}, never the one captured by \var{q}.
-
- While this property is generally intuitive, there is at least one specific
- case where a different semantics might be expected.
- Consider a pattern followed by a when-guard:
- "|"~\var{p}~"when"~\var{g}~"->"~\var{e}, for example:
-\begin{verbatim}
- | ((Const x, _) | (_, Const x)) when is_neutral x -> branch
-\end{verbatim}
- The semantics is clear:
- match the scrutinee against the pattern, if it matches, test the guard,
- and if the guard passes, take the branch.
- In particular, consider the input "(Const"~\var{a}", Const"~\var{b}")", where
- \var{a} fails the test "is_neutral"~\var{a}, while \var{b} passes the test
- "is_neutral"~\var{b}. With the left-to-right semantics, the clause above is
- {\em not} taken by its input: matching "(Const"~\var{a}", Const"~\var{b}")"
- against the or-pattern succeeds in the left branch, it returns the
- environment \var{x}~"->"~\var{a}, and then the guard
- "is_neutral"~\var{a} is tested and fails, the branch is not taken.
-
- However, another semantics may be considered more natural here:
- any pair that has one side passing the test will take the branch. With this
- semantics the previous code fragment would be equivalent to
-\begin{verbatim}
- | (Const x, _) when is_neutral x -> branch
- | (_, Const x) when is_neutral x -> branch
-\end{verbatim}
- This is {\em not} the semantics adopted by OCaml.
-
- Warning 57 is dedicated to these confusing cases where the
- specified left-to-right semantics is not equivalent to a non-deterministic
- semantics (any branch can be taken) relatively to a specific guard.
- More precisely, it warns when guard uses ``ambiguous'' variables, that are bound
- to different parts of the scrutinees by different sides of a or-pattern.
+++ /dev/null
-\chapter{The debugger (ocamldebug)} \label{c:debugger}
-%HEVEA\cutname{debugger.html}
-
-This chapter describes the OCaml source-level replay debugger
-"ocamldebug".
-
-\begin{unix} The debugger is available on Unix systems that provide
-BSD sockets.
-\end{unix}
-
-\begin{windows} The debugger is available under the Cygwin port of
-OCaml, but not under the native Win32 ports.
-\end{windows}
-
-\section{s:debugger-compilation}{Compiling for debugging}
-
-Before the debugger can be used, the program must be compiled and
-linked with the "-g" option: all ".cmo" and ".cma" files that are part
-of the program should have been created with "ocamlc -g", and they
-must be linked together with "ocamlc -g".
-
-Compiling with "-g" entails no penalty on the running time of
-programs: object files and bytecode executable files are bigger and
-take longer to produce, but the executable files run at
-exactly the same speed as if they had been compiled without "-g".
-
-\section{s:debugger-invocation}{Invocation}
-
-\subsection{ss:debugger-start}{Starting the debugger}
-
-The OCaml debugger is invoked by running the program
-"ocamldebug" with the name of the bytecode executable file as first
-argument:
-\begin{alltt}
- ocamldebug \optvar{options} \var{program} \optvar{arguments}
-\end{alltt}
-The arguments following \var{program} are optional, and are passed as
-command-line arguments to the program being debugged. (See also the
-"set arguments" command.)
-
-The following command-line options are recognized:
-\begin{options}
-\item["-c " \var{count}]
-Set the maximum number of simultaneously live checkpoints to \var{count}.
-
-\item["-cd " \var{dir}]
-Run the debugger program from the working directory \var{dir},
-instead of the current directory. (See also the "cd" command.)
-
-\item["-emacs"]
-Tell the debugger it is executed under Emacs. (See
-section~\ref{s:inf-debugger} for information on how to run the
-debugger under Emacs.)
-
-\item["-I "\var{directory}]
-Add \var{directory} to the list of directories searched for source
-files and compiled files. (See also the "directory" command.)
-
-\item["-s "\var{socket}]
-Use \var{socket} for communicating with the debugged program. See the
-description of the command "set socket" (section~\ref{ss:debugger-communication})
-for the format of \var{socket}.
-
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-%
-\end{options}
-
-\subsection{ss:debugger-init-file}{Initialization file}
-
-On start-up, the debugger will read commands from an initialization
-file before giving control to the user. The default file is
-".ocamldebug" in the current directory if it exists, otherwise
-".ocamldebug" in the user's home directory.
-
-\subsection{ss:debugger-exut}{Exiting the debugger}
-
-The command "quit" exits the debugger. You can also exit the debugger
-by typing an end-of-file character (usually "ctrl-D").
-
-Typing an interrupt character (usually "ctrl-C") will not exit the
-debugger, but will terminate the action of any debugger command that is in
-progress and return to the debugger command level.
-
-\section{s:debugger-commands}{Commands}
-
-A debugger command is a single line of input. It starts with a command
-name, which is followed by arguments depending on this name. Examples:
-\begin{verbatim}
- run
- goto 1000
- set arguments arg1 arg2
-\end{verbatim}
-
-A command name can be truncated as long as there is no ambiguity. For
-instance, "go 1000" is understood as "goto 1000", since there are no
-other commands whose name starts with "go". For the most frequently
-used commands, ambiguous abbreviations are allowed. For instance, "r"
-stands for "run" even though there are others commands starting with
-"r". You can test the validity of an abbreviation using the "help" command.
-
-If the previous command has been successful, a blank line (typing just
-"RET") will repeat it.
-
-\subsection{ss:debugger-help}{Getting help}
-
-The OCaml debugger has a simple on-line help system, which gives
-a brief description of each command and variable.
-
-\begin{options}
-\item["help"]
-Print the list of commands.
-
-\item["help "\var{command}]
-Give help about the command \var{command}.
-
-\item["help set "\var{variable}, "help show "\var{variable}]
-Give help about the variable \var{variable}. The list of all debugger
-variables can be obtained with "help set".
-
-\item["help info "\var{topic}]
-Give help about \var{topic}. Use "help info" to get a list of known topics.
-\end{options}
-
-\subsection{ss:debugger-state}{Accessing the debugger state}
-
-\begin{options}
-\item["set "\var{variable} \var{value}]
-Set the debugger variable \var{variable} to the value \var{value}.
-
-\item["show "\var{variable}]
-Print the value of the debugger variable \var{variable}.
-
-\item["info "\var{subject}]
-Give information about the given subject.
-For instance, "info breakpoints" will print the list of all breakpoints.
-\end{options}
-
-\section{s:debugger-execution}{Executing a program}
-
-\subsection{ss:debugger-events}{Events}
-
-Events are ``interesting'' locations in the source code, corresponding
-to the beginning or end of evaluation of ``interesting''
-sub-expressions. Events are the unit of single-stepping (stepping goes
-to the next or previous event encountered in the program execution).
-Also, breakpoints can only be set at events. Thus, events play the
-role of line numbers in debuggers for conventional languages.
-
-During program execution, a counter is incremented at each event
-encountered. The value of this counter is referred as the {\em current
-time}. Thanks to reverse execution, it is possible to jump back and
-forth to any time of the execution.
-
-Here is where the debugger events (written \event) are located in
-the source code:
-\begin{itemize}
-\item Following a function application:
-\begin{alltt}
-(f arg)\event
-\end{alltt}
-\item On entrance to a function:
-\begin{alltt}
-fun x y z -> \event ...
-\end{alltt}
-\item On each case of a pattern-matching definition (function,
-"match"\ldots"with" construct, "try"\ldots"with" construct):
-\begin{alltt}
-function pat1 -> \event expr1
- | ...
- | patN -> \event exprN
-\end{alltt}
-\item Between subexpressions of a sequence:
-\begin{alltt}
-expr1; \event expr2; \event ...; \event exprN
-\end{alltt}
-\item In the two branches of a conditional expression:
-\begin{alltt}
-if cond then \event expr1 else \event expr2
-\end{alltt}
-\item At the beginning of each iteration of a loop:
-\begin{alltt}
-while cond do \event body done
-for i = a to b do \event body done
-\end{alltt}
-\end{itemize}
-Exceptions: A function application followed by a function return is replaced
-by the compiler by a jump (tail-call optimization). In this case, no
-event is put after the function application.
-% Also, no event is put after a function application when the function
-% is external (written in C).
-
-\subsection{ss:debugger-starting-program}{Starting the debugged program}
-
-The debugger starts executing the debugged program only when needed.
-This allows setting breakpoints or assigning debugger variables before
-execution starts. There are several ways to start execution:
-\begin{options}
-\item["run"] Run the program until a breakpoint is hit, or the program
-terminates.
-\item["goto 0"] Load the program and stop on the first event.
-\item["goto "\var{time}] Load the program and execute it until the
-given time. Useful when you already know approximately at what time
-the problem appears. Also useful to set breakpoints on function values
-that have not been computed at time 0 (see section~\ref{s:breakpoints}).
-\end{options}
-
-The execution of a program is affected by certain information it
-receives when the debugger starts it, such as the command-line
-arguments to the program and its working directory. The debugger
-provides commands to specify this information ("set arguments" and "cd").
-These commands must be used before program execution starts. If you try
-to change the arguments or the working directory after starting your
-program, the debugger will kill the program (after asking for confirmation).
-
-\subsection{ss:debugger-running}{Running the program}
-
-The following commands execute the program forward or backward,
-starting at the current time. The execution will stop either when
-specified by the command or when a breakpoint is encountered.
-
-\begin{options}
-\item["run"] Execute the program forward from current time. Stops at
-next breakpoint or when the program terminates.
-\item["reverse"] Execute the program backward from current time.
-Mostly useful to go to the last breakpoint encountered before the
-current time.
-\item["step "\optvar{count}] Run the program and stop at the next
-event. With an argument, do it \var{count} times. If \var{count} is 0,
-run until the program terminates or a breakpoint is hit.
-\item["backstep "\optvar{count}] Run the program backward and stop at
-the previous event. With an argument, do it \var{count} times.
-\item["next "\optvar{count}] Run the program and stop at the next
-event, skipping over function calls. With an argument, do it
-\var{count} times.
-\item["previous "\optvar{count}] Run the program backward and stop at
-the previous event, skipping over function calls. With an argument, do
-it \var{count} times.
-\item["finish"] Run the program until the current function returns.
-\item["start"] Run the program backward and stop at the first event
-before the current function invocation.
-\end{options}
-
-\subsection{ss:debugger-time-travel}{Time travel}
-
-You can jump directly to a given time, without stopping on
-breakpoints, using the "goto" command.
-
-As you move through the program, the debugger maintains an history of
-the successive times you stop at. The "last" command can be used to
-revisit these times: each "last" command moves one step back through
-the history. That is useful mainly to undo commands such as "step"
-and "next".
-
-\begin{options}
-\item["goto "\var{time}]
-Jump to the given time.
-\item["last "\optvar{count}]
-Go back to the latest time recorded in the execution history. With an
-argument, do it \var{count} times.
-\item["set history "\var{size}]
-Set the size of the execution history.
-\end{options}
-
-\subsection{ss:debugger-kill}{Killing the program}
-
-\begin{options}
-\item["kill"] Kill the program being executed. This command is mainly
-useful if you wish to recompile the program without leaving the debugger.
-\end{options}
-
-\section{s:breakpoints}{Breakpoints}
-
-A breakpoint causes the program to stop whenever a certain point in
-the program is reached. It can be set in several ways using the
-"break" command. Breakpoints are assigned numbers when set, for
-further reference. The most comfortable way to set breakpoints is
-through the Emacs interface (see section~\ref{s:inf-debugger}).
-
-\begin{options}
-\item["break"]
-Set a breakpoint at the current position in the program execution. The
-current position must be on an event (i.e., neither at the beginning,
-nor at the end of the program).
-
-\item["break "\var{function}]
-Set a breakpoint at the beginning of \var{function}. This works only
-when the functional value of the identifier \var{function} has been
-computed and assigned to the identifier. Hence this command cannot be
-used at the very beginning of the program execution, when all
-identifiers are still undefined; use "goto" \var{time} to advance
-execution until the functional value is available.
-
-\item["break \@" \optvar{module} \var{line}]
-Set a breakpoint in module \var{module} (or in the current module if
-\var{module} is not given), at the first event of line \var{line}.
-
-\item["break \@" \optvar{module} \var{line} \var{column}]
-Set a breakpoint in module \var{module} (or in the current module if
-\var{module} is not given), at the event closest to line \var{line},
-column \var{column}.
-
-\item["break \@" \optvar{module} "#" \var{character}]
-Set a breakpoint in module \var{module} at the event closest to
-character number \var{character}.
-
-\item["break " \var{frag}":"\var{pc}, "break " \var{pc}]
-Set a breakpoint at code address \var{frag}":"\var{pc}. The integer
-\var{frag} is the identifier of a code fragment, a set of modules that
-have been loaded at once, either initially or with the "Dynlink"
-module. The integer \var{pc} is the instruction counter within this
-code fragment. If \var{frag} is omitted, it defaults to 0, which is
-the code fragment of the program loaded initially.
-
-\item["delete "\optvar{breakpoint-numbers}]
-Delete the specified breakpoints. Without argument, all breakpoints
-are deleted (after asking for confirmation).
-
-\item["info breakpoints"] Print the list of all breakpoints.
-\end{options}
-
-\section{s:debugger-callstack}{The call stack}
-
-Each time the program performs a function application, it saves the
-location of the application (the return address) in a block of data
-called a stack frame. The frame also contains the local variables of
-the caller function. All the frames are allocated in a region of
-memory called the call stack. The command "backtrace" (or "bt")
-displays parts of the call stack.
-
-At any time, one of the stack frames is ``selected'' by the debugger; several
-debugger commands refer implicitly to the selected frame. In particular,
-whenever you ask the debugger for the value of a local variable, the
-value is found in the selected frame. The commands "frame", "up" and "down"
-select whichever frame you are interested in.
-
-When the program stops, the debugger automatically selects the
-currently executing frame and describes it briefly as the "frame"
-command does.
-
-\begin{options}
-\item["frame"]
-Describe the currently selected stack frame.
-
-\item["frame" \var{frame-number}]
-Select a stack frame by number and describe it. The frame currently
-executing when the program stopped has number 0; its caller has number
-1; and so on up the call stack.
-
-\item["backtrace "\optvar{count}, "bt "\optvar{count}]
-Print the call stack. This is useful to see which sequence of function
-calls led to the currently executing frame. With a positive argument,
-print only the innermost \var{count} frames.
-With a negative argument, print only the outermost -\var{count} frames.
-
-\item["up" \optvar{count}]
-Select and display the stack frame just ``above'' the selected frame,
-that is, the frame that called the selected frame. An argument says how
-many frames to go up.
-
-\item["down "\optvar{count}]
-Select and display the stack frame just ``below'' the selected frame,
-that is, the frame that was called by the selected frame. An argument
-says how many frames to go down.
-\end{options}
-
-\section{s:debugger-examining-values}{Examining variable values}
-
-The debugger can print the current value of simple expressions. The
-expressions can involve program variables: all the identifiers that
-are in scope at the selected program point can be accessed.
-
-Expressions that can be printed are a subset of OCaml
-expressions, as described by the following grammar:
-\begin{syntax}
-simple-expr:
- lowercase-ident
- | { capitalized-ident '.' } lowercase-ident
- | '*'
- | '$' integer
- | simple-expr '.' lowercase-ident
- | simple-expr '.(' integer ')'
- | simple-expr '.[' integer ']'
- | '!' simple-expr
- | '(' simple-expr ')'
-\end{syntax}
-The first two cases refer to a value identifier, either unqualified or
-qualified by the path to the structure that define it.
-"*" refers to the result just computed (typically, the value of a
-function application), and is valid only if the selected event is an
-``after'' event (typically, a function application).
-@'$' integer@ refer to a previously printed value. The remaining four
-forms select part of an expression: respectively, a record field, an
-array element, a string element, and the current contents of a
-reference.
-
-\begin{options}
-\item["print "\var{variables}]
-Print the values of the given variables. "print" can be abbreviated as
-"p".
-\item["display "\var{variables}]
-Same as "print", but limit the depth of printing to 1. Useful to
-browse large data structures without printing them in full.
-"display" can be abbreviated as "d".
-\end{options}
-
-When printing a complex expression, a name of the form "$"\var{integer}
-is automatically assigned to its value. Such names are also assigned
-to parts of the value that cannot be printed because the maximal
-printing depth is exceeded. Named values can be printed later on
-with the commands "p $"\var{integer} or "d $"\var{integer}.
-Named values are valid only as long as the program is stopped. They
-are forgotten as soon as the program resumes execution.
-
-\begin{options}
-\item["set print_depth" \var{d}]
-Limit the printing of values to a maximal depth of \var{d}.
-\item["set print_length" \var{l}]
-Limit the printing of values to at most \var{l} nodes printed.
-\end{options}
-
-\section{s:debugger-control}{Controlling the debugger}
-
-\subsection{ss:debugger-name-and-arguments}{Setting the program name and arguments}
-
-\begin{options}
-\item["set program" \var{file}]
-Set the program name to \var{file}.
-\item["set arguments" \var{arguments}]
-Give \var{arguments} as command-line arguments for the program.
-\end{options}
-
-A shell is used to pass the arguments to the debugged program. You can
-therefore use wildcards, shell variables, and file redirections inside
-the arguments. To debug programs that read from standard input, it is
-recommended to redirect their input from a file (using
-"set arguments < input-file"), otherwise input to the program and
-input to the debugger are not properly separated, and inputs are not
-properly replayed when running the program backwards.
-
-\subsection{ss:debugger-loading}{How programs are loaded}
-
-The "loadingmode" variable controls how the program is executed.
-
-\begin{options}
-\item["set loadingmode direct"]
-The program is run directly by the debugger. This is the default mode.
-\item["set loadingmode runtime"]
-The debugger execute the OCaml runtime "ocamlrun" on the program.
-Rarely useful; moreover it prevents the debugging of programs compiled
-in ``custom runtime'' mode.
-\item["set loadingmode manual"]
-The user starts manually the program, when asked by the debugger.
-Allows remote debugging (see section~\ref{ss:debugger-communication}).
-\end{options}
-
-\subsection{ss:debugger-search-path}{Search path for files}
-
-The debugger searches for source files and compiled interface files in
-a list of directories, the search path. The search path initially
-contains the current directory "." and the standard library directory.
-The "directory" command adds directories to the path.
-
-Whenever the search path is modified, the debugger will clear any
-information it may have cached about the files.
-
-\begin{options}
-\item["directory" \var{directorynames}]
-Add the given directories to the search path. These directories are
-added at the front, and will therefore be searched first.
-
-\item["directory" \var{directorynames} "for" \var{modulename}]
-Same as "directory" \var{directorynames}, but the given directories will be
-searched only when looking for the source file of a module that has
-been packed into \var{modulename}.
-
-\item["directory"]
-Reset the search path. This requires confirmation.
-\end{options}
-
-\subsection{ss:debugger-working-dir}{Working directory}
-
-Each time a program is started in the debugger, it inherits its working
-directory from the current working directory of the debugger. This
-working directory is initially whatever it inherited from its parent
-process (typically the shell), but you can specify a new working
-directory in the debugger with the "cd" command or the "-cd"
-command-line option.
-
-\begin{options}
-\item["cd" \var{directory}]
-Set the working directory for "ocamldebug" to \var{directory}.
-
-\item["pwd"]
-Print the working directory for "ocamldebug".
-\end{options}
-
-\subsection{ss:debugger-reverse-execution}{Turning reverse execution on and off}
-
-In some cases, you may want to turn reverse execution off. This speeds
-up the program execution, and is also sometimes useful for interactive
-programs.
-
-Normally, the debugger takes checkpoints of the program state from
-time to time. That is, it makes a copy of the current state of the
-program (using the Unix system call "fork"). If the variable
-\var{checkpoints} is set to "off", the debugger will not take any
-checkpoints.
-
-\begin{options}
-\item["set checkpoints" \var{on/off}]
-Select whether the debugger makes checkpoints or not.
-\end{options}
-
-\subsection{ss:debugger-fork}{Behavior of the debugger with respect to "fork"}
-
-When the program issues a call to "fork", the debugger can either
-follow the child or the parent. By default, the debugger follows the
-parent process. The variable \var{follow_fork_mode} controls this
-behavior:
-
-\begin{options}
-\item["set follow_fork_mode" \var{child/parent}]
-Select whether to follow the child or the parent in case of a call to
-"fork".
-\end{options}
-
-\subsection{ss:debugger-stop-at-new-load}{Stopping execution when new code is loaded}
-
-The debugger is compatible with the "Dynlink" module. However, when an
-external module is not yet loaded, it is impossible to set a
-breakpoint in its code. In order to facilitate setting breakpoints in
-dynamically loaded code, the debugger stops the program each time new
-modules are loaded. This behavior can be disabled using the
-\var{break_on_load} variable:
-
-\begin{options}
-\item["set break_on_load" \var{on/off}]
-Select whether to stop after loading new code.
-\end{options}
-
-\subsection{ss:debugger-communication}{Communication between the debugger and the program}
-
-The debugger communicate with the program being debugged through a
-Unix socket. You may need to change the socket name, for example if
-you need to run the debugger on a machine and your program on another.
-
-\begin{options}
-\item["set socket" \var{socket}]
-Use \var{socket} for communication with the program. \var{socket} can be
-either a file name, or an Internet port specification
-\var{host}:\var{port}, where \var{host} is a host name or an Internet
-address in dot notation, and \var{port} is a port number on the host.
-\end{options}
-
-On the debugged program side, the socket name is passed through the
-"CAML_DEBUG_SOCKET" environment variable.
-
-\subsection{ss:debugger-fine-tuning}{Fine-tuning the debugger}
-
-Several variables enables to fine-tune the debugger. Reasonable
-defaults are provided, and you should normally not have to change them.
-
-\begin{options}
-\item["set processcount" \var{count}]
-Set the maximum number of checkpoints to \var{count}. More checkpoints
-facilitate going far back in time, but use more memory and create more
-Unix processes.
-\end{options}
-
-As checkpointing is quite expensive, it must not be done too often. On
-the other hand, backward execution is faster when checkpoints are
-taken more often. In particular, backward single-stepping is more
-responsive when many checkpoints have been taken just before the
-current time. To fine-tune the checkpointing strategy, the debugger
-does not take checkpoints at the same frequency for long displacements
-(e.g. "run") and small ones (e.g. "step"). The two variables "bigstep"
-and "smallstep" contain the number of events between two checkpoints
-in each case.
-
-\begin{options}
-\item["set bigstep" \var{count}]
-Set the number of events between two checkpoints for long displacements.
-\item["set smallstep" \var{count}]
-Set the number of events between two checkpoints for small
-displacements.
-\end{options}
-
-The following commands display information on checkpoints and events:
-
-\begin{options}
-\item["info checkpoints"]
-Print a list of checkpoints.
-\item["info events" \optvar{module}]
-Print the list of events in the given module (the current module, by default).
-\end{options}
-
-\subsection{ss:debugger-printers}{User-defined printers}
-
-Just as in the toplevel system (section~\ref{s:toplevel-directives}),
-the user can register functions for printing values of certain types.
-For technical reasons, the debugger cannot call printing functions
-that reside in the program being debugged. The code for the printing
-functions must therefore be loaded explicitly in the debugger.
-
-\begin{options}
-\item["load_printer \""\var{file-name}"\""]
-Load in the debugger the indicated ".cmo" or ".cma" object file. The
-file is loaded in an environment consisting only of the OCaml
-standard library plus the definitions provided by object files
-previously loaded using "load_printer". If this file depends on other
-object files not yet loaded, the debugger automatically loads them if
-it is able to find them in the search path. The loaded file does not
-have direct access to the modules of the program being debugged.
-
-\item["install_printer "\var{printer-name}]
-Register the function named \var{printer-name} (a
-value path) as a printer for objects whose types match the argument
-type of the function. That is, the debugger will call
-\var{printer-name} when it has such an object to print.
-The printing function \var{printer-name} must use the "Format" library
-module to produce its output, otherwise its output will not be
-correctly located in the values printed by the toplevel loop.
-
-The value path \var{printer-name} must refer to one of the functions
-defined by the object files loaded using "load_printer". It cannot
-reference the functions of the program being debugged.
-
-\item["remove_printer "\var{printer-name}]
-Remove the named function from the table of value printers.
-\end{options}
-
-\section{s:debugger-misc-cmds}{Miscellaneous commands}
-
-\begin{options}
-\item["list" \optvar{module} \optvar{beginning} \optvar{end}]
-List the source of module \var{module}, from line number
-\var{beginning} to line number \var{end}. By default, 20 lines of the
-current module are displayed, starting 10 lines before the current
-position.
-\item["source" \var{filename}]
-Read debugger commands from the script \var{filename}.
-\end{options}
-
-\section{s:inf-debugger}{Running the debugger under Emacs}
-
-The most user-friendly way to use the debugger is to run it under Emacs with
-the OCaml mode available through MELPA and also at
-\url{https://github.com/ocaml/caml-mode}.
-
-The OCaml debugger is started under Emacs by the command "M-x
-camldebug", with argument the name of the executable file
-\var{progname} to debug. Communication with the debugger takes place
-in an Emacs buffer named "*camldebug-"\var{progname}"*". The editing
-and history facilities of Shell mode are available for interacting
-with the debugger.
-
-In addition, Emacs displays the source files containing the current
-event (the current position in the program execution) and highlights
-the location of the event. This display is updated synchronously with
-the debugger action.
-
-The following bindings for the most common debugger commands are
-available in the "*camldebug-"\var{progname}"*" buffer:
-
-\begin{options}
-\item["C-c C-s"] (command "step"): execute the program one step forward.
-\item["C-c C-k"] (command "backstep"): execute the program one step backward.
-\item["C-c C-n"] (command "next"): execute the program one step
-forward, skipping over function calls.
-\item[Middle mouse button] (command "display"): display named value.
-"$"\var{n} under mouse cursor (support incremental browsing of large
-data structures).
-\item["C-c C-p"] (command "print"): print value of identifier at point.
-\item["C-c C-d"] (command "display"): display value of identifier at point.
-\item["C-c C-r"] (command "run"): execute the program forward to next
-breakpoint.
-\item["C-c C-v"] (command "reverse"): execute the program backward to
-latest breakpoint.
-\item["C-c C-l"] (command "last"): go back one step in the command history.
-\item["C-c C-t"] (command "backtrace"): display backtrace of function calls.
-\item["C-c C-f"] (command "finish"): run forward till the current
-function returns.
-\item["C-c <"] (command "up"): select the stack frame below the
-current frame.
-\item["C-c >"] (command "down"): select the stack frame above the
-current frame.
-\end{options}
-
-In all buffers in OCaml editing mode, the following debugger commands
-are also available:
-
-\begin{options}
-\item["C-x C-a C-b"] (command "break"): set a breakpoint at event closest
-to point
-\item["C-x C-a C-p"] (command "print"): print value of identifier at point
-\item["C-x C-a C-d"] (command "display"): display value of identifier at point
-\end{options}
+++ /dev/null
-\chapter{Optimisation with Flambda}
-%HEVEA\cutname{flambda.html}
-
-\section{s:flambda-overview}{Overview}
-
-{\em Flambda} is the term used to describe a series of optimisation passes
-provided by the native code compilers as of OCaml 4.03.
-
-Flambda aims to make it easier to write idiomatic OCaml code without
-incurring performance penalties.
-
-To use the Flambda optimisers it is necessary to pass the {\tt -flambda}
-option to the OCaml {\tt configure} script. (There is no support for a
-single compiler that can operate in both Flambda and non-Flambda modes.)
-Code compiled with Flambda
-cannot be linked into the same program as code compiled without Flambda.
-Attempting to do this will result in a compiler error.
-
-Whether or not a particular {\tt ocamlopt} uses Flambda may be
-determined by invoking it with the {\tt -config} option and looking
-for any line starting with ``{\tt flambda:}''. If such a line is present
-and says ``{\tt true}'', then Flambda is supported, otherwise it is not.
-
-Flambda provides full optimisation across different compilation units,
-so long as the {\tt .cmx} files for the dependencies of the unit currently
-being compiled are available. (A compilation unit corresponds to a
-single {\tt .ml} source file.) However it does not yet act entirely as
-a whole-program compiler: for example, elimination of dead code across
-a complete set of compilation units is not supported.
-
-Optimisation with Flambda is not currently supported when generating
-bytecode.
-
-Flambda should not in general affect the semantics of existing programs.
-Two exceptions to this rule are: possible elimination of pure code
-that is being benchmarked (see section\ \ref{s:flambda-inhibition}) and changes in
-behaviour of code using unsafe operations (see section\ \ref{s:flambda-unsafe}).
-
-Flambda does not yet optimise array or string bounds checks. Neither
-does it take hints for optimisation from any assertions written by the
-user in the code.
-
-Consult the {\em Glossary} at the end of this chapter for definitions of
-technical terms used below.
-
-\section{s:flambda-cli}{Command-line flags}
-
-The Flambda optimisers provide a variety of command-line flags that may
-be used to control their behaviour. Detailed descriptions of each flag
-are given in the referenced sections. Those sections also describe any
-arguments which the particular flags take.
-
-Commonly-used options:
-\begin{options}
-\item[\machine{-O2}] Perform more optimisation than usual. Compilation
-times may be lengthened. (This flag is an abbreviation for a certain
-set of parameters described in section\ \ref{s:flambda-defaults}.)
-\item[\machine{-O3}] Perform even more optimisation than usual, possibly
-including unrolling of recursive functions. Compilation times may be
-significantly lengthened.
-\item[\machine{-Oclassic}] Make inlining decisions at the point of
-definition of a function rather than at the call site(s). This mirrors
-the behaviour of OCaml compilers not using Flambda. Compared to compilation
-using the new Flambda inlining heuristics (for example at {\tt -O2}) it
-produces
-smaller {\tt .cmx} files, shorter compilation times and code that probably
-runs rather slower. When using {\tt -Oclassic}, only the following options
-described in this section are relevant: {\tt -inlining-report} and
-{\tt -inline}. If any other of the options described in this section are
-used, the behaviour is undefined and may cause an error in future versions
-of the compiler.
-\item[\machine{-inlining-report}] Emit {\tt .inlining} files (one per
-round of optimisation) showing all of the inliner's decisions.
-\end{options}
-
-Less commonly-used options:
-\begin{options}
-\item[\machine{-remove-unused-arguments}] Remove unused function arguments
-even when the argument is not specialised. This may have a small
-performance penalty.
-See section\ \ref{ss:flambda-remove-unused-args}.
-\item[\machine{-unbox-closures}] Pass free variables via specialised arguments
-rather than closures (an optimisation for reducing allocation). See
-section\ \ref{ss:flambda-unbox-closures}. This may have a small performance penalty.
-\end{options}
-
-Advanced options, only needed for detailed tuning:
-\begin{options}
-\item[\machine{-inline}] The behaviour depends on whether {\tt -Oclassic}
-is used.
-\begin{itemize}
-\item When not in {\tt -Oclassic} mode, {\tt -inline} limits the total
-size of functions considered for inlining during any speculative inlining
-search. (See section\ \ref{ss:flambda-speculation}.) Note that
-this parameter does
-{\bf not} control the assessment as to whether any particular function may
-be inlined. Raising it to excessive amounts will not necessarily cause
-more functions to be inlined.
-\item When in {\tt -Oclassic} mode, {\tt -inline} behaves as in
-previous versions of the compiler: it is the maximum size of function to
-be considered for inlining. See section\ \ref{ss:flambda-classic}.
-\end{itemize}
-\item[\machine{-inline-toplevel}] The equivalent of {\tt -inline} but used
-when speculative inlining starts at toplevel. See
-section\ \ref{ss:flambda-speculation}.
-Not used in {\tt -Oclassic} mode.
-\item[\machine{-inline-branch-factor}] Controls how the inliner assesses
-whether a code path is likely to be hot or cold. See
-section\ \ref{ss:flambda-assessment-inlining}.
-\item[\machine{-inline-alloc-cost},
- \machine{-inline-branch-cost},
- \machine{-inline-call-cost}] Controls how the inliner assesses the runtime
- performance penalties associated with various operations. See
- section\ \ref{ss:flambda-assessment-inlining}.
-\item[\machine{-inline-indirect-cost},
- \machine{-inline-prim-cost}] Likewise.
-\item[\machine{-inline-lifting-benefit}] Controls inlining of functors
-at toplevel. See section\ \ref{ss:flambda-assessment-inlining}.
-\item[\machine{-inline-max-depth}] The maximum depth of any
-speculative inlining search. See section\ \ref{ss:flambda-speculation}.
-\item[\machine{-inline-max-unroll}] The maximum depth of any unrolling of
-recursive functions during any speculative inlining search.
-See section\ \ref{ss:flambda-speculation}.
-\item[\machine{-no-unbox-free-vars-of-closures}] %
-Do not unbox closure variables. See section\ \ref{ss:flambda-unbox-fvs}.
-\item[\machine{-no-unbox-specialised-args}] %
-Do not unbox arguments to which functions have been specialised. See
-section\ \ref{ss:flambda-unbox-spec-args}.
-\item[\machine{-rounds}] How many rounds of optimisation to perform.
-See section\ \ref{ss:flambda-rounds}.
-\item[\machine{-unbox-closures-factor}] Scaling factor for benefit
-calculation when using {\tt -unbox-closures}. See
-section\ \ref{ss:flambda-unbox-closures}.
-\end{options}
-
-\paragraph{Notes}
-\begin{itemize}
-\item The set of command line flags relating to optimisation should typically
-be specified to be the same across an entire project. Flambda does not
-currently record the requested flags in the {\tt .cmx} files. As such,
-inlining of functions from previously-compiled units will subject their code
-to the optimisation parameters of the unit currently being compiled, rather
-than those specified when they were previously compiled. It is hoped to
-rectify this deficiency in the future.
-
-\item Flambda-specific flags do not affect linking with the exception of
-affecting the optimisation of code in the startup file (containing
-generated functions such as currying helpers). Typically such optimisation
-will not be significant, so eliding such flags at link time might be
-reasonable.
-
-\item Flambda-specific flags are silently accepted even when the
-{\tt -flambda} option was not provided to the {\tt configure} script.
-(There is no means provided to change this behaviour.)
-This is intended to make it more
-straightforward to run benchmarks with and without the Flambda optimisers
-in effect.
-\item Some of the Flambda flags may be subject to change in future
-releases.
-\end{itemize}
-
-\subsection{ss:flambda-rounds}{Specification of optimisation parameters by round}
-
-Flambda operates in {\em rounds}: one round consists of a certain sequence
-of transformations that may then be repeated in order to achieve more
-satisfactory results. The number of rounds can be set manually using the
-{\tt -rounds} parameter (although this is not necessary when using
-predefined optimisation levels such as with {\tt -O2} and {\tt -O3}).
-For high optimisation the number of rounds might be set at 3 or 4.
-
-Command-line flags that may apply per round, for example those with
-{\tt "-cost"} in the name, accept arguments of the form:
-\begin{center}
-{\em n}{\tt\ |\ }{\em round}{\tt =}{\em n}[{\tt,}...]
-\end{center}
-\begin{itemize}
-\item If the first form is used, with a single integer specified,
-the value will apply to all rounds.
-\item If the second form is used, zero-based {\em round} integers specify
-values which are to be used only for those rounds.
-\end{itemize}
-
-The flags {\tt -Oclassic}, {\tt -O2} and {\tt -O3} are applied before all
-other flags, meaning that certain parameters may be overridden without
-having to specify every parameter usually invoked by the given optimisation
-level.
-
-\section{s:flambda-inlining}{Inlining}
-
-{\em Inlining} refers to the copying of the code of a function to a
-place where the function is called.
-The code of the function will be surrounded by bindings of its parameters
-to the corresponding arguments.
-
-The aims of inlining are:
-\begin{itemize}
-\item to reduce the runtime overhead caused by function calls (including
-setting up for such calls and returning afterwards);
-\item to reduce instruction cache misses by expressing frequently-taken
-paths through the program using fewer machine instructions; and
-\item to reduce the amount of allocation (especially of closures).
-\end{itemize}
-These goals are often reached not just by inlining itself but also by
-other optimisations that the compiler is able to perform as a result of
-inlining.
-
-When a recursive call to a function (within the definition of that function
-or another in the same mutually-recursive group) is inlined, the procedure is
-also known as {\em unrolling}. This is somewhat akin to loop peeling.
-For example, given the following code:
-\begin{verbatim}
-let rec fact x =
- if x = 0 then
- 1
- else
- x * fact (x - 1)
-
-let n = fact 4
-\end{verbatim}
-unrolling once at the call site {\tt fact 4} produces (with the body of
-{\tt fact} unchanged):
-\begin{verbatim}
-let n =
- if 4 = 0 then
- 1
- else
- 4 * fact (4 - 1)
-\end{verbatim}
-This simplifies to:
-\begin{verbatim}
-let n = 4 * fact 3
-\end{verbatim}
-
-%% CR pchambart: A specific section for unrolling might be worth (telling
-%% when this is beneficial)
-
-Flambda provides significantly enhanced inlining capabilities relative to
-previous versions of the compiler.
-
-\subsubsection{sss:flambda-inlining-aside}{Aside: when inlining is performed}
-
-Inlining is performed together with all of the other Flambda optimisation
-passes, that is to say, after closure conversion. This has three particular
-advantages over a potentially more straightforward implementation prior to
-closure conversion:
-\begin{itemize}
-\item It permits higher-order inlining, for example when a non-inlinable
-function always returns the same function yet with different environments
-of definition. Not all such cases are supported yet, but it is intended
-that such support will be improved in future.
-\item It is easier to integrate with cross-module optimisation, since
-imported information about other modules is already in the correct
-intermediate language.
-\item It becomes more straightforward to optimise closure allocations since
-the layout of closures does not have to be estimated in any way: it is
-known. Similarly,
-it becomes more straightforward to control which variables end up
-in which closures, helping to avoid closure bloat.
-\end{itemize}
-
-\subsection{ss:flambda-classic}{Classic inlining heuristic}
-
-In {\tt -Oclassic} mode the behaviour of the Flambda inliner
-mimics previous versions
-of the compiler. (Code may still be subject to further optimisations not
-performed by previous versions of the compiler: functors may be inlined,
-constants are lifted and unused code is eliminated all as described elsewhere
-in this chapter. See sections \ref{sss:flambda-functors},\ \ref{ss:flambda-lift-const} %
-and\ \ref{s:flambda-remove-unused}.
-At the definition site of a function, the body of the
-function is measured. It will then be marked as eligible for inlining
-(and hence inlined at every direct call site) if:
-\begin{itemize}
-\item the measured size (in unspecified units) is smaller than that of a
-function call plus the argument of the {\tt -inline} command-line flag; and
-\item the function is not recursive.
-\end{itemize}
-
-Non-Flambda versions of the compiler cannot inline functions that
-contain a definition of another function. However {\tt -Oclassic} does
-permit this. Further, non-Flambda versions also cannot inline functions
-that are only themselves exposed as a result of a previous pass of inlining,
-but again this is permitted by {\tt -Oclassic}.
-For example:
-\begin{verbatim}
-module M : sig
- val i : int
-end = struct
- let f x =
- let g y = x + y in
- g
- let h = f 3
- let i = h 4 (* h is correctly discovered to be g and inlined *)
-end
-\end{verbatim}
-
-All of this contrasts with the normal Flambda mode, that is to say
-without {\tt -Oclassic}, where:
-\begin{itemize}
-\item the inlining decision is made at the {\bf call site}; and
-\item recursive functions can be handled, by {\em specialisation} (see
-below).
-\end{itemize}
-The Flambda mode is described in the next section.
-
-\subsection{ss:flambda-inlining-overview}{Overview of ``Flambda'' inlining heuristics}
-
-The Flambda inlining heuristics, used whenever the compiler is configured
-for Flambda and {\tt -Oclassic} was not specified, make inlining decisions
-at call sites. This helps in situations where the context is important.
-For example:
-\begin{verbatim}
-let f b x =
- if b then
- x
- else
- ... big expression ...
-
-let g x = f true x
-\end{verbatim}
-In this case, we would like to inline {\tt f} into {\tt g}, because a
-conditional jump can be eliminated and the code size should reduce. If the
-inlining decision has been made after the declaration of {\tt f} without
-seeing the use, its size would have probably made it ineligible for
-inlining; but at the call site, its final size can be known. Further,
-this function should probably not be inlined systematically: if {\tt b}
-is unknown, or indeed {\tt false}, there is little benefit to trade off
-against a large increase in code size. In the existing non-Flambda inliner
-this isn't a great problem because chains of inlining were cut off fairly
-quickly. However it has led to excessive use of overly-large inlining
-parameters such as {\tt -inline 10000}.
-
-In more detail, at each call site the following procedure is followed:
-\begin{itemize}
-\item Determine whether it is clear that inlining would be beneficial
-without, for the moment, doing any inlining within the function itself.
-(The exact assessment of {\em benefit} is described below.) If so, the
-function is inlined.
-\item If inlining the function is not clearly beneficial, then inlining
-will be performed {\em speculatively} inside the function itself. The
-search for speculative inlining possibilities is controlled by two
-parameters: the {\em inlining threshold} and the {\em inlining depth}.
-(These are described in more detail below.)
-\begin{itemize}
-\item If such speculation shows that performing some inlining inside the
-function would be beneficial, then such inlining is performed and the
-resulting function inlined at the original call site.
-\item Otherwise, nothing happens.
-\end{itemize}
-\end{itemize}
-Inlining within recursive functions of calls to other
-functions in the same mutually-recursive group is kept in check by
-an {\em unrolling depth}, described below. This ensures that functions are
-not unrolled to excess. (Unrolling is only enabled
-if {\tt -O3} optimisation level is selected and/or the
-{\tt -inline-max-unroll}
-flag is passed with an argument greater than zero.)
-
-\subsection{ss:flambda-by-constructs}{Handling of specific language constructs}
-
-\subsubsection{sss:flambda-functors}{Functors}
-
-There is nothing particular about functors that inhibits inlining compared
-to normal functions. To the inliner, these both look the same, except
-that functors are marked as such.
-
-Applications of functors at toplevel are biased in favour of inlining.
-(This bias may be adjusted:
-see the documentation for {\tt -inline-lifting-benefit} below.)
-
-Applications of functors not at toplevel, for example in a local module
-inside some other expression, are treated by the inliner identically to
-normal function calls.
-
-\subsubsection{sss:flambda-first-class-modules}{First-class modules}
-
-The inliner will be able to consider inlining a call to a function in a first
-class module if it knows which particular function is going to be called.
-The presence of the first-class module record that wraps the set of functions
-in the module does not per se inhibit inlining.
-
-\subsubsection{sss:flambda-objects}{Objects}
-
-Method calls to objects are not at present inlined by Flambda.
-
-\subsection{ss:flambda-inlining-reports}{Inlining reports}
-
-If the {\tt -inlining-report} option is provided to the compiler then a file
-will be emitted corresponding to each round of optimisation. For the
-OCaml source file {\em basename}{\tt .ml} the files
-are named {\em basename}{\tt .}{\em round}{\tt.inlining.org},
-with {\em round} a
-zero-based integer. Inside the files, which are formatted as ``org mode'',
-will be found English prose describing the decisions that the inliner took.
-
-\subsection{ss:flambda-assessment-inlining}{Assessment of inlining benefit}
-
-Inlining typically
-results in an increase in code size, which if left unchecked, may not only
-lead to grossly large executables and excessive compilation times but also
-a decrease in performance due to worse locality. As such, the
-Flambda inliner trades off the change in code size against
-the expected runtime performance benefit, with the benefit being computed
-based on the number of operations that the compiler observes may be removed
-as a result of inlining.
-
-For example given the following code:
-\begin{verbatim}
-let f b x =
- if b then
- x
- else
- ... big expression ...
-
-let g x = f true x
-\end{verbatim}
-it would be observed that inlining of {\tt f} would remove:
-\begin{itemize}
-\item one direct call;
-\item one conditional branch.
-\end{itemize}
-
-Formally, an estimate of runtime performance benefit is computed by
-first summing
-the cost of the operations that are known to be removed as a result of the
-inlining and subsequent simplification of the inlined body.
-The individual costs for the various kinds of operations may be adjusted
-using the various {\tt -inline-...-cost} flags as follows. Costs are
-specified as integers. All of these flags accept a single argument
-describing such integers using the conventions
-detailed in section\ \ref{ss:flambda-rounds}.
-\begin{options}
-\item[\machine{-inline-alloc-cost}] The cost of an allocation.
-\item[\machine{-inline-branch-cost}] The cost of a branch.
-\item[\machine{-inline-call-cost}] The cost of a direct function call.
-\item[\machine{-inline-indirect-cost}] The cost of an indirect function call.
-\item[\machine{-inline-prim-cost}] The cost of a {\em primitive}. Primitives
-encompass operations including arithmetic and memory access.
-\end{options}
-(Default values are described in section\ \ref{s:flambda-defaults} below.)
-
-The initial benefit value is then scaled by a factor that attempts to
-compensate for the fact that the current point in the code, if under some
-number of conditional branches, may be cold. (Flambda does not currently
-compute hot and cold paths.) The factor---the estimated probability that
-the inliner really is on a {\em hot} path---is calculated as
-$\frac{1}{(1 + f)^{d}}$, where $f$ is set by
-{\tt -inline-branch-factor} and $d$ is the nesting depth of branches
-at the current point. As the inliner descends into more deeply-nested
-branches, the benefit of inlining thus lessens.
-
-The resulting benefit value is known as the {\em estimated benefit}.
-
-The change in code size is also estimated: morally speaking it should be the
-change in machine code size, but since that is not available to the inliner,
-an approximation is used.
-
-If the estimated benefit exceeds the increase in code size then the inlined
-version of the function will be kept. Otherwise the function will not be
-inlined.
-
-Applications of functors at toplevel will be given
-an additional benefit (which may be controlled by the
-{\tt -inline-lifting-benefit} flag) to bias inlining in such situations
-towards keeping the inlined version.
-
-\subsection{ss:flambda-speculation}{Control of speculation}
-
-As described above, there are three parameters that restrict the search
-for inlining opportunities during speculation:
-\begin{itemize}
-\item the {\em inlining threshold};
-\item the {\em inlining depth};
-\item the {\em unrolling depth}.
-\end{itemize}
-These parameters are ultimately bounded by the arguments provided to
-the corresponding command-line flags (or their default values):
-\begin{itemize}
-\item {\tt -inline} (or, if the call site that triggered speculation is
-at toplevel, {\tt -inline-toplevel});
-\item {\tt -inline-max-depth};
-\item {\tt -inline-max-unroll}.
-\end{itemize}
-{\bf Note in particular} that {\tt -inline} does not have the meaning that
-it has in the previous compiler or in {\tt -Oclassic} mode. In both of those
-situations {\tt -inline} was effectively some kind of basic assessment of
-inlining benefit. However in Flambda inlining mode it corresponds to a
-constraint on the search; the assessment of benefit is independent, as
-described above.
-
-When speculation starts the inlining threshold starts at the value set
-by {\tt -inline} (or {\tt -inline-toplevel} if appropriate, see above).
-Upon making a speculative inlining decision the
-threshold is reduced by the code size of the function being inlined.
-If the threshold becomes exhausted, at or below zero, no further speculation
-will be performed.
-
-The inlining depth starts at zero
-and is increased by one every time the inliner
-descends into another function. It is then decreased by one every time the
-inliner leaves such function. If the depth exceeds the value set by
-{\tt -inline-max-depth} then speculation stops. This parameter is intended
-as a general backstop for situations where the inlining
-threshold does not control the search sufficiently.
-
-The unrolling depth applies to calls within the same mutually-recursive
-group of functions. Each time an inlining of such a call is performed
-the depth is incremented by one when examining the resulting body. If the
-depth reaches the limit set by {\tt -inline-max-unroll} then speculation
-stops.
-
-\section{s:flambda-specialisation}{Specialisation}
-
-The inliner may discover a call site to a recursive function where
-something is known about the arguments: for example, they may be equal to
-some other variables currently in scope. In this situation it may be
-beneficial to {\em specialise} the function to those arguments. This is
-done by copying the declaration of the function (and any others involved
-in any same mutually-recursive declaration) and noting the extra information
-about the arguments. The arguments augmented by this information are known
-as {\em specialised arguments}. In order to try to ensure that specialisation
-is not performed uselessly, arguments are only specialised if it can be shown
-that they are {\em invariant}: in other words, during the execution of the
-recursive function(s) themselves, the arguments never change.
-
-Unless overridden by an attribute (see below), specialisation of a function
-will not be attempted if:
-\begin{itemize}
-\item the compiler is in {\tt -Oclassic} mode;
-\item the function is not obviously recursive;
-\item the function is not closed.
-\end{itemize}
-
-The compiler can prove invariance of function arguments across multiple
-functions within a recursive group (although this has some limitations,
-as shown by the example below).
-
-It should be noted that the {\em unboxing of closures} pass (see below)
-can introduce specialised arguments on non-recursive functions. (No other
-place in the compiler currently does this.)
-
-\paragraph{Example: the well-known {\tt List.iter} function}
-This function might be written like so:
-\begin{verbatim}
-let rec iter f l =
- match l with
- | [] -> ()
- | h :: t ->
- f h;
- iter f t
-\end{verbatim}
-and used like this:
-\begin{verbatim}
-let print_int x =
- print_endline (Int.to_string x)
-
-let run xs =
- iter print_int (List.rev xs)
-\end{verbatim}
-The argument {\tt f} to {\tt iter} is invariant so the function may be
-specialised:
-\begin{verbatim}
-let run xs =
- let rec iter' f l =
- (* The compiler knows: f holds the same value as foo throughout iter'. *)
- match l with
- | [] -> ()
- | h :: t ->
- f h;
- iter' f t
- in
- iter' print_int (List.rev xs)
-\end{verbatim}
-The compiler notes down that for the function {\tt iter'}, the argument
-{\tt f} is specialised to the constant closure {\tt print\_int}. This
-means that the body of {\tt iter'} may be simplified:
-\begin{verbatim}
-let run xs =
- let rec iter' f l =
- (* The compiler knows: f holds the same value as foo throughout iter'. *)
- match l with
- | [] -> ()
- | h :: t ->
- print_int h; (* this is now a direct call *)
- iter' f t
- in
- iter' print_int (List.rev xs)
-\end{verbatim}
-The call to {\tt print\_int} can indeed be inlined:
-\begin{verbatim}
-let run xs =
- let rec iter' f l =
- (* The compiler knows: f holds the same value as foo throughout iter'. *)
- match l with
- | [] -> ()
- | h :: t ->
- print_endline (Int.to_string h);
- iter' f t
- in
- iter' print_int (List.rev xs)
-\end{verbatim}
-The unused specialised argument {\tt f} may now be removed, leaving:
-\begin{verbatim}
-let run xs =
- let rec iter' l =
- match l with
- | [] -> ()
- | h :: t ->
- print_endline (Int.to_string h);
- iter' t
- in
- iter' (List.rev xs)
-\end{verbatim}
-
-\paragraph{Aside on invariant parameters.} The compiler cannot currently
-detect invariance in cases such as the following.
-\begin{verbatim}
-let rec iter_swap f g l =
- match l with
- | [] -> ()
- | 0 :: t ->
- iter_swap g f l
- | h :: t ->
- f h;
- iter_swap f g t
-\end{verbatim}
-
-\subsection{ss:flambda-assessment-specialisation}{Assessment of specialisation benefit}
-
-The benefit of specialisation is assessed in a similar way as for inlining.
-Specialised argument information may mean that the body of the function
-being specialised can be simplified: the removed operations are accumulated
-into a benefit. This, together with the size of the duplicated (specialised)
-function declaration, is then assessed against the size of the call to the
-original function.
-
-\section{s:flambda-defaults}{Default settings of parameters}
-
-The default settings (when not using {\tt -Oclassic}) are for one
-round of optimisation using the following parameters.
-% CR-soon mshinwell: for 4.04, let's autogenerate these.
-
-\begin{tableau}{|l|l|}{Parameter}{Setting}
-\entree{{\tt -inline}}{10}
-\entree{{\tt -inline-branch-factor}}{0.1}
-\entree{{\tt -inline-alloc-cost}}{7}
-\entree{{\tt -inline-branch-cost}}{5}
-\entree{{\tt -inline-call-cost}}{5}
-\entree{{\tt -inline-indirect-cost}}{4}
-\entree{{\tt -inline-prim-cost}}{3}
-\entree{{\tt -inline-lifting-benefit}}{1300}
-\entree{{\tt -inline-toplevel}}{160}
-\entree{{\tt -inline-max-depth}}{1}
-\entree{{\tt -inline-max-unroll}}{0}
-\entree{{\tt -unbox-closures-factor}}{10}
-\end{tableau}
-
-\subsection{ss:flambda-o2}{Settings at -O2 optimisation level}
-
-When {\tt -O2} is specified two rounds of optimisation are performed.
-The first round uses the default parameters (see above). The second uses
-the following parameters.
-
-\begin{tableau}{|l|l|}{Parameter}{Setting}
-\entree{{\tt -inline}}{25}
-\entree{{\tt -inline-branch-factor}}{Same as default}
-\entree{{\tt -inline-alloc-cost}}{Double the default}
-\entree{{\tt -inline-branch-cost}}{Double the default}
-\entree{{\tt -inline-call-cost}}{Double the default}
-\entree{{\tt -inline-indirect-cost}}{Double the default}
-\entree{{\tt -inline-prim-cost}}{Double the default}
-\entree{{\tt -inline-lifting-benefit}}{Same as default}
-\entree{{\tt -inline-toplevel}}{400}
-\entree{{\tt -inline-max-depth}}{2}
-\entree{{\tt -inline-max-unroll}}{Same as default}
-\entree{{\tt -unbox-closures-factor}}{Same as default}
-\end{tableau}
-
-\subsection{ss:flambda-o3}{Settings at -O3 optimisation level}
-
-When {\tt -O3} is specified three rounds of optimisation are performed.
-The first two rounds are as for {\tt -O2}. The third round uses
-the following parameters.
-
-\begin{tableau}{|l|l|}{Parameter}{Setting}
-\entree{{\tt -inline}}{50}
-\entree{{\tt -inline-branch-factor}}{Same as default}
-\entree{{\tt -inline-alloc-cost}}{Triple the default}
-\entree{{\tt -inline-branch-cost}}{Triple the default}
-\entree{{\tt -inline-call-cost}}{Triple the default}
-\entree{{\tt -inline-indirect-cost}}{Triple the default}
-\entree{{\tt -inline-prim-cost}}{Triple the default}
-\entree{{\tt -inline-lifting-benefit}}{Same as default}
-\entree{{\tt -inline-toplevel}}{800}
-\entree{{\tt -inline-max-depth}}{3}
-\entree{{\tt -inline-max-unroll}}{1}
-\entree{{\tt -unbox-closures-factor}}{Same as default}
-\end{tableau}
-
-\section{s:flambda-manual-control}{Manual control of inlining and specialisation}
-
-Should the inliner prove recalcitrant and refuse to inline a particular
-function, or if the observed inlining decisions are not to the programmer's
-satisfaction for some other reason, inlining behaviour can be dictated by the
-programmer directly in the source code.
-One example where this might be appropriate is when the programmer,
-but not the compiler, knows that a particular function call is on a cold
-code path. It might be desirable to prevent inlining of the function so
-that the code size along the hot path is kept smaller, so as to increase
-locality.
-
-The inliner is directed using attributes.
-For non-recursive functions (and one-step unrolling of recursive functions,
-although {\tt \@unroll} is more clear for this purpose)
-the following are supported:
-\begin{options}
-\item[{\machine{\@\@inline always}} or {\machine{\@\@inline never}}] Attached
-to a {\em declaration} of a function or functor, these direct the inliner to
-either
-always or never inline, irrespective of the size/benefit calculation. (If
-the function is recursive then the body is substituted and no special
-action is taken for the recursive call site(s).)
-{\machine{\@\@inline}} with no argument is equivalent to
-{\machine{\@\@inline always}}.
-\item[{\machine{\@inlined always}} or {\machine{\@inlined never}}] Attached
-to a function {\em application}, these direct the inliner likewise. These
-attributes at call sites override any other attribute that may be present
-on the corresponding declaration.
-{\machine{\@inlined}} with no argument is equivalent to
-{\machine{\@inlined always}}. {\machine{\@\@inlined hint}} is equivalent to
-{\machine{\@\@inline always}} except that it will not trigger warning 55 if
-the function application cannot be inlined.
-\end{options}
-
-For recursive functions the relevant attributes are:
-\begin{options}
-\item[{\machine{\@\@specialise always}} or {\machine{\@\@specialise never}}]%
-Attached to a declaration of a function
-or functor, this directs the inliner to either always or never
-specialise the function so
-long as it has appropriate contextual knowledge, irrespective of the
-size/benefit calculation.
-{\machine{\@\@specialise}} with no argument is equivalent to
-{\machine{\@\@specialise always}}.
-\item[{\machine{\@specialised always}} or {\machine{\@specialised never}}]%
-Attached to a function application, this
-directs the inliner likewise. This attribute at a call site overrides any
-other attribute that may be present on the corresponding declaration.
-(Note that the function will still only be specialised if there exist
-one or more invariant parameters whose values are known.)
-{\machine{\@specialised}} with no argument is equivalent to
-{\machine{\@specialised always}}.
-\item[{\machine{\@unrolled }}$n$] This attribute is attached to a function
-application and always takes an integer argument. Each time the inliner sees
-the attribute it behaves as follows:
-\begin{itemize}
-\item If $n$ is zero or less, nothing happens.
-\item Otherwise the function being called is substituted at the call site
-with its body having been rewritten such that
-any recursive calls to that function {\em or
-any others in the same mutually-recursive group} are annotated with the
-attribute {\tt unrolled(}$n - 1${\tt )}. Inlining may continue on that body.
-\end{itemize}
-As such, $n$ behaves as the ``maximum depth of unrolling''.
-\end{options}
-
-A compiler warning will be emitted if it was found impossible to obey an
-annotation from an {\tt \@inlined} or {\tt \@specialised} attribute.
-
-\paragraph{Example showing correct placement of attributes}
-\begin{verbatim}
-module F (M : sig type t end) = struct
- let[@inline never] bar x =
- x * 3
-
- let foo x =
- (bar [@inlined]) (42 + x)
-end [@@inline never]
-
-module X = F [@inlined] (struct type t = int end)
-\end{verbatim}
-
-\section{s:flambda-simplification}{Simplification}
-
-Simplification, which is run in conjunction with inlining,
-propagates information (known as {\em approximations}) about which
-variables hold what values at runtime. Certain relationships between
-variables and symbols are also tracked: for example, some variable may be
-known to always hold the same value as some other variable; or perhaps
-some variable may be known to always hold the value pointed to by some
-symbol.
-
-The propagation can help to eliminate allocations in cases such as:
-\begin{verbatim}
-let f x y =
- ...
- let p = x, y in
- ...
- ... (fst p) ... (snd p) ...
-\end{verbatim}
-The projections from {\tt p} may be replaced by uses of the variables
-{\tt x} and {\tt y}, potentially meaning that {\tt p} becomes unused.
-
-The propagation performed by the simplification pass is also important for
-discovering which functions flow to indirect call sites. This can enable
-the transformation of such call sites into direct call sites, which makes
-them eligible for an inlining transformation.
-
-Note that no information is propagated about the contents of strings,
-even in {\tt safe-string} mode, because it cannot yet be guaranteed
-that they are immutable throughout a given program.
-
-\section{s:flambda-other-transfs}{Other code motion transformations}
-
-\subsection{ss:flambda-lift-const}{Lifting of constants}
-
-Expressions found to be constant will be lifted to symbol
-bindings---that is to say, they will be statically allocated in the
-object file---when
-they evaluate to boxed values. Such constants may be straightforward numeric
-constants, such as the floating-point number {\tt 42.0}, or more complicated
-values such as constant closures.
-
-Lifting of constants to toplevel reduces allocation at runtime.
-
-The compiler aims to share constants lifted to toplevel such that there
-are no duplicate definitions. However if {\tt .cmx} files are hidden
-from the compiler then maximal sharing may not be possible.
-
-\paragraph{Notes about float arrays} %
-The following language semantics apply specifically to constant float arrays.
-(By ``constant float array'' is meant an array consisting entirely of floating
-point numbers that are known at compile time. A common case is a literal
-such as {\tt [| 42.0; 43.0; |]}.
-\begin{itemize}
-\item Constant float arrays at the toplevel are mutable and never shared.
-(That is to say, for each
-such definition there is a distinct symbol in the data section of the object
-file pointing at the array.)
-\item Constant float arrays not at toplevel are mutable and are created each
-time the expression is evaluated. This can be thought of as an operation that
-takes an immutable array (which in the source code has no associated name; let
-us call it the {\em initialising array}) and
-duplicates it into a fresh mutable array.
-\begin{itemize}
-\item If the array is of size four or less, the expression will create a
-fresh block and write the values into it one by one. There is no reference
-to the initialising array as a whole.
-
-\item Otherwise, the initialising array is lifted out and subject to the
-normal constant sharing procedure;
-creation of the array consists of bulk copying the initialising array
-into a fresh value on the OCaml heap.
-\end{itemize}
-\end{itemize}
-
-\subsection{ss:flambda-lift-toplevel-let}{Lifting of toplevel let bindings}
-
-Toplevel {\tt let}-expressions may be lifted to symbol bindings to ensure
-that the corresponding bound variables are not captured by closures. If the
-defining expression of a given binding is found to be constant, it is bound
-as such (the technical term is a {\em let-symbol} binding).
-
-Otherwise, the symbol is bound to a (statically-allocated)
-{\em preallocated block} containing one field. At runtime, the defining
-expression will be evaluated and the first field of the block filled with
-the resulting value. This {\em initialise-symbol} binding
-causes one extra indirection but ensures, by
-virtue of the symbol's address being known at compile time, that uses of the
-value are not captured by closures.
-
-It should be noted that the blocks corresponding to initialise-symbol
-bindings are kept alive forever, by virtue of them occurring in a static
-table of GC roots within the object file. This extended lifetime of
-expressions may on occasion be surprising. If it is desired to create
-some non-constant value (for example when writing GC tests) that does not
-have this
-extended lifetime, then it may be created and used inside a function,
-with the application point of that function (perhaps at toplevel)---or
-indeed the function declaration itself---marked
-as to never be inlined. This technique prevents lifting of the definition
-of the value in question (assuming of course that it is not constant).
-
-\section{s:flambda-unboxing}{Unboxing transformations}
-
-The transformations in this section relate to the splitting apart of
-{\em boxed} (that is to say, non-immediate) values. They are largely
-intended to reduce allocation, which tends to result in a runtime
-performance profile with lower variance and smaller tails.
-
-\subsection{ss:flambda-unbox-fvs}{Unboxing of closure variables}
-
-This transformation is enabled unless
-{\tt -no-unbox-free-vars-of-closures} is provided.
-
-Variables that appear in closure environments may themselves be boxed
-values. As such, they may be split into further closure variables, each
-of which corresponds to some projection from the original closure variable(s).
-This transformation is called {\em unboxing of closure variables} or
-{\em unboxing of free variables of closures}. It is only applied when
-there is
-reasonable certainty that there are no uses of the boxed free variable itself
-within the corresponding function bodies.
-% CR-someday mshinwell: Actually, we probably don't check this carefully
-% enough. It needs a global analysis in case there is an out-of-scope
-% projection.
-
-\paragraph{Example:} In the following code, the compiler observes that
-the closure returned from the function {\tt f} contains a variable {\tt pair}
-(free in the body of {\tt f}) that may be split into two separate variables.
-\begin{verbatim}
-let f x0 x1 =
- let pair = x0, x1 in
- Printf.printf "foo\n";
- fun y ->
- fst pair + snd pair + y
-\end{verbatim}
-After some simplification one obtains:
-\begin{verbatim}
-let f x0 x1 =
- let pair_0 = x0 in
- let pair_1 = x1 in
- Printf.printf "foo\n";
- fun y ->
- pair_0 + pair_1 + y
-\end{verbatim}
-and then:
-\begin{verbatim}
-let f x0 x1 =
- Printf.printf "foo\n";
- fun y ->
- x0 + x1 + y
-\end{verbatim}
-The allocation of the pair has been eliminated.
-
-This transformation does not operate if it would cause the closure to
-contain more than twice as many closure variables as it did beforehand.
-
-\subsection{ss:flambda-unbox-spec-args}{Unboxing of specialised arguments}
-
-This transformation is enabled unless
-{\tt -no-unbox-specialised-args} is provided.
-
-It may become the case during compilation that one or more invariant arguments
-to a function become specialised to a particular value. When such values are
-themselves boxed the corresponding specialised arguments may be split into
-more specialised arguments corresponding to the projections out of the boxed
-value that occur within the function body. This transformation is called
-{\em unboxing of specialised arguments}. It is only applied when there is
-reasonable certainty that the boxed argument itself is unused within the
-function.
-
-If the function in question is involved in a recursive group then unboxing
-of specialised arguments may be immediately replicated across the group
-based on the dataflow between invariant arguments.
-
-\paragraph{Example:} Having been given the following code, the compiler
-will inline {\tt loop} into {\tt f}, and then observe {\tt inv}
-being invariant and always the pair formed by adding {\tt 42} and {\tt 43}
-to the argument {\tt x} of the function {\tt f}.
-\begin{verbatim}
-let rec loop inv xs =
- match xs with
- | [] -> fst inv + snd inv
- | x::xs -> x + loop2 xs inv
-and loop2 ys inv =
- match ys with
- | [] -> 4
- | y::ys -> y - loop inv ys
-
-let f x =
- Printf.printf "%d\n" (loop (x + 42, x + 43) [1; 2; 3])
-\end{verbatim}
-Since the functions have sufficiently few arguments, more specialised
-arguments will be added. After some simplification one obtains:
-\begin{verbatim}
-let f x =
- let rec loop' xs inv_0 inv_1 =
- match xs with
- | [] -> inv_0 + inv_1
- | x::xs -> x + loop2' xs inv_0 inv_1
- and loop2' ys inv_0 inv_1 =
- match ys with
- | [] -> 4
- | y::ys -> y - loop' ys inv_0 inv_1
- in
- Printf.printf "%d\n" (loop' [1; 2; 3] (x + 42) (x + 43))
-\end{verbatim}
-The allocation of the pair within {\tt f} has been removed. (Since the
-two closures for {\tt loop'} and {\tt loop2'} are constant they will also be
-lifted to toplevel with no runtime allocation penalty. This
-would also happen without having run the transformation to unbox
-specialise arguments.)
-
-The transformation to unbox specialised arguments never introduces extra
-allocation.
-
-The transformation will not unbox arguments if it would result in the
-original function having sufficiently many arguments so as to inhibit
-tail-call optimisation.
-
-The transformation is implemented by creating a wrapper function that
-accepts the original arguments. Meanwhile, the original function is renamed
-and extra arguments are added corresponding to the unboxed specialised
-arguments; this new function
-is called from the wrapper. The wrapper will then be inlined
-at direct call sites. Indeed, all call sites will be direct unless
-{\tt -unbox-closures} is being used, since they will have been generated
-by the compiler when originally specialising the function. (In the case
-of {\tt -unbox-closures} other functions may appear with specialised
-arguments; in this case there may be indirect calls and these will incur
-a small penalty owing to having to bounce through the wrapper. The technique
-of {\em direct call surrogates} used for {\tt -unbox-closures} is not
-used by the transformation to unbox specialised arguments.)
-
-\subsection{ss:flambda-unbox-closures}{Unboxing of closures}
-
-This transformation is {\em not} enabled by default. It may be enabled
-using the {\tt -unbox-closures} flag.
-
-The transformation replaces closure variables by specialised arguments.
-The aim is to cause more closures to become closed. It is particularly
-applicable, as a means of reducing allocation, where the function concerned
-cannot be inlined or specialised. For example, some non-recursive function
-might be too large to inline; or some recursive function might offer
-no opportunities for specialisation perhaps because its only argument is
-one of type {\tt unit}.
-
-At present there may be a small penalty in terms of actual runtime
-performance when this transformation is enabled, although more stable
-performance may be obtained due to reduced allocation. It is recommended
-that developers experiment to determine whether the option is beneficial
-for their code. (It is expected that in the future it will be possible
-for the performance degradation to be removed.)
-
-\paragraph{Simple example:} In the following code (which might typically
-occur when {\tt g} is too large to inline) the value of {\tt x} would usually
-be communicated to the application of the {\tt +} function via the closure
-of {\tt g}.
-\begin{verbatim}
-let f x =
- let g y =
- x + y
- in
- (g [@inlined never]) 42
-\end{verbatim}
-Unboxing of the closure causes the value for {\tt x} inside {\tt g} to
-be passed as an argument to {\tt g} rather than through its closure. This
-means that the closure of {\tt g} becomes constant and may be lifted to
-toplevel, eliminating the runtime allocation.
-
-The transformation is implemented by adding a new wrapper function in the
-manner of that used when unboxing specialised arguments. The closure
-variables are still free in the wrapper, but the intention is that when
-the wrapper is inlined at direct call sites, the relevant values are
-passed directly to the main function via the new specialised arguments.
-
-Adding such a wrapper will penalise indirect calls to the function
-(which might exist in arbitrary places; remember that this transformation
-is not for example applied only on functions the compiler has produced
-as a result of specialisation) since such calls will bounce through
-the wrapper. To
-mitigate this, if a function is small enough when weighed up against
-the number of free variables being removed, it will be duplicated by the
-transformation to obtain two versions: the original (used for indirect calls,
-since we can do no better) and the wrapper/rewritten function pair as
-described in the previous paragraph. The wrapper/rewritten function pair
-will only be used at direct call sites of the function. (The wrapper in
-this case is known as a {\em direct call surrogate}, since
-it takes the place of another function---the unchanged version used for
-indirect calls---at direct call sites.)
-
-The {\tt -unbox-closures-factor} command line flag, which takes an
-integer, may be used to adjust the point at which a function is deemed
-large enough to be ineligible for duplication. The benefit of
-duplication is scaled by the integer before being evaluated against the
-size.
-
-\paragraph{Harder example:} In the following code, there are two closure
-variables that would typically cause closure allocations. One is called
-{\tt fv} and occurs inside the function {\tt baz}; the other is called
-{\tt z} and occurs inside the function {\tt bar}.
-In this toy (yet sophisticated) example we again use an attribute to
-simulate the typical situation where the first argument of {\tt baz} is
-too large to inline.
-\begin{verbatim}
-let foo c =
- let rec bar zs fv =
- match zs with
- | [] -> []
- | z::zs ->
- let rec baz f = function
- | [] -> []
- | a::l -> let r = fv + ((f [@inlined never]) a) in r :: baz f l
- in
- (map2 (fun y -> z + y) [z; 2; 3; 4]) @ bar zs fv
- in
- Printf.printf "%d" (List.length (bar [1; 2; 3; 4] c))
-\end{verbatim}
-The code resulting from applying {\tt -O3 -unbox-closures} to this code
-passes the free variables via function arguments in
-order to eliminate all closure allocation in this example (aside from any
-that might be performed inside {\tt printf}).
-
-\section{s:flambda-remove-unused}{Removal of unused code and values}
-
-\subsection{ss:flambda-redundant-let}{Removal of redundant let expressions}
-
-The simplification pass removes unused {\tt let} bindings so long as
-their corresponding defining expressions have ``no effects''. See
-the section ``Treatment of effects'' below for the precise definition of
-this term.
-
-\subsection{ss:flambda-redundant}{Removal of redundant program constructs}
-
-This transformation is analogous to the removal of {\tt let}-expressions
-whose defining expressions have no effects. It operates instead on symbol
-bindings, removing those that have no effects.
-
-\subsection{ss:flambda-remove-unused-args}{Removal of unused arguments}
-
-This transformation is only enabled by default for specialised arguments.
-It may be enabled for all arguments using the {\tt -remove-unused-arguments}
-flag.
-
-The pass analyses functions to determine which arguments are unused.
-Removal is effected by creating a wrapper function, which will be inlined
-at every direct call site, that accepts the original arguments and then
-discards the unused ones before calling the original function. As a
-consequence, this transformation may be detrimental if the original
-function is usually indirectly called, since such calls will now bounce
-through the wrapper. (The technique of {\em direct call surrogates} used
-to reduce this penalty during unboxing of closure variables (see above)
-does not yet apply to the pass that removes unused arguments.)
-
-\subsection{ss:flambda-removal-closure-vars}{Removal of unused closure variables}
-
-This transformation performs an analysis across
-the whole compilation unit to determine whether there exist closure variables
-that are never used. Such closure variables are then eliminated. (Note that
-this has to be a whole-unit analysis because a projection of a closure
-variable from some particular closure may have propagated to an arbitrary
-location within the code due to inlining.)
-
-\section{s:flambda-other}{Other code transformations}
-
-\subsection{ss:flambda-non-escaping-refs}{Transformation of non-escaping references into mutable variables}
-
-Flambda performs a simple analysis analogous to that performed elsewhere
-in the compiler that can transform {\tt ref}s into mutable variables
-that may then be held in registers (or on the stack as appropriate) rather
-than being allocated on the OCaml heap. This only happens so long as the
-reference concerned can be shown to not escape from its defining scope.
-
-\subsection{ss:flambda-subst-closure-vars}{Substitution of closure variables for specialised arguments}
-
-This transformation discovers closure variables that are known to be
-equal to specialised arguments. Such closure variables are replaced by
-the specialised arguments; the closure variables may then be removed by
-the ``removal of unused closure variables'' pass (see below).
-
-\section{s:flambda-effects}{Treatment of effects}
-
-The Flambda optimisers classify expressions in order to determine whether
-an expression:
-\begin{itemize}
-\item does not need to be evaluated at all; and/or
-\item may be duplicated.
-\end{itemize}
-
-This is done by forming judgements on the {\em effects} and the {\em coeffects}
-that might be performed were the expression to be executed. Effects talk
-about how the expression might affect the world; coeffects talk about how
-the world might affect the expression.
-
-Effects are classified as follows:
-\begin{options}
-\item[{\bf No effects:}] The expression does not change the observable state
-of the world. For example, it must not write to any mutable storage,
-call arbitrary external functions or change control flow (e.g. by raising
-an exception). Note that allocation is {\em not} classed as having
-``no effects'' (see below).
-\begin{itemize}
-\item It is assumed in the compiler that expressions with no
-effects, whose results are not used, may be eliminated. (This typically
-happens where the expression in question is the defining expression of a
-{\tt let}; in such cases the {\tt let}-expression will be
-eliminated.) It is further
-assumed that such expressions with no effects may be
-duplicated (and thus possibly executed more than once).
-\item Exceptions arising from allocation points, for example
-``out of memory'' or
-exceptions propagated from finalizers or signal handlers, are treated as
-``effects out of the ether'' and thus ignored for our determination here
-of effectfulness. The same goes for floating point operations that may
-cause hardware traps on some platforms.
-\end{itemize}
-\item[{\bf Only generative effects:}] The expression does not change the
-observable state of the world save for possibly affecting the state of
-the garbage collector by performing an allocation. Expressions
-that only have generative effects and whose results are unused
-may be eliminated by the compiler. However, unlike expressions with
-``no effects'', such expressions will never be eligible for duplication.
-\item[{\bf Arbitrary effects:}] All other expressions.
-\end{options}
-
-There is a single classification for coeffects:
-\begin{options}
-\item[{\bf No coeffects:}] The expression does not observe the effects (in
-the sense described above) of other expressions. For example, it must not
-read from any mutable storage or call arbitrary external functions.
-\end{options}
-
-It is assumed in the compiler that, subject to data dependencies,
-expressions with neither effects nor coeffects may be reordered with
-respect to other expressions.
-
-\section{s:flambda-static-modules}{Compilation of statically-allocated modules}
-
-Compilation of modules that are able to be statically allocated (for example,
-the module corresponding to an entire compilation unit, as opposed to a first
-class module dependent on values computed at runtime) initially follows the
-strategy used for bytecode. A sequence of {\tt let}-bindings, which may be
-interspersed with arbitrary effects, surrounds a record creation that becomes
-the module block. The Flambda-specific transformation follows: these bindings
-are lifted to toplevel symbols, as described above.
-
-\section{s:flambda-inhibition}{Inhibition of optimisation}
-
-Especially when writing benchmarking suites that run non-side-effecting
-algorithms in loops, it may be found that the optimiser entirely
-elides the code being benchmarked. This behaviour can be prevented by
-using the {\tt Sys.opaque\_identity} function (which indeed behaves as a
-normal OCaml function and does not possess any ``magic'' semantics). The
-documentation of the {\tt Sys} module should be consulted for further details.
-
-\section{s:flambda-unsafe}{Use of unsafe operations}
-
-The behaviour of the Flambda simplification pass means that certain unsafe
-operations, which may without Flambda or when using previous versions of
-the compiler be safe, must not be used. This specifically refers to
-functions found in the {\tt Obj} module.
-
-In particular, it is forbidden to change any value (for example using
-{\tt Obj.set\_field} or {\tt Obj.set\_tag}) that is not mutable.
-(Values returned from C stubs
-are always treated as mutable.) The compiler will emit warning 59 if it
-detects such a write---but it cannot warn in all cases. Here is an example
-of code that will trigger the warning:
-\begin{verbatim}
-let f x =
- let a = 42, x in
- (Obj.magic a : int ref) := 1;
- fst a
-\end{verbatim}
-The reason this is unsafe is because the simplification pass believes that
-{\tt fst a} holds the value {\tt 42}; and indeed it must, unless type
-soundness has been broken via unsafe operations.
-
-If it must be the case that code has to be written that triggers warning 59,
-but the code is known to actually be correct (for some definition of
-correct), then {\tt Sys.opaque\_identity} may be used to wrap the value
-before unsafe operations are performed upon it. Great care must be taken
-when doing this to ensure that the opacity is added at the correct place.
-It must be emphasised that this use of {\tt Sys.opaque\_identity} is only
-for {\bf exceptional} cases. It should not be used in normal code or to
-try to guide the optimiser.
-
-As an example, this code will return the integer {\tt 1}:
-\begin{verbatim}
-let f x =
- let a = Sys.opaque_identity (42, x) in
- (Obj.magic a : int ref) := 1;
- fst a
-\end{verbatim}
-However the following code will still return {\tt 42}:
-\begin{verbatim}
-let f x =
- let a = 42, x in
- Sys.opaque_identity (Obj.magic a : int ref) := 1;
- fst a
-\end{verbatim}
-
-High levels of inlining performed by Flambda may expose bugs in code
-thought previously to be correct. Take care, for example, not
-to add type annotations that claim some mutable value is always immediate
-if it might be possible for an unsafe operation to update it to a boxed
-value.
-
-\section{s:flambda-glossary}{Glossary}
-
-The following terminology is used in this chapter of the manual.
-
-\begin{options}
-\item[{\bf Call site}] See {\em direct call site} and %
-{\em indirect call site} below.
-\item[{\bf Closed function}] A function whose body has no free variables
-except its parameters and any to which are bound other functions within
-the same (possibly mutually-recursive) declaration.
-\item[{\bf Closure}] The runtime representation of a function. This
-includes pointers to the code of the function
-together with the values of any variables that are used in the body of
-the function but actually defined outside of the function, in the
-enclosing scope.
-The values of such variables, collectively known as the
-{\em environment}, are required because the function may be
-invoked from a place where the original bindings of such variables are
-no longer in scope. A group of possibly
-mutually-recursive functions defined using {\em let rec} all share a
-single closure. (Note to developers: in the Flambda source code a
-{\em closure} always corresponds to a single function; a
-{\em set of closures} refers to a group of such.)
-\item[{\bf Closure variable}] A member of the environment held within the
-closure of a given function.
-\item[{\bf Constant}] Some entity (typically an expression) the value of which
-is known by the compiler at compile time. Constantness may be explicit from
-the source code or inferred by the Flambda optimisers.
-\item[{\bf Constant closure}] A closure that is statically allocated in an
-object file. It is almost always the case that the environment portion of
-such a closure is empty.
-\item[{\bf Defining expression}] The expression {\tt e} in %
-{\tt let x = e in e'}.
-\item[{\bf Direct call site}] A place in a program's code where a function is
-called and it is known at compile time which function it will always be.
-\item[{\bf Indirect call site}] A place in a program's code where a function
-is called but is not known to be a {\em direct call site}.
-\item[{\bf Program}] A collection of {\em symbol bindings} forming the
-definition of a single compilation unit (i.e. {\tt .cmx} file).
-\item[{\bf Specialised argument}] An argument to a function that is known
-to always hold a particular value at runtime. These are introduced by the
-inliner when specialising recursive functions; and the {\tt unbox-closures}
-pass. (See section\ \ref{s:flambda-specialisation}.)
-\item[{\bf Symbol}] A name referencing a particular place in an object file
-or executable image. At that particular place will be some constant value.
-Symbols may be examined using operating system-specific tools (for
-example {\tt objdump} on Linux).
-\item[{\bf Symbol binding}] Analogous to a {\tt let}-expression but working
-at the level of symbols defined in the object file. The address of a symbol is
-fixed, but it may be bound to both constant and non-constant expressions.
-\item[{\bf Toplevel}] An expression in the current program which is not
-enclosed within any function declaration.
-\item[{\bf Variable}] A named entity to which some OCaml value is bound by a
-{\tt let} expression, pattern-matching construction, or similar.
-\end{options}
+++ /dev/null
-\chapter{Runtime tracing with the instrumented runtime}
-%HEVEA\cutname{instrumented-runtime.html}
-
-This chapter describes the OCaml instrumented runtime, a runtime variant
-allowing the collection of events and metrics.
-
-Collected metrics include time spent executing the {\em garbage collector}.
-The overall execution time of individual pauses are measured
-down to the time spent in specific parts of the garbage collection.
-Insight is also given on memory allocation and motion by recording
-the size of allocated memory blocks, as well as value promotions from the
-{\em minor heap} to the {\em major heap}.
-
-\section{s:instr-runtime-overview}{Overview}
-
-Once compiled and linked with the instrumented runtime, any OCaml program
-can generate {\em trace files} that can then be read
-and analyzed by users in order to understand specific runtime behaviors.
-
-The generated trace files are stored using the {\em Common Trace Format}, which
-is a general purpose binary tracing format.
-A complete trace consists of:
-\begin{itemize}
-\item a {\em metadata file}, part of the OCaml distribution
-\item and a {\em trace file}, generated by the runtime\
- in the program being traced.
-\end{itemize}
-
-For more information on the {\em Common Trace Format}, see
-\href{https://diamon.org/ctf/}{https://diamon.org/ctf/}.
-
-\section{s:instr-runtime-enabling}{Enabling runtime instrumentation}
-
-
-For the following examples, we will use the following example program:
-
-\begin{caml_example*}{verbatim}
-module SMap = Map.Make(String)
-
-let s i = String.make 512 (Char.chr (i mod 256))
-
-let clear map = SMap.fold (fun k _ m -> SMap.remove k m) map map
-
-let rec seq i =
- if i = 0 then Seq.empty else fun () -> (Seq.Cons (i, seq (i - 1)))
-
-let () =
- seq 1_000_000
- |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
- |> clear
- |> ignore
-\end{caml_example*}
-
-The next step is to compile and link the program with the instrumented runtime.
-This can be done by using the "-runtime-variant" flag:
-
-\begin{verbatim}
- ocamlopt -runtime-variant i program.ml -o program
-\end{verbatim}
-
-Note that the instrumented runtime is an alternative runtime for OCaml
-programs. It is only referenced during the linking stage of the final
-executable. This means that the compilation stage does not need to be altered
-to enable instrumentation.
-
-The resulting program can then be traced by running it with the environment
-variable "OCAML_EVENTLOG_ENABLED":
-
-\begin{verbatim}
- OCAML_EVENTLOG_ENABLED=1 ./program
-\end{verbatim}
-
-During execution, a trace file will be generated in the
-program's current working directory.
-
-\subsubsection*{sss:instr-runtime-build-more}{More build examples}
-
-When using the {\em dune} build system, this compiler invocation can be
-replicated using the {\tt flags} {\tt stanza} when building an executable.
-
-\begin{verbatim}
- (executable
- (name program)
- (flags "-runtime-variant=i"))
-\end{verbatim}
-
-The instrumented runtime can also be used with the OCaml bytecode interpreter.
-This can be done by either using the
-"-runtime-variant=i" flag when linking the program with {\tt ocamlc}, or by running the generated
-bytecode through {\tt ocamlruni}:
-
-\begin{verbatim}
- ocamlc program.ml -o program.byte
- OCAML_EVENTLOG_ENABLED=1 ocamlruni program.byte
-\end{verbatim}
-
-See chapter~\ref{c:camlc} and chapter~\ref{c:runtime} for more information about
-{\tt ocamlc} and {\tt ocamlrun}.
-
-\section{s:instr-runtime-read}{Reading traces}
-
-Traces generated by the instrumented runtime can be analyzed with tooling
-available outside of the OCaml distribution.
-
-A complete trace consists of a {\em metadata file} and a {\em trace file}.
-Two simple ways to work with the traces are the {\em eventlog-tools} and
-{\em babeltrace} libraries.
-
-\subsection{ss:instr-runtime-tools}{eventlog-tools}
-{\em eventlog-tools} is a library implementing a parser, as well as a
-a set of tools that allows to perform basic format conversions and analysis.
-
-For more information about {\em eventlog-tools}, refer to the project's
-main page: \href{https://github.com/ocaml-multicore/eventlog-tools}{https://github.com/ocaml-multicore/eventlog-tools}
-
-\subsection{ss:instr-runtime-babeltrace}{babeltrace}
-
-{\em babeltrace} is a C library, as well as a Python binding and set of tools
-that serve as the reference implementation for the {\em Common Trace Format}.
-The {\em babeltrace} command line utility allows for a basic rendering
-of a trace's content, while the high level Python API can be used to
-decode the trace and process them programmatically with libraries
-such as {\em numpy} or {\em Jupyter}.
-
-Unlike {\em eventlog-tools}, which possesses a specific knowledge of
-OCaml's {\em Common Trace Format} schema, it is required to provide
-the OCaml {\em metadata} file to {\em babeltrace}.
-
-The metadata file is available in the OCaml installation.
-Its location can be obtained using the following command:
-
-\begin{verbatim}
- ocamlc -where
-\end{verbatim}
-
-The {\em eventlog_metadata} file can be found at this path and
-copied in the same directory as the generated trace file.
-However, {\em babeltrace} expects the file to be named
-{\tt metadata} in order to process the trace.
-Thus, it will need to be renamed when copied to the trace's directory.
-
-Here is a naive decoder example, using {\em babeltrace}'s Python
-library, and {\em Python 3.8}:
-
-\begin{verbatim}
-
-import subprocess
-import shutil
-import sys
-import babeltrace as bt
-
-def print_event(ev):
- print(ev['timestamp'])
- print(ev['pid'])
- if ev.name == "entry":
- print('entry_event')
- print(ev['phase'])
- if ev.name == "exit":
- print('exit_event')
- print(ev['phase'])
- if ev.name == "alloc":
- print(ev['count'])
- print(ev['bucket'])
- if ev.name == "counter":
- print(ev['count'])
- print(ev['kind'])
- if ev.name == "flush":
- print("flush")
-
-def get_ocaml_dir():
- # Fetching OCaml's installation directory to extract the CTF metadata
- ocamlc_where = subprocess.run(['ocamlc', '-where'], stdout=subprocess.PIPE)
- ocaml_dir = ocamlc_where.stdout.decode('utf-8').rstrip('\n')
- return(ocaml_dir)
-
-def main():
- trace_dir = sys.argv[1]
- ocaml_dir = get_ocaml_dir()
- metadata_path = ocaml_dir + "/eventlog_metadata"
- # copying the metadata to the trace's directory,
- # and renaming it to 'metadata'.
- shutil.copyfile(metadata_path, trace_dir + "/metadata")
- tr = bt.TraceCollection()
- tr.add_trace(trace_dir, 'ctf')
- for event in tr.events:
- print_event(event)
-
-if __name__ == '__main__':
- main()
-
-\end{verbatim}
-
-This script expect to receive as an argument the directory containing the
-trace file. It will then copy the {\em CTF} metadata file to the trace's
-directory, and then decode the trace, printing each event in the process.
-
-For more information on {\em babeltrace}, see the website at:
-\href{https://babeltrace.org/}{https://babeltrace.org/}
-
-\section{s:instr-runtime-more}{Controlling instrumentation and limitations}
-
-\subsection{ss:instr-runtime-prefix}{Trace filename}
-
-The default trace filename is {\tt caml-\{PID\}.eventlog}, where {\tt \{PID\}}
-is the process identifier of the traced program.
-
-This filename can also be specified using the
-"OCAML_EVENTLOG_PREFIX" environment variable.
-The given path will be suffixed with {\tt \{.PID\}.eventlog}.
-
-\begin{verbatim}
- OCAML_EVENTLOG_PREFIX=/tmp/a_prefix OCAML_EVENTLOG_ENABLED=1 ./program
-\end{verbatim}
-
-In this example, the trace will be available at path
-{\tt /tmp/a_prefix.\{PID\}.eventlog}.
-
-Note that this will only affect the prefix of the trace file, there is no
-option to specify the full effective file name.
-This restriction is in place to make room for future improvements to the
-instrumented runtime, where the single trace file per session design
-may be replaced.
-
-For scripting purpose, matching against `\{PID\}`, as well as the
-{\tt .eventlog} file extension should provide enough control over
-the generated files.
-
-Note as well that parent directories in the given path will not be created
-when opening the trace. The runtime assumes the path is
-accessible for creating and writing the trace. The program will
-fail to start if this requirement isn't met.
-
-\subsection{ss:instr-runtime-pause}{Pausing and resuming tracing}
-Mechanisms are available to control event collection at runtime.
-
-"OCAML_EVENTLOG_ENABLED" can be set to the {\tt p} flag in order
-to start the program with event collection paused.
-
-\begin{verbatim}
- OCAML_EVENTLOG_ENABLED=p ./program
-\end{verbatim}
-
-The program will have to start event collection explicitly.
-Starting and stopping event collection programmatically can be done by calling
-{\tt Gc.eventlog_resume} and {\tt Gc.eventlog_pause}) from within the program.
-Refer to the {\stdmoduleref{Gc}} module documentation for more information.
-
-Running the program provided earlier with "OCAML_EVENTLOG_ENABLED=p"
-will for example yield the following result.
-
-\begin{verbatim}
-$ OCAML_EVENTLOG_ENABLED=p ./program
-$ ocaml-eventlog-report caml-{PID}.eventlog
-==== eventlog/flush
-median flush time: 58ns
-total flush time: 58ns
-flush count: 1
-\end{verbatim}
-
-The resulting trace contains only one event payload, namely a {\em flush} event,
-indicating how much time was spent flushing the trace file to disk.
-
-However, if the program is changed to include a call to
-{\tt Gc.eventlog_resume}, events payloads can be seen again
-in the trace file.
-
-\begin{caml_example*}{verbatim}
- let () =
- Gc.eventlog_resume();
- seq 1_000_000
- |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
- |> clear
- |> ignore
-
-\end{caml_example*}
-
-The resulting trace will contain all events encountered during
-the program's execution:
-
-\begin{verbatim}
- $ ocaml-eventlog-report caml-{PID}.eventlog
- [..omitted..]
- ==== force_minor/alloc_small
- 100.0K..200.0K: 174
- 20.0K..30.0K: 1
- 0..100: 1
-
- ==== eventlog/flush
- median flush time: 207.8us
- total flush time: 938.1us
- flush count: 5
-\end{verbatim}
-
-\subsection{ss:instr-runtime-limitations}{Limitations}
-
-The instrumented runtime does not support the {\tt fork} system call.
-A child process forked from an instrumented program will not be traced.
-
-The instrumented runtime aims to provide insight into the runtime's execution
-while maintaining a low overhead.
-However, this overhead may become more noticeable depending on how a program
-executes.
-The instrumented runtime currently puts a strong emphasis on
-tracing {\em garbage collection} events. This means that programs
-with heavy garbage collection activity may be more susceptible to
-tracing induced performance penalties.
-
-While providing an accurate estimate of potential performance loss is difficult,
-test on various OCaml programs showed a total running time increase ranging
-from 1\% to 8\%.
-
-For a program with an extended running time where the collection of only a
-small sample of events is required, using the {\em eventlog_resume} and
-{\em eventlog_pause} primitives may help relieve some of the
-tracing induced performance impact.
+++ /dev/null
-\chapter{Interfacing\label{c:intf-c} C with OCaml}
-%HEVEA\cutname{intfc.html}
-
-This chapter describes how user-defined primitives, written in C, can
-be linked with OCaml code and called from OCaml functions, and how
-these C functions can call back to OCaml code.
-
-\section{s:c-overview}{Overview and compilation information}
-
-\subsection{ss:c-prim-decl}{Declaring primitives}
-
-\begin{syntax}
-definition: ...
- | 'external' value-name ':' typexpr '=' external-declaration
-;
-external-declaration: string-literal [ string-literal [ string-literal ] ]
-\end{syntax}
-
-User primitives are declared in an implementation file or
-@"struct"\ldots"end"@ module expression using the @"external"@ keyword:
-\begin{alltt}
- external \var{name} : \var{type} = \var{C-function-name}
-\end{alltt}
-This defines the value name \var{name} as a function with type
-\var{type} that executes by calling the given C function.
-For instance, here is how the "seek_in" primitive is declared in the
-standard library module "Stdlib":
-\begin{verbatim}
- external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
-\end{verbatim}
-Primitives with several arguments are always curried. The C function
-does not necessarily have the same name as the ML function.
-
-External functions thus defined can be specified in interface files or
-@"sig"\ldots"end"@ signatures either as regular values
-\begin{alltt}
- val \var{name} : \var{type}
-\end{alltt}
-thus hiding their implementation as C functions, or explicitly as
-``manifest'' external functions
-\begin{alltt}
- external \var{name} : \var{type} = \var{C-function-name}
-\end{alltt}
-The latter is slightly more efficient, as it allows clients of the
-module to call directly the C function instead of going through the
-corresponding OCaml function. On the other hand, it should not be used
-in library modules if they have side-effects at toplevel, as this
-direct call interferes with the linker's algorithm for removing unused
-modules from libraries at link-time.
-
-The arity (number of arguments) of a primitive is automatically
-determined from its OCaml type in the "external" declaration, by
-counting the number of function arrows in the type. For instance,
-"seek_in" above has arity 2, and the "caml_ml_seek_in" C function
-is called with two arguments. Similarly,
-\begin{verbatim}
- external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair"
-\end{verbatim}
-has arity 1, and the "caml_ml_seek_in_pair" C function receives one argument
-(which is a pair of OCaml values).
-
-Type abbreviations are not expanded when determining the arity of a
-primitive. For instance,
-\begin{verbatim}
- type int_endo = int -> int
- external f : int_endo -> int_endo = "f"
- external g : (int -> int) -> (int -> int) = "f"
-\end{verbatim}
-"f" has arity 1, but "g" has arity 2. This allows a primitive to
-return a functional value (as in the "f" example above): just remember
-to name the functional return type in a type abbreviation.
-
-The language accepts external declarations with one or two
-flag strings in addition to the C function's name. These flags are
-reserved for the implementation of the standard library.
-
-\subsection{ss:c-prim-impl}{Implementing primitives}
-
-User primitives with arity $n \leq 5$ are implemented by C functions
-that take $n$ arguments of type "value", and return a result of type
-"value". The type "value" is the type of the representations for OCaml
-values. It encodes objects of several base types (integers,
-floating-point numbers, strings,~\ldots) as well as OCaml data
-structures. The type "value" and the associated conversion
-functions and macros are described in detail below. For instance,
-here is the declaration for the C function implementing the "input"
-primitive:
-\begin{verbatim}
-CAMLprim value input(value channel, value buffer, value offset, value length)
-{
- ...
-}
-\end{verbatim}
-When the primitive function is applied in an OCaml program, the C
-function is called with the values of the expressions to which the
-primitive is applied as arguments. The value returned by the function is
-passed back to the OCaml program as the result of the function
-application.
-
-User primitives with arity greater than 5 should be implemented by two
-C functions. The first function, to be used in conjunction with the
-bytecode compiler "ocamlc", receives two arguments: a pointer to an
-array of OCaml values (the values for the arguments), and an
-integer which is the number of arguments provided. The other function,
-to be used in conjunction with the native-code compiler "ocamlopt",
-takes its arguments directly. For instance, here are the two C
-functions for the 7-argument primitive "Nat.add_nat":
-\begin{verbatim}
-CAMLprim value add_nat_native(value nat1, value ofs1, value len1,
- value nat2, value ofs2, value len2,
- value carry_in)
-{
- ...
-}
-CAMLprim value add_nat_bytecode(value * argv, int argn)
-{
- return add_nat_native(argv[0], argv[1], argv[2], argv[3],
- argv[4], argv[5], argv[6]);
-}
-\end{verbatim}
-The names of the two C functions must be given in the primitive
-declaration, as follows:
-\begin{alltt}
- external \var{name} : \var{type} =
- \var{bytecode-C-function-name} \var{native-code-C-function-name}
-\end{alltt}
-For instance, in the case of "add_nat", the declaration is:
-\begin{verbatim}
- external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
- = "add_nat_bytecode" "add_nat_native"
-\end{verbatim}
-
-Implementing a user primitive is actually two separate tasks: on the
-one hand, decoding the arguments to extract C values from the given
-OCaml values, and encoding the return value as an OCaml
-value; on the other hand, actually computing the result from the arguments.
-Except for very simple primitives, it is often preferable to have two
-distinct C functions to implement these two tasks. The first function
-actually implements the primitive, taking native C values as
-arguments and returning a native C value. The second function,
-often called the ``stub code'', is a simple wrapper around the first
-function that converts its arguments from OCaml values to C values,
-call the first function, and convert the returned C value to OCaml
-value. For instance, here is the stub code for the "input"
-primitive:
-\begin{verbatim}
-CAMLprim value input(value channel, value buffer, value offset, value length)
-{
- return Val_long(getblock((struct channel *) channel,
- &Byte(buffer, Long_val(offset)),
- Long_val(length)));
-}
-\end{verbatim}
-(Here, "Val_long", "Long_val" and so on are conversion macros for the
-type "value", that will be described later. The "CAMLprim" macro
-expands to the required compiler directives to ensure that the
-function is exported and accessible from OCaml.)
-The hard work is performed by the function "getblock", which is
-declared as:
-\begin{verbatim}
-long getblock(struct channel * channel, char * p, long n)
-{
- ...
-}
-\end{verbatim}
-
-To write C code that operates on OCaml values, the following
-include files are provided:
-\begin{tableau}{|l|p{12cm}|}{Include file}{Provides}
-\entree{"caml/mlvalues.h"}{definition of the "value" type, and conversion
-macros}
-\entree{"caml/alloc.h"}{allocation functions (to create structured OCaml
-objects)}
-\entree{"caml/memory.h"}{miscellaneous memory-related functions
-and macros (for GC interface, in-place modification of structures, etc).}
-\entree{"caml/fail.h"}{functions for raising exceptions
-(see section~\ref{ss:c-exceptions})}
-\entree{"caml/callback.h"}{callback from C to OCaml (see
-section~\ref{s:c-callback}).}
-\entree{"caml/custom.h"}{operations on custom blocks (see
-section~\ref{s:c-custom}).}
-\entree{"caml/intext.h"}{operations for writing user-defined
-serialization and deserialization functions for custom blocks
-(see section~\ref{s:c-custom}).}
-\entree{"caml/threads.h"}{operations for interfacing in the presence
- of multiple threads (see section~\ref{s:C-multithreading}).}
-\end{tableau}
-Before including any of these files, you should define the "CAML_NAME_SPACE"
-macro. For instance,
-\begin{verbatim}
-#define CAML_NAME_SPACE
-#include "caml/mlvalues.h"
-#include "caml/fail.h"
-\end{verbatim}
-These files reside in the "caml/" subdirectory of the OCaml
-standard library directory, which is returned by the command
-"ocamlc -where" (usually "/usr/local/lib/ocaml" or "/usr/lib/ocaml").
-
-{\bf Note:}
-Including the header files without first defining "CAML_NAME_SPACE"
-introduces in scope short names for most functions.
-Those short names are deprecated, and may be removed in the future
-because they usually produce clashes with names defined by other
-C libraries.
-
-\subsection{ss:staticlink-c-code}{Statically linking C code with OCaml code}
-
-The OCaml runtime system comprises three main parts: the bytecode
-interpreter, the memory manager, and a set of C functions that
-implement the primitive operations. Some bytecode instructions are
-provided to call these C functions, designated by their offset in a
-table of functions (the table of primitives).
-
-In the default mode, the OCaml linker produces bytecode for the
-standard runtime system, with a standard set of primitives. References
-to primitives that are not in this standard set result in the
-``unavailable C primitive'' error. (Unless dynamic loading of C
-libraries is supported -- see section~\ref{ss:dynlink-c-code} below.)
-
-In the ``custom runtime'' mode, the OCaml linker scans the
-object files and determines the set of required primitives. Then, it
-builds a suitable runtime system, by calling the native code linker with:
-\begin{itemize}
-\item the table of the required primitives;
-\item a library that provides the bytecode interpreter, the
-memory manager, and the standard primitives;
-\item libraries and object code files (".o" files) mentioned on the
-command line for the OCaml linker, that provide implementations
-for the user's primitives.
-\end{itemize}
-This builds a runtime system with the required primitives. The OCaml
-linker generates bytecode for this custom runtime system. The
-bytecode is appended to the end of the custom runtime system, so that
-it will be automatically executed when the output file (custom
-runtime + bytecode) is launched.
-
-To link in ``custom runtime'' mode, execute the "ocamlc" command with:
-\begin{itemize}
-\item the "-custom" option;
-\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
-\item the names of the C object files and libraries (".o" and ".a"
-files) that implement the required primitives. Under Unix and Windows,
-a library named "lib"\var{name}".a" (respectively, ".lib") residing in one of
-the standard library directories can also be specified as "-cclib -l"\var{name}.
-\end{itemize}
-
-If you are using the native-code compiler "ocamlopt", the "-custom"
-flag is not needed, as the final linking phase of "ocamlopt" always
-builds a standalone executable. To build a mixed OCaml/C executable,
-execute the "ocamlopt" command with:
-\begin{itemize}
-\item the names of the desired OCaml native object files (".cmx" and
-".cmxa" files);
-\item the names of the C object files and libraries (".o", ".a",
-".so" or ".dll" files) that implement the required primitives.
-\end{itemize}
-
-Starting with Objective Caml 3.00, it is possible to record the
-"-custom" option as well as the names of C libraries in an OCaml
-library file ".cma" or ".cmxa". For instance, consider an OCaml library
-"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
-which reference C code in "libmylib.a". If the library is
-built as follows:
-\begin{alltt}
- ocamlc -a -o mylib.cma -custom a.cmo b.cmo -cclib -lmylib
-\end{alltt}
-users of the library can simply link with "mylib.cma":
-\begin{alltt}
- ocamlc -o myprog mylib.cma ...
-\end{alltt}
-and the system will automatically add the "-custom" and "-cclib
--lmylib" options, achieving the same effect as
-\begin{alltt}
- ocamlc -o myprog -custom a.cmo b.cmo ... -cclib -lmylib
-\end{alltt}
-The alternative is of course to build the library without extra
-options:
-\begin{alltt}
- ocamlc -a -o mylib.cma a.cmo b.cmo
-\end{alltt}
-and then ask users to provide the "-custom" and "-cclib -lmylib"
-options themselves at link-time:
-\begin{alltt}
- ocamlc -o myprog -custom mylib.cma ... -cclib -lmylib
-\end{alltt}
-The former alternative is more convenient for the final users of the
-library, however.
-
-\subsection{ss:dynlink-c-code}{Dynamically linking C code with OCaml code}
-
-Starting with Objective Caml 3.03, an alternative to static linking of C code
-using the "-custom" code is provided. In this mode, the OCaml linker
-generates a pure bytecode executable (no embedded custom runtime
-system) that simply records the names of dynamically-loaded libraries
-containing the C code. The standard OCaml runtime system "ocamlrun"
-then loads dynamically these libraries, and resolves references to the
-required primitives, before executing the bytecode.
-
-This facility is currently available on all platforms supported by
-OCaml except Cygwin 64 bits.
-
-To dynamically link C code with OCaml code, the C code must first be
-compiled into a shared library (under Unix) or DLL (under Windows).
-This involves 1- compiling the C files with appropriate C compiler
-flags for producing position-independent code (when required by the
-operating system), and 2- building a
-shared library from the resulting object files. The resulting shared
-library or DLL file must be installed in a place where "ocamlrun" can
-find it later at program start-up time (see
-section~\ref{s:ocamlrun-dllpath}).
-Finally (step 3), execute the "ocamlc" command with
-\begin{itemize}
-\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
-\item the names of the C shared libraries (".so" or ".dll" files) that
-implement the required primitives. Under Unix and Windows,
-a library named "dll"\var{name}".so" (respectively, ".dll") residing
-in one of the standard library directories can also be specified as
-"-dllib -l"\var{name}.
-\end{itemize}
-Do {\em not} set the "-custom" flag, otherwise you're back to static linking
-as described in section~\ref{ss:staticlink-c-code}.
-The "ocamlmklib" tool (see section~\ref{s:ocamlmklib})
-automates steps 2 and 3.
-
-As in the case of static linking, it is possible (and recommended) to
-record the names of C libraries in an OCaml ".cma" library archive.
-Consider again an OCaml library
-"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
-which reference C code in "dllmylib.so". If the library is
-built as follows:
-\begin{alltt}
- ocamlc -a -o mylib.cma a.cmo b.cmo -dllib -lmylib
-\end{alltt}
-users of the library can simply link with "mylib.cma":
-\begin{alltt}
- ocamlc -o myprog mylib.cma ...
-\end{alltt}
-and the system will automatically add the "-dllib -lmylib" option,
-achieving the same effect as
-\begin{alltt}
- ocamlc -o myprog a.cmo b.cmo ... -dllib -lmylib
-\end{alltt}
-Using this mechanism, users of the library "mylib.cma" do not need to
-known that it references C code, nor whether this C code must be
-statically linked (using "-custom") or dynamically linked.
-
-\subsection{ss:c-static-vs-dynamic}{Choosing between static linking and dynamic linking}
-
-After having described two different ways of linking C code with OCaml
-code, we now review the pros and cons of each, to help developers of
-mixed OCaml/C libraries decide.
-
-The main advantage of dynamic linking is that it preserves the
-platform-independence of bytecode executables. That is, the bytecode
-executable contains no machine code, and can therefore be compiled on
-platform $A$ and executed on other platforms $B$, $C$, \ldots, as long
-as the required shared libraries are available on all these
-platforms. In contrast, executables generated by "ocamlc -custom" run
-only on the platform on which they were created, because they embark a
-custom-tailored runtime system specific to that platform. In
-addition, dynamic linking results in smaller executables.
-
-Another advantage of dynamic linking is that the final users of the
-library do not need to have a C compiler, C linker, and C runtime
-libraries installed on their machines. This is no big deal under
-Unix and Cygwin, but many Windows users are reluctant to install
-Microsoft Visual C just to be able to do "ocamlc -custom".
-
-There are two drawbacks to dynamic linking. The first is that the
-resulting executable is not stand-alone: it requires the shared
-libraries, as well as "ocamlrun", to be installed on the machine
-executing the code. If you wish to distribute a stand-alone
-executable, it is better to link it statically, using "ocamlc -custom
--ccopt -static" or "ocamlopt -ccopt -static". Dynamic linking also
-raises the ``DLL hell'' problem: some care must be taken to ensure
-that the right versions of the shared libraries are found at start-up
-time.
-
-The second drawback of dynamic linking is that it complicates the
-construction of the library. The C compiler and linker flags to
-compile to position-independent code and build a shared library vary
-wildly between different Unix systems. Also, dynamic linking is not
-supported on all Unix systems, requiring a fall-back case to static
-linking in the Makefile for the library. The "ocamlmklib" command
-(see section~\ref{s:ocamlmklib}) tries to hide some of these system
-dependencies.
-
-In conclusion: dynamic linking is highly recommended under the native
-Windows port, because there are no portability problems and it is much
-more convenient for the end users. Under Unix, dynamic linking should
-be considered for mature, frequently used libraries because it
-enhances platform-independence of bytecode executables. For new or
-rarely-used libraries, static linking is much simpler to set up in a
-portable way.
-
-\subsection{ss:custom-runtime}{Building standalone custom runtime systems}
-
-It is sometimes inconvenient to build a custom runtime system each
-time OCaml code is linked with C libraries, like "ocamlc -custom" does.
-For one thing, the building of the runtime system is slow on some
-systems (that have bad linkers or slow remote file systems); for
-another thing, the platform-independence of bytecode files is lost,
-forcing to perform one "ocamlc -custom" link per platform of interest.
-
-An alternative to "ocamlc -custom" is to build separately a custom
-runtime system integrating the desired C libraries, then generate
-``pure'' bytecode executables (not containing their own runtime
-system) that can run on this custom runtime. This is achieved by the
-"-make-runtime" and "-use-runtime" flags to "ocamlc". For example,
-to build a custom runtime system integrating the C parts of the
-``Unix'' and ``Threads'' libraries, do:
-\begin{verbatim}
- ocamlc -make-runtime -o /home/me/ocamlunixrun unix.cma threads.cma
-\end{verbatim}
-To generate a bytecode executable that runs on this runtime system,
-do:
-\begin{alltt}
- ocamlc -use-runtime /home/me/ocamlunixrun -o myprog \char92
- unix.cma threads.cma {\it{your .cmo and .cma files}}
-\end{alltt}
-The bytecode executable "myprog" can then be launched as usual:
-"myprog" \var{args} or "/home/me/ocamlunixrun myprog" \var{args}.
-
-Notice that the bytecode libraries "unix.cma" and "threads.cma" must
-be given twice: when building the runtime system (so that "ocamlc"
-knows which C primitives are required) and also when building the
-bytecode executable (so that the bytecode from "unix.cma" and
-"threads.cma" is actually linked in).
-
-\section{s:c-value}{The \texttt{value} type}
-
-All OCaml objects are represented by the C type "value",
-defined in the include file "caml/mlvalues.h", along with macros to
-manipulate values of that type. An object of type "value" is either:
-\begin{itemize}
-\item an unboxed integer;
-\item or a pointer to a block inside the heap,
-allocated through one of the \verb"caml_alloc_*" functions described
-in section~\ref{ss:c-block-allocation}.
-\end{itemize}
-
-\subsection{ss:c-int}{Integer values}
-
-Integer values encode 63-bit signed integers (31-bit on 32-bit
-architectures). They are unboxed (unallocated).
-
-\subsection{ss:c-blocks}{Blocks}
-
-Blocks in the heap are garbage-collected, and therefore have strict
-structure constraints. Each block includes a header containing the
-size of the block (in words), and the tag of the block.
-The tag governs how the contents of the blocks are structured. A tag
-lower than "No_scan_tag" indicates a structured block, containing
-well-formed values, which is recursively traversed by the garbage
-collector. A tag greater than or equal to "No_scan_tag" indicates a
-raw block, whose contents are not scanned by the garbage collector.
-For the benefit of ad-hoc polymorphic primitives such as equality and
-structured input-output, structured and raw blocks are further
-classified according to their tags as follows:
-\begin{tableau}{|l|p{10cm}|}{Tag}{Contents of the block}
-\entree{0 to $\hbox{"No_scan_tag"}-1$}{A structured block (an array of
-OCaml objects). Each field is a "value".}
-\entree{"Closure_tag"}{A closure representing a functional value. The first
-word is a pointer to a piece of code, the remaining words are
-"value" containing the environment.}
-\entree{"String_tag"}{A character string or a byte sequence.}
-\entree{"Double_tag"}{A double-precision floating-point number.}
-\entree{"Double_array_tag"}{An array or record of double-precision
-floating-point numbers.}
-\entree{"Abstract_tag"}{A block representing an abstract datatype.}
-\entree{"Custom_tag"}{A block representing an abstract datatype
- with user-defined finalization, comparison, hashing,
- serialization and deserialization functions attached.}
-\end{tableau}
-
-\subsection{ss:c-outside-head}{Pointers outside the heap}
-
-In earlier versions of OCaml, it was possible to use
-word-aligned pointers to addresses outside the heap as OCaml values,
-just by casting the pointer to type "value". Starting with OCaml
-4.11, this usage is deprecated and will stop being supported in OCaml 5.00.
-
-A correct way to manipulate pointers to out-of-heap blocks from
-OCaml is to store those pointers in OCaml blocks with tag
-"Abstract_tag" or "Custom_tag", then use the blocks as the OCaml
-values.
-
-Here is an example of encapsulation of out-of-heap pointers of C type
-"ty *" inside "Abstract_tag" blocks. Section~\ref{s:c-intf-example}
-gives a more complete example using "Custom_tag" blocks.
-\begin{verbatim}
-/* Create an OCaml value encapsulating the pointer p */
-static value val_of_typtr(ty * p)
-{
- value v = caml_alloc(1, Abstract_tag);
- *((ty **) Data_abstract_val(v)) = p;
- return v;
-}
-
-/* Extract the pointer encapsulated in the given OCaml value */
-static ty * typtr_of_val(value v)
-{
- return *((ty **) Data_abstract_val(v));
-}
-\end{verbatim}
-Alternatively, out-of-heap pointers can be treated as ``native''
-integers, that is, boxed 32-bit integers on a 32-bit platform and
-boxed 64-bit integers on a 64-bit platform.
-\begin{verbatim}
-/* Create an OCaml value encapsulating the pointer p */
-static value val_of_typtr(ty * p)
-{
- return caml_copy_nativeint((intnat) p);
-}
-
-/* Extract the pointer encapsulated in the given OCaml value */
-static ty * typtr_of_val(value v)
-{
- return (ty *) Nativeint_val(v);
-}
-\end{verbatim}
-For pointers that are at least 2-aligned (the low bit is guaranteed to
-be zero), we have yet another valid representation as an OCaml tagged
-integer.
-\begin{verbatim}
-/* Create an OCaml value encapsulating the pointer p */
-static value val_of_typtr(ty * p)
-{
- assert (((uintptr_t) p & 1) == 0); /* check correct alignment */
- return (value) p | 1;
-}
-
-/* Extract the pointer encapsulated in the given OCaml value */
-static ty * typtr_of_val(value v)
-{
- return (ty *) (v & ~1);
-}
-\end{verbatim}
-
-
-\section{s:c-ocaml-datatype-repr}{Representation of OCaml data types}
-
-This section describes how OCaml data types are encoded in the
-"value" type.
-
-\subsection{ss:c-atomic}{Atomic types}
-
-\begin{tableau}{|l|l|}{OCaml type}{Encoding}
-\entree{"int"}{Unboxed integer values.}
-\entree{"char"}{Unboxed integer values (ASCII code).}
-\entree{"float"}{Blocks with tag "Double_tag".}
-\entree{"bytes"}{Blocks with tag "String_tag".}
-\entree{"string"}{Blocks with tag "String_tag".}
-\entree{"int32"}{Blocks with tag "Custom_tag".}
-\entree{"int64"}{Blocks with tag "Custom_tag".}
-\entree{"nativeint"}{Blocks with tag "Custom_tag".}
-\end{tableau}
-
-\subsection{ss:c-tuples-and-records}{Tuples and records}
-
-Tuples are represented by pointers to blocks, with tag~0.
-
-Records are also represented by zero-tagged blocks. The ordering of
-labels in the record type declaration determines the layout of
-the record fields: the value associated to the label
-declared first is stored in field~0 of the block, the value associated
-to the second label goes in field~1, and so on.
-
-As an optimization, records whose fields all have static type "float"
-are represented as arrays of floating-point numbers, with tag
-"Double_array_tag". (See the section below on arrays.)
-
-As another optimization, unboxable record types are represented
-specially; unboxable record types are the immutable record types that
-have only one field. An unboxable type will be represented in one of
-two ways: boxed or unboxed. Boxed record types are represented as
-described above (by a block with tag 0 or "Double_array_tag"). An
-unboxed record type is represented directly by the value of its field
-(i.e. there is no block to represent the record itself).
-
-The representation is chosen according to the following, in decreasing
-order of priority:
-\begin{itemize}
-\item An attribute ("[\@\@boxed]" or "[\@\@unboxed]") on the type declaration.
-\item A compiler option ("-unboxed-types" or "-no-unboxed-types").
-\item The default representation. In the present version of OCaml, the
-default is the boxed representation.
-\end{itemize}
-
-\subsection{ss:c-arrays}{Arrays}
-
-Arrays of integers and pointers are represented like tuples,
-that is, as pointers to blocks tagged~0. They are accessed with the
-"Field" macro for reading and the "caml_modify" function for writing.
-
-Arrays of floating-point numbers (type "float array")
-have a special, unboxed, more efficient representation.
-These arrays are represented by pointers to blocks with tag
-"Double_array_tag". They should be accessed with the "Double_field"
-and "Store_double_field" macros.
-
-\subsection{ss:c-concrete-datatypes}{Concrete data types}
-
-Constructed terms are represented either by unboxed integers (for
-constant constructors) or by blocks whose tag encode the constructor
-(for non-constant constructors). The constant constructors and the
-non-constant constructors for a given concrete type are numbered
-separately, starting from 0, in the order in which they appear in the
-concrete type declaration. A constant constructor is represented by
-the unboxed integer equal to its constructor number. A non-constant
-constructor declared with $n$ arguments is represented by
-a block of size $n$, tagged with the constructor number; the $n$
-fields contain its arguments. Example:
-
-\begin{tableau}{|l|p{8cm}|}{Constructed term}{Representation}
-\entree{"()"}{"Val_int(0)"}
-\entree{"false"}{"Val_int(0)"}
-\entree{"true"}{"Val_int(1)"}
-\entree{"[]"}{"Val_int(0)"}
-\entree{"h::t"}{Block with size = 2 and tag = 0; first field
-contains "h", second field "t".}
-\end{tableau}
-
-As a convenience, "caml/mlvalues.h" defines the macros "Val_unit",
-"Val_false" and "Val_true" to refer to "()", "false" and "true".
-
-The following example illustrates the assignment of
-integers and block tags to constructors:
-\begin{verbatim}
-type t =
- | A (* First constant constructor -> integer "Val_int(0)" *)
- | B of string (* First non-constant constructor -> block with tag 0 *)
- | C (* Second constant constructor -> integer "Val_int(1)" *)
- | D of bool (* Second non-constant constructor -> block with tag 1 *)
- | E of t * t (* Third non-constant constructor -> block with tag 2 *)
-\end{verbatim}
-
-
-As an optimization, unboxable concrete data types are represented
-specially; a concrete data type is unboxable if it has exactly one
-constructor and this constructor has exactly one argument. Unboxable
-concrete data types are represented in the same ways as unboxable
-record types: see the description in
-section~\ref{ss:c-tuples-and-records}.
-
-\subsection{ss:c-objects}{Objects}
-
-Objects are represented as blocks with tag "Object_tag". The first
-field of the block refers to the object's class and associated method
-suite, in a format that cannot easily be exploited from C. The second
-field contains a unique object ID, used for comparisons. The remaining
-fields of the object contain the values of the instance variables of
-the object. It is unsafe to access directly instance variables, as the
-type system provides no guarantee about the instance variables
-contained by an object.
-% Instance variables are stored in the order in which they
-% appear in the class definition (taking inherited classes into
-% account).
-
-One may extract a public method from an object using the C function
-"caml_get_public_method" (declared in "<caml/mlvalues.h>".)
-Since public method tags are hashed in the same way as variant tags,
-and methods are functions taking self as first argument, if you want
-to do the method call "foo#bar" from the C side, you should call:
-\begin{verbatim}
- callback(caml_get_public_method(foo, hash_variant("bar")), foo);
-\end{verbatim}
-
-\subsection{ss:c-polyvar}{Polymorphic variants}
-
-Like constructed terms, polymorphic variant values are represented either
-as integers (for polymorphic variants without argument), or as blocks
-(for polymorphic variants with an argument). Unlike constructed
-terms, variant constructors are not numbered starting from 0, but
-identified by a hash value (an OCaml integer), as computed by the C function
-"hash_variant" (declared in "<caml/mlvalues.h>"):
-the hash value for a variant constructor named, say, "VConstr"
-is "hash_variant(\"VConstr\")".
-
-The variant value "`VConstr" is represented by
-"hash_variant(\"VConstr\")". The variant value "`VConstr("\var{v}")" is
-represented by a block of size 2 and tag 0, with field number 0
-containing "hash_variant(\"VConstr\")" and field number 1 containing
-\var{v}.
-
-Unlike constructed values, polymorphic variant values taking several
-arguments are not flattened.
-That is, "`VConstr("\var{v}", "\var{w}")" is represented by a block
-of size 2, whose field number 1 contains the representation of the
-pair "("\var{v}", "\var{w}")", rather than a block of size 3
-containing \var{v} and \var{w} in fields 1 and 2.
-
-\section{s:c-ops-on-values}{Operations on values}
-
-\subsection{ss:c-kind-tests}{Kind tests}
-
-\begin{itemize}
-\item "Is_long("\var{v}")" is true if value \var{v} is an immediate integer,
-false otherwise
-\item "Is_block("\var{v}")" is true if value \var{v} is a pointer to a block,
-and false if it is an immediate integer.
-\item "Is_none("\var{v}")" is true if value \var{v} is "None".
-\item "Is_some("\var{v}")" is true if value \var{v} (assumed to be of option
-type) corresponds to the "Some" constructor.
-\end{itemize}
-
-\subsection{ss:c-int-ops}{Operations on integers}
-
-\begin{itemize}
-\item "Val_long("\var{l}")" returns the value encoding the "long int" \var{l}.
-\item "Long_val("\var{v}")" returns the "long int" encoded in value \var{v}.
-\item "Val_int("\var{i}")" returns the value encoding the "int" \var{i}.
-\item "Int_val("\var{v}")" returns the "int" encoded in value \var{v}.
-\item "Val_bool("\var{x}")" returns the OCaml boolean representing the
-truth value of the C integer \var{x}.
-\item "Bool_val("\var{v}")" returns 0 if \var{v} is the OCaml boolean
-"false", 1 if \var{v} is "true".
-\item "Val_true", "Val_false" represent the OCaml booleans "true" and "false".
-\item "Val_none" represents the OCaml value "None".
-\end{itemize}
-
-\subsection{ss:c-block-access}{Accessing blocks}
-
-\begin{itemize}
-\item "Wosize_val("\var{v}")" returns the size of the block \var{v}, in words,
-excluding the header.
-\item "Tag_val("\var{v}")" returns the tag of the block \var{v}.
-\item "Field("\var{v}", "\var{n}")" returns the value contained in the
-$n\th$ field of the structured block \var{v}. Fields are numbered from 0 to
-$\hbox{"Wosize_val"}(v)-1$.
-\item "Store_field("\var{b}", "\var{n}", "\var{v}")" stores the value
-\var{v} in the field number \var{n} of value \var{b}, which must be a
-structured block.
-\item "Code_val("\var{v}")" returns the code part of the closure \var{v}.
-\item "caml_string_length("\var{v}")" returns the length (number of bytes)
-of the string or byte sequence \var{v}.
-\item "Byte("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
-or byte sequence \var{v}, with type "char". Bytes are numbered from 0 to
-$\hbox{"string_length"}(v)-1$.
-\item "Byte_u("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
-or byte sequence \var{v}, with type "unsigned char". Bytes are
-numbered from 0 to $\hbox{"string_length"}(v)-1$.
-\item "String_val("\var{v}")" returns a pointer to the first byte of the string
-\var{v}, with type "char *" or, when OCaml is configured with
-"-force-safe-string", with type "const char *".
-This pointer is a valid C string: there is a null byte after the last
-byte in the string. However, OCaml strings can contain embedded null bytes,
-which will confuse the usual C functions over strings.
-\item "Bytes_val("\var{v}")" returns a pointer to the first byte of the
-byte sequence \var{v}, with type "unsigned char *".
-\item "Double_val("\var{v}")" returns the floating-point number contained in
-value \var{v}, with type "double".
-\item "Double_field("\var{v}", "\var{n}")" returns
-the $n\th$ element of the array of floating-point numbers \var{v} (a
-block tagged "Double_array_tag").
-\item "Store_double_field("\var{v}", "\var{n}",
-"\var{d}")" stores the double precision floating-point number \var{d}
-in the $n\th$ element of the array of floating-point numbers \var{v}.
-\item "Data_custom_val("\var{v}")" returns a pointer to the data part
-of the custom block \var{v}. This pointer has type "void *" and must
-be cast to the type of the data contained in the custom block.
-\item "Int32_val("\var{v}")" returns the 32-bit integer contained
-in the "int32" \var{v}.
-\item "Int64_val("\var{v}")" returns the 64-bit integer contained
-in the "int64" \var{v}.
-\item "Nativeint_val("\var{v}")" returns the long integer contained
-in the "nativeint" \var{v}.
-\item "caml_field_unboxed("\var{v}")" returns the value of the field
-of a value \var{v} of any unboxed type (record or concrete data type).
-\item "caml_field_boxed("\var{v}")" returns the value of the field
-of a value \var{v} of any boxed type (record or concrete data type).
-\item "caml_field_unboxable("\var{v}")" calls either
-"caml_field_unboxed" or "caml_field_boxed" according to the default
-representation of unboxable types in the current version of OCaml.
-\item "Some_val("\var{v}")" returns the argument "\var{x}" of a value \var{v} of
-the form "Some("\var{x}")".
-\end{itemize}
-The expressions "Field("\var{v}", "\var{n}")",
-"Byte("\var{v}", "\var{n}")" and
-"Byte_u("\var{v}", "\var{n}")"
-are valid l-values. Hence, they can be assigned to, resulting in an
-in-place modification of value \var{v}.
-Assigning directly to "Field("\var{v}", "\var{n}")" must
-be done with care to avoid confusing the garbage collector (see
-below).
-
-\subsection{ss:c-block-allocation}{Allocating blocks}
-
-\subsubsection{sss:c-simple-allocation}{Simple interface}
-
-\begin{itemize}
-\item
-"Atom("\var{t}")" returns an ``atom'' (zero-sized block) with tag \var{t}.
-Zero-sized blocks are preallocated outside of the heap. It is
-incorrect to try and allocate a zero-sized block using the functions below.
-For instance, "Atom(0)" represents the empty array.
-\item
-"caml_alloc("\var{n}", "\var{t}")" returns a fresh block of size \var{n}
-with tag \var{t}. If \var{t} is less than "No_scan_tag", then the
-fields of the block are initialized with a valid value in order to
-satisfy the GC constraints.
-\item
-"caml_alloc_tuple("\var{n}")" returns a fresh block of size
-\var{n} words, with tag 0.
-\item
-"caml_alloc_string("\var{n}")" returns a byte sequence (or string) value of
-length \var{n} bytes. The sequence initially contains uninitialized bytes.
-\item
-"caml_alloc_initialized_string("\var{n}", "\var{p}")" returns a byte sequence
-(or string) value of length \var{n} bytes. The value is initialized from the
-\var{n} bytes starting at address \var{p}.
-\item
-"caml_copy_string("\var{s}")" returns a string or byte sequence value
-containing a copy of the null-terminated C string \var{s} (a "char *").
-\item
-"caml_copy_double("\var{d}")" returns a floating-point value initialized
-with the "double" \var{d}.
-\item
-"caml_copy_int32("\var{i}")", "caml_copy_int64("\var{i}")" and
-"caml_copy_nativeint("\var{i}")" return a value of OCaml type "int32",
-"int64" and "nativeint", respectively, initialized with the integer
-\var{i}.
-\item
-"caml_alloc_array("\var{f}", "\var{a}")" allocates an array of values, calling
-function \var{f} over each element of the input array \var{a} to transform it
-into a value. The array \var{a} is an array of pointers terminated by the
-null pointer. The function \var{f} receives each pointer as argument, and
-returns a value. The zero-tagged block returned by
-"alloc_array("\var{f}", "\var{a}")" is filled with the values returned by the
-successive calls to \var{f}. (This function must not be used to build
-an array of floating-point numbers.)
-\item
-"caml_copy_string_array("\var{p}")" allocates an array of strings or byte
-sequences, copied from the pointer to a string array \var{p}
-(a "char **"). \var{p} must be NULL-terminated.
-\item "caml_alloc_float_array("\var{n}")" allocates an array of floating point
- numbers of size \var{n}. The array initially contains uninitialized values.
-\item "caml_alloc_unboxed("\var{v}")" returns the value (of any unboxed
-type) whose field is the value \var{v}.
-\item "caml_alloc_boxed("\var{v}")" allocates and returns a value (of
-any boxed type) whose field is the value \var{v}.
-\item "caml_alloc_unboxable("\var{v}")" calls either
-"caml_alloc_unboxed" or "caml_alloc_boxed" according to the default
-representation of unboxable types in the current version of OCaml.
-\item "caml_alloc_some("\var{v}")" allocates a block representing
-"Some("\var{v}")".
-\end{itemize}
-
-\subsubsection{sss:c-low-level-alloc}{Low-level interface}
-
-The following functions are slightly more efficient than "caml_alloc", but
-also much more difficult to use.
-
-From the standpoint of the allocation functions, blocks are divided
-according to their size as zero-sized blocks, small blocks (with size
-less than or equal to \verb"Max_young_wosize"), and large blocks (with
-size greater than \verb"Max_young_wosize"). The constant
-\verb"Max_young_wosize" is declared in the include file "mlvalues.h". It
-is guaranteed to be at least 64 (words), so that any block with
-constant size less than or equal to 64 can be assumed to be small. For
-blocks whose size is computed at run-time, the size must be compared
-against \verb"Max_young_wosize" to determine the correct allocation procedure.
-
-\begin{itemize}
-\item
-"caml_alloc_small("\var{n}", "\var{t}")" returns a fresh small block of size
-$n \leq \hbox{"Max_young_wosize"}$ words, with tag \var{t}.
-If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
-the fields of the block (initially containing garbage) must be initialized
-with legal values (using direct assignment to the fields of the block)
-before the next allocation.
-\item
-"caml_alloc_shr("\var{n}", "\var{t}")" returns a fresh block of size
-\var{n}, with tag \var{t}.
-The size of the block can be greater than \verb"Max_young_wosize". (It
-can also be smaller, but in this case it is more efficient to call
-"caml_alloc_small" instead of "caml_alloc_shr".)
-If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
-the fields of the block (initially containing garbage) must be initialized
-with legal values (using the "caml_initialize" function described below)
-before the next allocation.
-\end{itemize}
-
-\subsection{ss:c-exceptions}{Raising exceptions}
-
-Two functions are provided to raise two standard exceptions:
-\begin{itemize}
-\item "caml_failwith("\var{s}")", where \var{s} is a null-terminated C string (with
-type \verb"char *"), raises exception "Failure" with argument \var{s}.
-\item "caml_invalid_argument("\var{s}")", where \var{s} is a null-terminated C
-string (with type \verb"char *"), raises exception "Invalid_argument"
-with argument \var{s}.
-\end{itemize}
-
-Raising arbitrary exceptions from C is more delicate: the
-exception identifier is dynamically allocated by the OCaml program, and
-therefore must be communicated to the C function using the
-registration facility described below in section~\ref{ss:c-register-exn}.
-Once the exception identifier is recovered in C, the following
-functions actually raise the exception:
-\begin{itemize}
-\item "caml_raise_constant("\var{id}")" raises the exception \var{id} with
-no argument;
-\item "caml_raise_with_arg("\var{id}", "\var{v}")" raises the exception
-\var{id} with the OCaml value \var{v} as argument;
-\item "caml_raise_with_args("\var{id}", "\var{n}", "\var{v}")"
-raises the exception \var{id} with the OCaml values
-\var{v}"[0]", \ldots, \var{v}"["\var{n}"-1]" as arguments;
-\item "caml_raise_with_string("\var{id}", "\var{s}")", where \var{s} is a
-null-terminated C string, raises the exception \var{id} with a copy of
-the C string \var{s} as argument.
-\end{itemize}
-
-\section{s:c-gc-harmony}{Living in harmony with the garbage collector}
-
-Unused blocks in the heap are automatically reclaimed by the garbage
-collector. This requires some cooperation from C code that
-manipulates heap-allocated blocks.
-
-\subsection{ss:c-simple-gc-harmony}{Simple interface}
-
-All the macros described in this section are declared in the
-"memory.h" header file.
-
-\begin{gcrule}
-A function that has parameters or local variables of type "value" must
-begin with a call to one of the "CAMLparam" macros and return with
-"CAMLreturn", "CAMLreturn0", or "CAMLreturnT". In particular, "CAMLlocal"
-and "CAMLxparam" can only be called \emph{after} "CAMLparam".
-\end{gcrule}
-
-There are six "CAMLparam" macros: "CAMLparam0" to "CAMLparam5", which
-take zero to five arguments respectively. If your function has no more
-than 5 parameters of type "value", use the corresponding macros
-with these parameters as arguments. If your function has more than 5
-parameters of type "value", use "CAMLparam5" with five of these
-parameters, and use one or more calls to the "CAMLxparam" macros for
-the remaining parameters ("CAMLxparam1" to "CAMLxparam5").
-
-The macros "CAMLreturn", "CAMLreturn0", and "CAMLreturnT" are used to
-replace the C
-keyword "return". Every occurrence of "return x" must be replaced by
-"CAMLreturn (x)" if "x" has type "value", or "CAMLreturnT (t, x)"
-(where "t" is the type of "x"); every occurrence of "return" without
-argument must be
-replaced by "CAMLreturn0". If your C function is a procedure (i.e. if
-it returns void), you must insert "CAMLreturn0" at the end (to replace
-C's implicit "return").
-
-\paragraph{Note:} some C compilers give bogus warnings about unused
-variables "caml__dummy_xxx" at each use of "CAMLparam" and
-"CAMLlocal". You should ignore them.
-
-\goodbreak
-
-Example:
-\begin{verbatim}
-void foo (value v1, value v2, value v3)
-{
- CAMLparam3 (v1, v2, v3);
- ...
- CAMLreturn0;
-}
-\end{verbatim}
-
-\paragraph{Note:} if your function is a primitive with more than 5 arguments
-for use with the byte-code runtime, its arguments are not "value"s and
-must not be declared (they have types "value *" and "int").
-
-\begin{gcrule}
-Local variables of type "value" must be declared with one of the
-"CAMLlocal" macros. Arrays of "value"s are declared with
-"CAMLlocalN". These macros must be used at the beginning of the
-function, not in a nested block.
-\end{gcrule}
-
-The macros "CAMLlocal1" to "CAMLlocal5" declare and initialize one to
-five local variables of type "value". The variable names are given as
-arguments to the macros. "CAMLlocalN("\var{x}", "\var{n}")" declares
-and initializes a local variable of type "value ["\var{n}"]". You can
-use several calls to these macros if you have more than 5 local
-variables.
-
-Example:
-\begin{verbatim}
-CAMLprim value bar (value v1, value v2, value v3)
-{
- CAMLparam3 (v1, v2, v3);
- CAMLlocal1 (result);
- result = caml_alloc (3, 0);
- ...
- CAMLreturn (result);
-}
-\end{verbatim}
-
-\begin{gcrule}
-Assignments to the fields of structured blocks must be done with the
-"Store_field" macro (for normal blocks) or "Store_double_field" macro
-(for arrays and records of floating-point numbers). Other assignments
-must not use "Store_field" nor "Store_double_field".
-\end{gcrule}
-
-"Store_field ("\var{b}", "\var{n}", "\var{v}")" stores the value
-\var{v} in the field number \var{n} of value \var{b}, which must be a
-block (i.e. "Is_block("\var{b}")" must be true).
-
-Example:
-\begin{verbatim}
-CAMLprim value bar (value v1, value v2, value v3)
-{
- CAMLparam3 (v1, v2, v3);
- CAMLlocal1 (result);
- result = caml_alloc (3, 0);
- Store_field (result, 0, v1);
- Store_field (result, 1, v2);
- Store_field (result, 2, v3);
- CAMLreturn (result);
-}
-\end{verbatim}
-
-\paragraph{Warning:} The first argument of "Store_field" and
-"Store_double_field" must be a variable declared by "CAMLparam*" or
-a parameter declared by "CAMLlocal*" to ensure that a garbage
-collection triggered by the evaluation of the other arguments will not
-invalidate the first argument after it is computed.
-
-\paragraph{Use with CAMLlocalN:} Arrays of values declared using
-"CAMLlocalN" must not be written to using "Store_field".
-Use the normal C array syntax instead.
-
-\begin{gcrule} Global variables containing values must be registered
-with the garbage collector using the "caml_register_global_root" function,
-save that global variables and locations that will only ever contain OCaml
-integers (and never pointers) do not have to be registered.
-
-The same is true for any memory location outside the OCaml heap that contains a
-value and is not guaranteed to be reachable---for as long as it contains such
-value---from either another registered global variable or location, local
-variable declared with "CAMLlocal" or function parameter declared with
-"CAMLparam".
-\end{gcrule}
-
-Registration of a global variable "v" is achieved by calling
-"caml_register_global_root(&v)" just before or just after a valid value is
-stored in "v" for the first time; likewise, registration of an arbitrary
-location "p" is achieved by calling "caml_register_global_root(p)".
-
-You must not call any of the OCaml runtime functions or macros between
-registering and storing the value. Neither must you store anything in the
-variable "v" (likewise, the location "p") that is not a valid value.
-
-The registration causes the contents of the variable or memory location to be
-updated by the garbage collector whenever the value in such variable or location
-is moved within the OCaml heap. In the presence of threads care must be taken to
-ensure appropriate synchronisation with the OCaml runtime to avoid a race
-condition against the garbage collector when reading or writing the value. (See
-section
-\ref{ss:parallel-execution-long-running-c-code}.)
-
-A registered global variable "v" can be un-registered by calling
-"caml_remove_global_root(&v)".
-
-If the contents of the global variable "v" are seldom modified after
-registration, better performance can be achieved by calling
-"caml_register_generational_global_root(&v)" to register "v" (after
-its initialization with a valid "value", but before any allocation or
-call to the GC functions),
-and "caml_remove_generational_global_root(&v)" to un-register it. In
-this case, you must not modify the value of "v" directly, but you must
-use "caml_modify_generational_global_root(&v,x)" to set it to "x".
-The garbage collector takes advantage of the guarantee that "v" is not
-modified between calls to "caml_modify_generational_global_root" to scan it
-less often. This improves performance if the
-modifications of "v" happen less often than minor collections.
-
-\paragraph{Note:} The "CAML" macros use identifiers (local variables, type
-identifiers, structure tags) that start with "caml__". Do not use any
-identifier starting with "caml__" in your programs.
-
-\subsection{ss:c-low-level-gc-harmony}{Low-level interface}
-
-% Il faudrait simplifier violemment ce qui suit.
-% En gros, dire quand on n'a pas besoin de declarer les variables
-% et dans quels cas on peut se passer de "Store_field".
-
-We now give the GC rules corresponding to the low-level allocation
-functions "caml_alloc_small" and "caml_alloc_shr". You can ignore those rules
-if you stick to the simplified allocation function "caml_alloc".
-
-\begin{gcrule} After a structured block (a block with tag less than
-"No_scan_tag") is allocated with the low-level functions, all fields
-of this block must be filled with well-formed values before the next
-allocation operation. If the block has been allocated with
-"caml_alloc_small", filling is performed by direct assignment to the fields
-of the block:
-\begin{alltt}
- Field(\var{v}, \var{n}) = \nth{v}{n};
-\end{alltt}
-If the block has been allocated with "caml_alloc_shr", filling is performed
-through the "caml_initialize" function:
-\begin{alltt}
- caml_initialize(&Field(\var{v}, \var{n}), \nth{v}{n});
-\end{alltt}
-\end{gcrule}
-
-The next allocation can trigger a garbage collection. The garbage
-collector assumes that all structured blocks contain well-formed
-values. Newly created blocks contain random data, which generally do
-not represent well-formed values.
-
-If you really need to allocate before the fields can receive their
-final value, first initialize with a constant value (e.g.
-"Val_unit"), then allocate, then modify the fields with the correct
-value (see rule~6).
-
-%% \begin{gcrule} Local variables and function parameters containing
-%% values must be registered with the garbage collector (using the
-%% "Begin_roots" and "End_roots" macros), if they are to survive a call
-%% to an allocation function.
-%% \end{gcrule}
-%%
-%% Registration is performed with the "Begin_roots" set of macros.
-%% "Begin_roots1("\var{v}")" registers variable \var{v} with the garbage
-%% collector. Generally, \var{v} will be a local variable or a
-%% parameter of your function. It must be initialized to a valid value
-%% (e.g. "Val_unit") before the first allocation. Likewise,
-%% "Begin_roots2", \ldots, "Begin_roots5"
-%% let you register up to 5 variables at the same time. "Begin_root" is
-%% the same as "Begin_roots1". "Begin_roots_block("\var{ptr}","\var{size}")"
-%% allows you to register an array of roots. \var{ptr} is a pointer to
-%% the first element, and \var{size} is the number of elements in the
-%% array.
-%%
-%% Once registered, each of your variables (or array element) has the
-%% following properties: if it points to a heap-allocated block, this
-%% block (and its contents) will not be reclaimed; moreover, if this
-%% block is relocated by the garbage collector, the variable is updated
-%% to point to the new location for the block.
-%%
-%% Each of the "Begin_roots" macros open a C block that must be closed
-%% with a matching "End_roots" at the same nesting level. The block must
-%% be exited normally (i.e. not with "return" or "goto"). However, the
-%% roots are automatically un-registered if an OCaml exception is raised,
-%% so you can exit the block with "failwith", "invalid_argument", or one
-%% of the "raise" functions.
-%%
-%% {\bf Note:} The "Begin_roots" macros use a local variable and a
-%% structure tag named "caml__roots_block". Do not use this identifier
-%% in your programs.
-
-\begin{gcrule} Direct assignment to a field of a block, as in
-\begin{alltt}
- Field(\var{v}, \var{n}) = \var{w};
-\end{alltt}
-is safe only if \var{v} is a block newly allocated by "caml_alloc_small";
-that is, if no allocation took place between the
-allocation of \var{v} and the assignment to the field. In all other cases,
-never assign directly. If the block has just been allocated by "caml_alloc_shr",
-use "caml_initialize" to assign a value to a field for the first time:
-\begin{alltt}
- caml_initialize(&Field(\var{v}, \var{n}), \var{w});
-\end{alltt}
-Otherwise, you are updating a field that previously contained a
-well-formed value; then, call the "caml_modify" function:
-\begin{alltt}
- caml_modify(&Field(\var{v}, \var{n}), \var{w});
-\end{alltt}
-\end{gcrule}
-
-To illustrate the rules above, here is a C function that builds and
-returns a list containing the two integers given as parameters.
-First, we write it using the simplified allocation functions:
-\begin{verbatim}
-value alloc_list_int(int i1, int i2)
-{
- CAMLparam0 ();
- CAMLlocal2 (result, r);
-
- r = caml_alloc(2, 0); /* Allocate a cons cell */
- Store_field(r, 0, Val_int(i2)); /* car = the integer i2 */
- Store_field(r, 1, Val_int(0)); /* cdr = the empty list [] */
- result = caml_alloc(2, 0); /* Allocate the other cons cell */
- Store_field(result, 0, Val_int(i1)); /* car = the integer i1 */
- Store_field(result, 1, r); /* cdr = the first cons cell */
- CAMLreturn (result);
-}
-\end{verbatim}
-Here, the registering of "result" is not strictly needed, because no
-allocation takes place after it gets its value, but it's easier and
-safer to simply register all the local variables that have type "value".
-
-Here is the same function written using the low-level allocation
-functions. We notice that the cons cells are small blocks and can be
-allocated with "caml_alloc_small", and filled by direct assignments on
-their fields.
-\begin{verbatim}
-value alloc_list_int(int i1, int i2)
-{
- CAMLparam0 ();
- CAMLlocal2 (result, r);
-
- r = caml_alloc_small(2, 0); /* Allocate a cons cell */
- Field(r, 0) = Val_int(i2); /* car = the integer i2 */
- Field(r, 1) = Val_int(0); /* cdr = the empty list [] */
- result = caml_alloc_small(2, 0); /* Allocate the other cons cell */
- Field(result, 0) = Val_int(i1); /* car = the integer i1 */
- Field(result, 1) = r; /* cdr = the first cons cell */
- CAMLreturn (result);
-}
-\end{verbatim}
-In the two examples above, the list is built bottom-up. Here is an
-alternate way, that proceeds top-down. It is less efficient, but
-illustrates the use of "caml_modify".
-\begin{verbatim}
-value alloc_list_int(int i1, int i2)
-{
- CAMLparam0 ();
- CAMLlocal2 (tail, r);
-
- r = caml_alloc_small(2, 0); /* Allocate a cons cell */
- Field(r, 0) = Val_int(i1); /* car = the integer i1 */
- Field(r, 1) = Val_int(0); /* A dummy value
- tail = caml_alloc_small(2, 0); /* Allocate the other cons cell */
- Field(tail, 0) = Val_int(i2); /* car = the integer i2 */
- Field(tail, 1) = Val_int(0); /* cdr = the empty list [] */
- caml_modify(&Field(r, 1), tail); /* cdr of the result = tail */
- CAMLreturn (r);
-}
-\end{verbatim}
-It would be incorrect to perform
-"Field(r, 1) = tail" directly, because the allocation of "tail"
-has taken place since "r" was allocated.
-
-
-\subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions}
-
-Since 4.10, allocation functions are guaranteed not to call any OCaml
-callbacks from C, including finalisers and signal handlers, and delay
-their execution instead.
-
-The function \verb"caml_process_pending_actions" from
-"<caml/signals.h>" executes any pending signal handlers and
-finalisers, Memprof callbacks, and requested minor and major garbage
-collections. In particular, it can raise asynchronous exceptions. It
-is recommended to call it regularly at safe points inside long-running
-non-blocking C code.
-
-The variant \verb"caml_process_pending_actions_exn" is provided, that
-returns the exception instead of raising it directly into OCaml code.
-Its result must be tested using {\tt Is_exception_result}, and
-followed by {\tt Extract_exception} if appropriate. It is typically
-used for clean up before re-raising:
-
-\begin{verbatim}
- CAMLlocal1(exn);
- ...
- exn = caml_process_pending_actions_exn();
- if(Is_exception_result(exn)) {
- exn = Extract_exception(exn);
- ...cleanup...
- caml_raise(exn);
- }
-\end{verbatim}
-
-Correct use of exceptional return, in particular in the presence of
-garbage collection, is further detailed in Section~\ref{ss:c-callbacks}.
-
-\section{s:c-intf-example}{A complete example}
-
-This section outlines how the functions from the Unix "curses" library
-can be made available to OCaml programs. First of all, here is
-the interface "curses.ml" that declares the "curses" primitives and
-data types:
-\begin{verbatim}
-(* File curses.ml -- declaration of primitives and data types *)
-type window (* The type "window" remains abstract *)
-external initscr: unit -> window = "caml_curses_initscr"
-external endwin: unit -> unit = "caml_curses_endwin"
-external refresh: unit -> unit = "caml_curses_refresh"
-external wrefresh : window -> unit = "caml_curses_wrefresh"
-external newwin: int -> int -> int -> int -> window = "caml_curses_newwin"
-external addch: char -> unit = "caml_curses_addch"
-external mvwaddch: window -> int -> int -> char -> unit = "caml_curses_mvwaddch"
-external addstr: string -> unit = "caml_curses_addstr"
-external mvwaddstr: window -> int -> int -> string -> unit
- = "caml_curses_mvwaddstr"
-(* lots more omitted *)
-\end{verbatim}
-To compile this interface:
-\begin{verbatim}
- ocamlc -c curses.ml
-\end{verbatim}
-
-To implement these functions, we just have to provide the stub code;
-the core functions are already implemented in the "curses" library.
-The stub code file, "curses_stubs.c", looks like this:
-\begin{verbatim}
-/* File curses_stubs.c -- stub code for curses */
-#include <curses.h>
-#define CAML_NAME_SPACE
-#include <caml/mlvalues.h>
-#include <caml/memory.h>
-#include <caml/alloc.h>
-#include <caml/custom.h>
-
-/* Encapsulation of opaque window handles (of type WINDOW *)
- as OCaml custom blocks. */
-
-static struct custom_operations curses_window_ops = {
- "fr.inria.caml.curses_windows",
- custom_finalize_default,
- custom_compare_default,
- custom_hash_default,
- custom_serialize_default,
- custom_deserialize_default,
- custom_compare_ext_default,
- custom_fixed_length_default
-};
-
-/* Accessing the WINDOW * part of an OCaml custom block */
-#define Window_val(v) (*((WINDOW **) Data_custom_val(v)))
-
-/* Allocating an OCaml custom block to hold the given WINDOW * */
-static value alloc_window(WINDOW * w)
-{
- value v = caml_alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
- Window_val(v) = w;
- return v;
-}
-
-CAMLprim value caml_curses_initscr(value unit)
-{
- CAMLparam1 (unit);
- CAMLreturn (alloc_window(initscr()));
-}
-
-CAMLprim value caml_curses_endwin(value unit)
-{
- CAMLparam1 (unit);
- endwin();
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_refresh(value unit)
-{
- CAMLparam1 (unit);
- refresh();
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_wrefresh(value win)
-{
- CAMLparam1 (win);
- wrefresh(Window_val(win));
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
-{
- CAMLparam4 (nlines, ncols, x0, y0);
- CAMLreturn (alloc_window(newwin(Int_val(nlines), Int_val(ncols),
- Int_val(x0), Int_val(y0))));
-}
-
-CAMLprim value caml_curses_addch(value c)
-{
- CAMLparam1 (c);
- addch(Int_val(c)); /* Characters are encoded like integers */
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_mvwaddch(value win, value x, value y, value c)
-{
- CAMLparam4 (win, x, y, c);
- mvwaddch(Window_val(win), Int_val(x), Int_val(y), Int_val(c));
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_addstr(value s)
-{
- CAMLparam1 (s);
- addstr(String_val(s));
- CAMLreturn (Val_unit);
-}
-
-CAMLprim value caml_curses_mvwaddstr(value win, value x, value y, value s)
-{
- CAMLparam4 (win, x, y, s);
- mvwaddstr(Window_val(win), Int_val(x), Int_val(y), String_val(s));
- CAMLreturn (Val_unit);
-}
-
-/* This goes on for pages. */
-\end{verbatim}
-
-The file "curses_stubs.c" can be compiled with:
-\begin{verbatim}
- cc -c -I`ocamlc -where` curses_stubs.c
-\end{verbatim}
-or, even simpler,
-\begin{verbatim}
- ocamlc -c curses_stubs.c
-\end{verbatim}
-(When passed a ".c" file, the "ocamlc" command simply calls the C
-compiler on that file, with the right "-I" option.)
-
-Now, here is a sample OCaml program "prog.ml" that uses the "curses"
-module:
-\begin{verbatim}
-(* File prog.ml -- main program using curses *)
-open Curses;;
-let main_window = initscr () in
-let small_window = newwin 10 5 20 10 in
- mvwaddstr main_window 10 2 "Hello";
- mvwaddstr small_window 4 3 "world";
- refresh();
- Unix.sleep 5;
- endwin()
-\end{verbatim}
-To compile and link this program, run:
-\begin{verbatim}
- ocamlc -custom -o prog unix.cma curses.cmo prog.ml curses_stubs.o -cclib -lcurses
-\end{verbatim}
-(On some machines, you may need to put
-"-cclib -lcurses -cclib -ltermcap" or "-cclib -ltermcap"
-instead of "-cclib -lcurses".)
-
-%% Note by Damien: when I launch the program, it only displays "Hello"
-%% and not "world". Why?
-
-\section{s:c-callback}{Advanced topic: callbacks from C to OCaml}
-
-So far, we have described how to call C functions from OCaml. In this
-section, we show how C functions can call OCaml functions, either as
-callbacks (OCaml calls C which calls OCaml), or with the main program
-written in C.
-
-\subsection{ss:c-callbacks}{Applying OCaml closures from C}
-
-C functions can apply OCaml function values (closures) to OCaml values.
-The following functions are provided to perform the applications:
-\begin{itemize}
-\item "caml_callback("\var{f, a}")" applies the functional value \var{f} to
-the value \var{a} and returns the value returned by~\var{f}.
-\item "caml_callback2("\var{f, a, b}")" applies the functional value \var{f}
-(which is assumed to be a curried OCaml function with two arguments) to
-\var{a} and \var{b}.
-\item "caml_callback3("\var{f, a, b, c}")" applies the functional value \var{f}
-(a curried OCaml function with three arguments) to \var{a}, \var{b} and \var{c}.
-\item "caml_callbackN("\var{f, n, args}")" applies the functional value \var{f}
-to the \var{n} arguments contained in the array of values \var{args}.
-\end{itemize}
-If the function \var{f} does not return, but raises an exception that
-escapes the scope of the application, then this exception is
-propagated to the next enclosing OCaml code, skipping over the C
-code. That is, if an OCaml function \var{f} calls a C function \var{g} that
-calls back an OCaml function \var{h} that raises a stray exception, then the
-execution of \var{g} is interrupted and the exception is propagated back
-into \var{f}.
-
-If the C code wishes to catch exceptions escaping the OCaml function,
-it can use the functions "caml_callback_exn", "caml_callback2_exn",
-"caml_callback3_exn", "caml_callbackN_exn". These functions take the same
-arguments as their non-"_exn" counterparts, but catch escaping
-exceptions and return them to the C code. The return value \var{v} of the
-"caml_callback*_exn" functions must be tested with the macro
-"Is_exception_result("\var{v}")". If the macro returns ``false'', no
-exception occurred, and \var{v} is the value returned by the OCaml
-function. If "Is_exception_result("\var{v}")" returns ``true'',
-an exception escaped, and its value (the exception descriptor) can be
-recovered using "Extract_exception("\var{v}")".
-
-\paragraph{Warning:} If the OCaml function returned with an exception,
-"Extract_exception" should be applied to the exception result prior
-to calling a function that may trigger garbage collection.
-Otherwise, if \var{v} is reachable during garbage collection, the runtime
-can crash since \var{v} does not contain a valid value.
-
-Example:
-\begin{verbatim}
- CAMLprim value call_caml_f_ex(value closure, value arg)
- {
- CAMLparam2(closure, arg);
- CAMLlocal2(res, tmp);
- res = caml_callback_exn(closure, arg);
- if(Is_exception_result(res)) {
- res = Extract_exception(res);
- tmp = caml_alloc(3, 0); /* Safe to allocate: res contains valid value. */
- ...
- }
- CAMLreturn (res);
- }
-\end{verbatim}
-
-\subsection{ss:c-closures}{Obtaining or registering OCaml closures for use in C functions}
-
-There are two ways to obtain OCaml function values (closures) to
-be passed to the "callback" functions described above. One way is to
-pass the OCaml function as an argument to a primitive function. For
-example, if the OCaml code contains the declaration
-\begin{verbatim}
- external apply : ('a -> 'b) -> 'a -> 'b = "caml_apply"
-\end{verbatim}
-the corresponding C stub can be written as follows:
-\begin{verbatim}
- CAMLprim value caml_apply(value vf, value vx)
- {
- CAMLparam2(vf, vx);
- CAMLlocal1(vy);
- vy = caml_callback(vf, vx);
- CAMLreturn(vy);
- }
-\end{verbatim}
-
-Another possibility is to use the registration mechanism provided by
-OCaml. This registration mechanism enables OCaml code to register
-OCaml functions under some global name, and C code to retrieve the
-corresponding closure by this global name.
-
-On the OCaml side, registration is performed by evaluating
-"Callback.register" \var{n} \var{v}. Here, \var{n} is the global name
-(an arbitrary string) and \var{v} the OCaml value. For instance:
-\begin{verbatim}
- let f x = print_string "f is applied to "; print_int x; print_newline()
- let _ = Callback.register "test function" f
-\end{verbatim}
-
-On the C side, a pointer to the value registered under name \var{n} is
-obtained by calling "caml_named_value("\var{n}")". The returned
-pointer must then be dereferenced to recover the actual OCaml value.
-If no value is registered under the name \var{n}, the null pointer is
-returned. For example, here is a C wrapper that calls the OCaml function "f"
-above:
-\begin{verbatim}
- void call_caml_f(int arg)
- {
- caml_callback(*caml_named_value("test function"), Val_int(arg));
- }
-\end{verbatim}
-
-The pointer returned by "caml_named_value" is constant and can safely
-be cached in a C variable to avoid repeated name lookups. The value
-pointed to cannot be changed from C. However, it might change during
-garbage collection, so must always be recomputed at the point of
-use. Here is a more efficient variant of "call_caml_f" above that
-calls "caml_named_value" only once:
-\begin{verbatim}
- void call_caml_f(int arg)
- {
- static const value * closure_f = NULL;
- if (closure_f == NULL) {
- /* First time around, look up by name */
- closure_f = caml_named_value("test function");
- }
- caml_callback(*closure_f, Val_int(arg));
- }
-\end{verbatim}
-
-\subsection{ss:c-register-exn}{Registering OCaml exceptions for use in C functions}
-
-The registration mechanism described above can also be used to
-communicate exception identifiers from OCaml to C. The OCaml code
-registers the exception by evaluating
-"Callback.register_exception" \var{n} \var{exn}, where \var{n} is an
-arbitrary name and \var{exn} is an exception value of the
-exception to register. For example:
-\begin{verbatim}
- exception Error of string
- let _ = Callback.register_exception "test exception" (Error "any string")
-\end{verbatim}
-The C code can then recover the exception identifier using
-"caml_named_value" and pass it as first argument to the functions
-"raise_constant", "raise_with_arg", and "raise_with_string" (described
-in section~\ref{ss:c-exceptions}) to actually raise the exception. For
-example, here is a C function that raises the "Error" exception with
-the given argument:
-\begin{verbatim}
- void raise_error(char * msg)
- {
- caml_raise_with_string(*caml_named_value("test exception"), msg);
- }
-\end{verbatim}
-
-\subsection{ss:main-c}{Main program in C}
-
-In normal operation, a mixed OCaml/C program starts by executing the
-OCaml initialization code, which then may proceed to call C
-functions. We say that the main program is the OCaml code. In some
-applications, it is desirable that the C code plays the role of the
-main program, calling OCaml functions when needed. This can be achieved as
-follows:
-\begin{itemize}
-\item The C part of the program must provide a "main" function,
-which will override the default "main" function provided by the OCaml
-runtime system. Execution will start in the user-defined "main" function
-just like for a regular C program.
-
-\item At some point, the C code must call "caml_main(argv)" to
-initialize the OCaml code. The "argv" argument is a C array of strings
-(type "char **"), terminated with a "NULL" pointer,
-which represents the command-line arguments, as
-passed as second argument to "main". The OCaml array "Sys.argv" will
-be initialized from this parameter. For the bytecode compiler,
-"argv[0]" and "argv[1]" are also consulted to find the file containing
-the bytecode.
-
-\item The call to "caml_main" initializes the OCaml runtime system,
-loads the bytecode (in the case of the bytecode compiler), and
-executes the initialization code of the OCaml program. Typically, this
-initialization code registers callback functions using "Callback.register".
-Once the OCaml initialization code is complete, control returns to the
-C code that called "caml_main".
-
-\item The C code can then invoke OCaml functions using the callback
-mechanism (see section~\ref{ss:c-callbacks}).
-\end{itemize}
-
-\subsection{ss:c-embedded-code}{Embedding the OCaml code in the C code}
-
-The bytecode compiler in custom runtime mode ("ocamlc -custom")
-normally appends the bytecode to the executable file containing the
-custom runtime. This has two consequences. First, the final linking
-step must be performed by "ocamlc". Second, the OCaml runtime library
-must be able to find the name of the executable file from the
-command-line arguments. When using "caml_main(argv)" as in
-section~\ref{ss:main-c}, this means that "argv[0]" or "argv[1]" must
-contain the executable file name.
-
-An alternative is to embed the bytecode in the C code. The
-"-output-obj" option to "ocamlc" is provided for this purpose. It
-causes the "ocamlc" compiler to output a C object file (".o" file,
-".obj" under Windows) containing the bytecode for the OCaml part of the
-program, as well as a "caml_startup" function. The C object file
-produced by "ocamlc -output-obj" can then be linked with C code using
-the standard C compiler, or stored in a C library.
-
-The "caml_startup" function must be called from the main C program in
-order to initialize the OCaml runtime and execute the OCaml
-initialization code. Just like "caml_main", it takes one "argv"
-parameter containing the command-line parameters. Unlike "caml_main",
-this "argv" parameter is used only to initialize "Sys.argv", but not
-for finding the name of the executable file.
-
-The "caml_startup" function calls the uncaught exception handler (or
-enters the debugger, if running under ocamldebug) if an exception escapes
-from a top-level module initialiser. Such exceptions may be caught in the
-C code by instead using the "caml_startup_exn" function and testing the result
-using {\tt Is_exception_result} (followed by {\tt Extract_exception} if
-appropriate).
-
-The "-output-obj" option can also be used to obtain the C source file.
-More interestingly, the same option can also produce directly a shared
-library (".so" file, ".dll" under Windows) that contains the OCaml
-code, the OCaml runtime system and any other static C code given to
-"ocamlc" (".o", ".a", respectively, ".obj", ".lib"). This use of
-"-output-obj" is very similar to a normal linking step, but instead of
-producing a main program that automatically runs the OCaml code, it
-produces a shared library that can run the OCaml code on demand. The
-three possible behaviors of "-output-obj" are selected according
-to the extension of the resulting file (given with "-o").
-
-The native-code compiler "ocamlopt" also supports the "-output-obj"
-option, causing it to output a C object file or a shared library
-containing the native code for all OCaml modules on the command-line,
-as well as the OCaml startup code. Initialization is performed by
-calling "caml_startup" (or "caml_startup_exn") as in the case of the
-bytecode compiler.
-
-For the final linking phase, in addition to the object file produced
-by "-output-obj", you will have to provide the OCaml runtime
-library ("libcamlrun.a" for bytecode, "libasmrun.a" for native-code),
-as well as all C libraries that are required by the OCaml libraries
-used. For instance, assume the OCaml part of your program uses the
-Unix library. With "ocamlc", you should do:
-\begin{alltt}
- ocamlc -output-obj -o camlcode.o unix.cma {\it{other}} .cmo {\it{and}} .cma {\it{files}}
- cc -o myprog {\it{C objects and libraries}} \char92
- camlcode.o -L`ocamlc -where` -lunix -lcamlrun
-\end{alltt}
-With "ocamlopt", you should do:
-\begin{alltt}
- ocamlopt -output-obj -o camlcode.o unix.cmxa {\it{other}} .cmx {\it{and}} .cmxa {\it{files}}
- cc -o myprog {\it{C objects and libraries}} \char92
- camlcode.o -L`ocamlc -where` -lunix -lasmrun
-\end{alltt}
-
-% -- This seems completely wrong -- Damien
-% The shared libraries produced by "ocamlc -output-obj" or by "ocamlopt
-% -output-obj" already contains the OCaml runtime library as
-% well as all the needed C libraries.
-
-\paragraph{Warning:} On some ports, special options are required on the final
-linking phase that links together the object file produced by the
-"-output-obj" option and the remainder of the program. Those options
-are shown in the configuration file "Makefile.config" generated during
-compilation of OCaml, as the variable "OC_LDFLAGS".
-\begin{itemize}
-\item Windows with the MSVC compiler: the object file produced by
-OCaml have been compiled with the "/MD" flag, and therefore
-all other object files linked with it should also be compiled with
-"/MD".
-\item other systems: you may have to add one or more of "-lcurses",
-"-lm", "-ldl", depending on your OS and C compiler.
-\end{itemize}
-
-\paragraph{Stack backtraces.} When OCaml bytecode produced by
-"ocamlc -g" is embedded in a C program, no debugging information is
-included, and therefore it is impossible to print stack backtraces on
-uncaught exceptions. This is not the case when native code produced
-by "ocamlopt -g" is embedded in a C program: stack backtrace
-information is available, but the backtrace mechanism needs to be
-turned on programmatically. This can be achieved from the OCaml side
-by calling "Printexc.record_backtrace true" in the initialization of
-one of the OCaml modules. This can also be achieved from the C side
-by calling "caml_record_backtrace(Val_int(1));" in the OCaml-C glue code.
-
-\paragraph{Unloading the runtime.}
-
-In case the shared library produced with "-output-obj" is to be loaded and
-unloaded repeatedly by a single process, care must be taken to unload the
-OCaml runtime explicitly, in order to avoid various system resource leaks.
-
-Since 4.05, "caml_shutdown" function can be used to shut the runtime down
-gracefully, which equals the following:
-\begin{itemize}
-\item Running the functions that were registered with "Stdlib.at_exit".
-\item Triggering finalization of allocated custom blocks (see
-section~\ref{s:c-custom}). For example, "Stdlib.in_channel" and
-"Stdlib.out_channel" are represented by custom blocks that enclose file
-descriptors, which are to be released.
-\item Unloading the dependent shared libraries that were loaded by the runtime,
-including "dynlink" plugins.
-\item Freeing the memory blocks that were allocated by the runtime with
-"malloc". Inside C primitives, it is advised to use "caml_stat_*" functions
-from "memory.h" for managing static (that is, non-moving) blocks of heap
-memory, as all the blocks allocated with these functions are automatically
-freed by "caml_shutdown". For ensuring compatibility with legacy C stubs that
-have used "caml_stat_*" incorrectly, this behaviour is only enabled if the
-runtime is started with a specialized "caml_startup_pooled" function.
-\end{itemize}
-
-As a shared library may have several clients simultaneously, it is made for
-convenience that "caml_startup" (and "caml_startup_pooled") may be called
-multiple times, given that each such call is paired with a corresponding call
-to "caml_shutdown" (in a nested fashion). The runtime will be unloaded once
-there are no outstanding calls to "caml_startup".
-
-Once a runtime is unloaded, it cannot be started up again without reloading the
-shared library and reinitializing its static data. Therefore, at the moment, the
-facility is only useful for building reloadable shared libraries.
-
-
-\section{s:c-advexample}{Advanced example with callbacks}
-
-This section illustrates the callback facilities described in
-section~\ref{s:c-callback}. We are going to package some OCaml functions
-in such a way that they can be linked with C code and called from C
-just like any C functions. The OCaml functions are defined in the
-following "mod.ml" OCaml source:
-
-\begin{verbatim}
-(* File mod.ml -- some "useful" OCaml functions *)
-
-let rec fib n = if n < 2 then 1 else fib(n-1) + fib(n-2)
-
-let format_result n = Printf.sprintf "Result is: %d\n" n
-
-(* Export those two functions to C *)
-
-let _ = Callback.register "fib" fib
-let _ = Callback.register "format_result" format_result
-\end{verbatim}
-
-Here is the C stub code for calling these functions from C:
-
-\begin{verbatim}
-/* File modwrap.c -- wrappers around the OCaml functions */
-
-#include <stdio.h>
-#include <string.h>
-#include <caml/mlvalues.h>
-#include <caml/callback.h>
-
-int fib(int n)
-{
- static const value * fib_closure = NULL;
- if (fib_closure == NULL) fib_closure = caml_named_value("fib");
- return Int_val(caml_callback(*fib_closure, Val_int(n)));
-}
-
-char * format_result(int n)
-{
- static const value * format_result_closure = NULL;
- if (format_result_closure == NULL)
- format_result_closure = caml_named_value("format_result");
- return strdup(String_val(caml_callback(*format_result_closure, Val_int(n))));
- /* We copy the C string returned by String_val to the C heap
- so that it remains valid after garbage collection. */
-}
-\end{verbatim}
-
-We now compile the OCaml code to a C object file and put it in a C
-library along with the stub code in "modwrap.c" and the OCaml runtime system:
-\begin{verbatim}
- ocamlc -custom -output-obj -o modcaml.o mod.ml
- ocamlc -c modwrap.c
- cp `ocamlc -where`/libcamlrun.a mod.a && chmod +w mod.a
- ar r mod.a modcaml.o modwrap.o
-\end{verbatim}
-(One can also use "ocamlopt -output-obj" instead of "ocamlc -custom
--output-obj". In this case, replace "libcamlrun.a" (the bytecode
-runtime library) by "libasmrun.a" (the native-code runtime library).)
-
-Now, we can use the two functions "fib" and "format_result" in any C
-program, just like regular C functions. Just remember to call
-"caml_startup" (or "caml_startup_exn") once before.
-
-\begin{verbatim}
-/* File main.c -- a sample client for the OCaml functions */
-
-#include <stdio.h>
-#include <caml/callback.h>
-
-extern int fib(int n);
-extern char * format_result(int n);
-
-int main(int argc, char ** argv)
-{
- int result;
-
- /* Initialize OCaml code */
- caml_startup(argv);
- /* Do some computation */
- result = fib(10);
- printf("fib(10) = %s\n", format_result(result));
- return 0;
-}
-\end{verbatim}
-
-To build the whole program, just invoke the C compiler as follows:
-\begin{verbatim}
- cc -o prog -I `ocamlc -where` main.c mod.a -lcurses
-\end{verbatim}
-(On some machines, you may need to put "-ltermcap" or
-"-lcurses -ltermcap" instead of "-lcurses".)
-
-\section{s:c-custom}{Advanced topic: custom blocks}
-
-Blocks with tag "Custom_tag" contain both arbitrary user data and a
-pointer to a C struct, with type "struct custom_operations", that
-associates user-provided finalization, comparison, hashing,
-serialization and deserialization functions to this block.
-
-\subsection{ss:c-custom-ops}{The "struct custom_operations"}
-
-The "struct custom_operations" is defined in "<caml/custom.h>" and
-contains the following fields:
-\begin{itemize}
-\item "char *identifier" \\
-A zero-terminated character string serving as an identifier for
-serialization and deserialization operations.
-
-\item "void (*finalize)(value v)" \\
-The "finalize" field contains a pointer to a C function that is called
-when the block becomes unreachable and is about to be reclaimed.
-The block is passed as first argument to the function.
-The "finalize" field can also be "custom_finalize_default" to indicate that no
-finalization function is associated with the block.
-
-\item "int (*compare)(value v1, value v2)" \\
-The "compare" field contains a pointer to a C function that is
-called whenever two custom blocks are compared using OCaml's generic
-comparison operators ("=", "<>", "<=", ">=", "<", ">" and
-"compare"). The C function should return 0 if the data contained in
-the two blocks are structurally equal, a negative integer if the data
-from the first block is less than the data from the second block, and
-a positive integer if the data from the first block is greater than
-the data from the second block.
-
-The "compare" field can be set to "custom_compare_default"; this
-default comparison function simply raises "Failure".
-
-\item "int (*compare_ext)(value v1, value v2)" \\
-(Since 3.12.1)
-The "compare_ext" field contains a pointer to a C function that is
-called whenever one custom block and one unboxed integer are compared using OCaml's generic
-comparison operators ("=", "<>", "<=", ">=", "<", ">" and
-"compare"). As in the case of the "compare" field, the C function
-should return 0 if the two arguments are structurally equal, a
-negative integer if the first argument compares less than the second
-argument, and a positive integer if the first argument compares
-greater than the second argument.
-
-The "compare_ext" field can be set to "custom_compare_ext_default"; this
-default comparison function simply raises "Failure".
-
-\item "intnat (*hash)(value v)" \\
-The "hash" field contains a pointer to a C function that is called
-whenever OCaml's generic hash operator (see module \stdmoduleref{Hashtbl}) is
-applied to a custom block. The C function can return an arbitrary
-integer representing the hash value of the data contained in the
-given custom block. The hash value must be compatible with the
-"compare" function, in the sense that two structurally equal data
-(that is, two custom blocks for which "compare" returns 0) must have
-the same hash value.
-
-The "hash" field can be set to "custom_hash_default", in which case
-the custom block is ignored during hash computation.
-
-\item "void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64)" \\
-The "serialize" field contains a pointer to a C function that is
-called whenever the custom block needs to be serialized (marshaled)
-using the OCaml functions "output_value" or "Marshal.to_...".
-For a custom block, those functions first write the identifier of the
-block (as given by the "identifier" field) to the output stream,
-then call the user-provided "serialize" function. That function is
-responsible for writing the data contained in the custom block, using
-the "serialize_..." functions defined in "<caml/intext.h>" and listed
-below. The user-provided "serialize" function must then store in its
-"bsize_32" and "bsize_64" parameters the sizes in bytes of the data
-part of the custom block on a 32-bit architecture and on a 64-bit
-architecture, respectively.
-
-The "serialize" field can be set to "custom_serialize_default",
-in which case the "Failure" exception is raised when attempting to
-serialize the custom block.
-
-\item "uintnat (*deserialize)(void * dst)" \\
-The "deserialize" field contains a pointer to a C function that is
-called whenever a custom block with identifier "identifier" needs to
-be deserialized (un-marshaled) using the OCaml functions "input_value"
-or "Marshal.from_...". This user-provided function is responsible for
-reading back the data written by the "serialize" operation, using the
-"deserialize_..." functions defined in "<caml/intext.h>" and listed
-below. It must then rebuild the data part of the custom block
-and store it at the pointer given as the "dst" argument. Finally, it
-returns the size in bytes of the data part of the custom block.
-This size must be identical to the "wsize_32" result of
-the "serialize" operation if the architecture is 32 bits, or
-"wsize_64" if the architecture is 64 bits.
-
-The "deserialize" field can be set to "custom_deserialize_default"
-to indicate that deserialization is not supported. In this case,
-do not register the "struct custom_operations" with the deserializer
-using "register_custom_operations" (see below).
-
-\item "const struct custom_fixed_length* fixed_length" \\
-(Since 4.08.0)
-Normally, space in the serialized output is reserved to write the
-"bsize_32" and "bsize_64" fields returned by "serialize". However, for
-very short custom blocks, this space can be larger than the data
-itself! As a space optimisation, if "serialize" always returns the
-same values for "bsize_32" and "bsize_64", then these values may be
-specified in the "fixed_length" structure, and do not consume space in
-the serialized output.
-\end{itemize}
-
-Note: the "finalize", "compare", "hash", "serialize" and "deserialize"
-functions attached to custom block descriptors must never trigger a
-garbage collection. Within these functions, do not call any of the
-OCaml allocation functions, and do not perform a callback into OCaml
-code. Do not use "CAMLparam" to register the parameters to these
-functions, and do not use "CAMLreturn" to return the result.
-
-\subsection{ss:c-custom-alloc}{Allocating custom blocks}
-
-Custom blocks must be allocated via "caml_alloc_custom" or
-"caml_alloc_custom_mem":
-\begin{center}
-"caml_alloc_custom("\var{ops}", "\var{size}", "\var{used}", "\var{max}")"
-\end{center}
-returns a fresh custom block, with room for \var{size} bytes of user
-data, and whose associated operations are given by \var{ops} (a
-pointer to a "struct custom_operations", usually statically allocated
-as a C global variable).
-
-The two parameters \var{used} and \var{max} are used to control the
-speed of garbage collection when the finalized object contains
-pointers to out-of-heap resources. Generally speaking, the
-OCaml incremental major collector adjusts its speed relative to the
-allocation rate of the program. The faster the program allocates, the
-harder the GC works in order to reclaim quickly unreachable blocks
-and avoid having large amount of ``floating garbage'' (unreferenced
-objects that the GC has not yet collected).
-
-Normally, the allocation rate is measured by counting the in-heap size
-of allocated blocks. However, it often happens that finalized
-objects contain pointers to out-of-heap memory blocks and other resources
-(such as file descriptors, X Windows bitmaps, etc.). For those
-blocks, the in-heap size of blocks is not a good measure of the
-quantity of resources allocated by the program.
-
-The two arguments \var{used} and \var{max} give the GC an idea of how
-much out-of-heap resources are consumed by the finalized block
-being allocated: you give the amount of resources allocated to this
-object as parameter \var{used}, and the maximum amount that you want
-to see in floating garbage as parameter \var{max}. The units are
-arbitrary: the GC cares only about the ratio $\var{used} / \var{max}$.
-
-For instance, if you are allocating a finalized block holding an X
-Windows bitmap of \var{w} by \var{h} pixels, and you'd rather not
-have more than 1 mega-pixels of unreclaimed bitmaps, specify
-$\var{used} = \var{w} * \var{h}$ and $\var{max} = 1000000$.
-
-Another way to describe the effect of the \var{used} and \var{max}
-parameters is in terms of full GC cycles. If you allocate many custom
-blocks with $\var{used} / \var{max} = 1 / \var{N}$, the GC will then do one
-full cycle (examining every object in the heap and calling
-finalization functions on those that are unreachable) every \var{N}
-allocations. For instance, if $\var{used} = 1$ and $\var{max} = 1000$,
-the GC will do one full cycle at least every 1000 allocations of
-custom blocks.
-
-If your finalized blocks contain no pointers to out-of-heap resources,
-or if the previous discussion made little sense to you, just take
-$\var{used} = 0$ and $\var{max} = 1$. But if you later find that the
-finalization functions are not called ``often enough'', consider
-increasing the $\var{used} / \var{max}$ ratio.
-
-\begin{center}
-"caml_alloc_custom_mem("\var{ops}", "\var{size}", "\var{used}")"
-\end{center}
-Use this function when your custom block holds only out-of-heap memory
-(memory allocated with "malloc" or "caml_stat_alloc") and no other
-resources. "used" should be the number of bytes of out-of-heap
-memory that are held by your custom block. This function works like
-"caml_alloc_custom" except that the "max" parameter is under the
-control of the user (via the "custom_major_ratio",
-"custom_minor_ratio", and "custom_minor_max_size" parameters) and
-proportional to the heap sizes.
-
-\subsection{ss:c-custom-access}{Accessing custom blocks}
-
-The data part of a custom block \var{v} can be
-accessed via the pointer "Data_custom_val("\var{v}")". This pointer
-has type "void *" and should be cast to the actual type of the data
-stored in the custom block.
-
-The contents of custom blocks are not scanned by the garbage
-collector, and must therefore not contain any pointer inside the OCaml
-heap. In other terms, never store an OCaml "value" in a custom block,
-and do not use "Field", "Store_field" nor "caml_modify" to access the data
-part of a custom block. Conversely, any C data structure (not
-containing heap pointers) can be stored in a custom block.
-
-\subsection{ss:c-custom-serialization}{Writing custom serialization and deserialization functions}
-
-The following functions, defined in "<caml/intext.h>", are provided to
-write and read back the contents of custom blocks in a portable way.
-Those functions handle endianness conversions when e.g. data is
-written on a little-endian machine and read back on a big-endian machine.
-
-\begin{tableau}{|l|p{10cm}|}{Function}{Action}
-\entree{"caml_serialize_int_1"}{Write a 1-byte integer}
-\entree{"caml_serialize_int_2"}{Write a 2-byte integer}
-\entree{"caml_serialize_int_4"}{Write a 4-byte integer}
-\entree{"caml_serialize_int_8"}{Write a 8-byte integer}
-\entree{"caml_serialize_float_4"}{Write a 4-byte float}
-\entree{"caml_serialize_float_8"}{Write a 8-byte float}
-\entree{"caml_serialize_block_1"}{Write an array of 1-byte quantities}
-\entree{"caml_serialize_block_2"}{Write an array of 2-byte quantities}
-\entree{"caml_serialize_block_4"}{Write an array of 4-byte quantities}
-\entree{"caml_serialize_block_8"}{Write an array of 8-byte quantities}
-\entree{"caml_deserialize_uint_1"}{Read an unsigned 1-byte integer}
-\entree{"caml_deserialize_sint_1"}{Read a signed 1-byte integer}
-\entree{"caml_deserialize_uint_2"}{Read an unsigned 2-byte integer}
-\entree{"caml_deserialize_sint_2"}{Read a signed 2-byte integer}
-\entree{"caml_deserialize_uint_4"}{Read an unsigned 4-byte integer}
-\entree{"caml_deserialize_sint_4"}{Read a signed 4-byte integer}
-\entree{"caml_deserialize_uint_8"}{Read an unsigned 8-byte integer}
-\entree{"caml_deserialize_sint_8"}{Read a signed 8-byte integer}
-\entree{"caml_deserialize_float_4"}{Read a 4-byte float}
-\entree{"caml_deserialize_float_8"}{Read an 8-byte float}
-\entree{"caml_deserialize_block_1"}{Read an array of 1-byte quantities}
-\entree{"caml_deserialize_block_2"}{Read an array of 2-byte quantities}
-\entree{"caml_deserialize_block_4"}{Read an array of 4-byte quantities}
-\entree{"caml_deserialize_block_8"}{Read an array of 8-byte quantities}
-\entree{"caml_deserialize_error"}{Signal an error during deserialization;
-"input_value" or "Marshal.from_..." raise a "Failure" exception after
-cleaning up their internal data structures}
-\end{tableau}
-
-Serialization functions are attached to the custom blocks to which
-they apply. Obviously, deserialization functions cannot be attached
-this way, since the custom block does not exist yet when
-deserialization begins! Thus, the "struct custom_operations" that
-contain deserialization functions must be registered with the
-deserializer in advance, using the "register_custom_operations"
-function declared in "<caml/custom.h>". Deserialization proceeds by
-reading the identifier off the input stream, allocating a custom block
-of the size specified in the input stream, searching the registered
-"struct custom_operation" blocks for one with the same identifier, and
-calling its "deserialize" function to fill the data part of the custom block.
-
-\subsection{ss:c-custom-idents}{Choosing identifiers}
-
-Identifiers in "struct custom_operations" must be chosen carefully,
-since they must identify uniquely the data structure for serialization
-and deserialization operations. In particular, consider including a
-version number in the identifier; this way, the format of the data can
-be changed later, yet backward-compatible deserialisation functions
-can be provided.
-
-Identifiers starting with "_" (an underscore character) are reserved
-for the OCaml runtime system; do not use them for your custom
-data. We recommend to use a URL
-("http://mymachine.mydomain.com/mylibrary/version-number")
-or a Java-style package name
-("com.mydomain.mymachine.mylibrary.version-number")
-as identifiers, to minimize the risk of identifier collision.
-
-\subsection{ss:c-finalized}{Finalized blocks}
-
-Custom blocks generalize the finalized blocks that were present in
-OCaml prior to version 3.00. For backward compatibility, the
-format of custom blocks is compatible with that of finalized blocks,
-and the "alloc_final" function is still available to allocate a custom
-block with a given finalization function, but default comparison,
-hashing and serialization functions. "caml_alloc_final("\var{n}",
-"\var{f}", "\var{used}", "\var{max}")" returns a fresh custom block of
-size \var{n}+1 words, with finalization function \var{f}. The first
-word is reserved for storing the custom operations; the other
-\var{n} words are available for your data. The two parameters
-\var{used} and \var{max} are used to control the speed of garbage
-collection, as described for "caml_alloc_custom".
-
-\section{s:C-Bigarrays}{Advanced topic: Bigarrays and the OCaml-C interface}
-
-This section explains how C stub code that interfaces C or Fortran
-code with OCaml code can use Bigarrays.
-
-\subsection{ss:C-Bigarrays-include}{Include file}
-
-The include file "<caml/bigarray.h>" must be included in the C stub
-file. It declares the functions, constants and macros discussed
-below.
-
-\subsection{ss:C-Bigarrays-access}{Accessing an OCaml bigarray from C or Fortran}
-
-If \var{v} is a OCaml "value" representing a Bigarray, the expression
-"Caml_ba_data_val("\var{v}")" returns a pointer to the data part of the array.
-This pointer is of type "void *" and can be cast to the appropriate C
-type for the array (e.g. "double []", "char [][10]", etc).
-
-Various characteristics of the OCaml Bigarray can be consulted from C
-as follows:
-\begin{tableau}{|l|l|}{C expression}{Returns}
-\entree{"Caml_ba_array_val("\var{v}")->num_dims"}{number of dimensions}
-\entree{"Caml_ba_array_val("\var{v}")->dim["\var{i}"]"}{\var{i}-th dimension}
-\entree{"Caml_ba_array_val("\var{v}")->flags & BIGARRAY_KIND_MASK"}{kind of array elements}
-\end{tableau}
-The kind of array elements is one of the following constants:
-\begin{tableau}{|l|l|}{Constant}{Element kind}
-\entree{"CAML_BA_FLOAT32"}{32-bit single-precision floats}
-\entree{"CAML_BA_FLOAT64"}{64-bit double-precision floats}
-\entree{"CAML_BA_SINT8"}{8-bit signed integers}
-\entree{"CAML_BA_UINT8"}{8-bit unsigned integers}
-\entree{"CAML_BA_SINT16"}{16-bit signed integers}
-\entree{"CAML_BA_UINT16"}{16-bit unsigned integers}
-\entree{"CAML_BA_INT32"}{32-bit signed integers}
-\entree{"CAML_BA_INT64"}{64-bit signed integers}
-\entree{"CAML_BA_CAML_INT"}{31- or 63-bit signed integers}
-\entree{"CAML_BA_NATIVE_INT"}{32- or 64-bit (platform-native) integers}
-\end{tableau}
-%
-\paragraph{Warning:}
-"Caml_ba_array_val("\var{v}")" must always be dereferenced immediately and not stored
-anywhere, including local variables.
-It resolves to a derived pointer: it is not a valid OCaml value but points to
-a memory region managed by the GC. For this reason this value must not be
-stored in any memory location that could be live cross a GC.
-
-The following example shows the passing of a two-dimensional Bigarray
-to a C function and a Fortran function.
-\begin{verbatim}
- extern void my_c_function(double * data, int dimx, int dimy);
- extern void my_fortran_function_(double * data, int * dimx, int * dimy);
-
- CAMLprim value caml_stub(value bigarray)
- {
- int dimx = Caml_ba_array_val(bigarray)->dim[0];
- int dimy = Caml_ba_array_val(bigarray)->dim[1];
- /* C passes scalar parameters by value */
- my_c_function(Caml_ba_data_val(bigarray), dimx, dimy);
- /* Fortran passes all parameters by reference */
- my_fortran_function_(Caml_ba_data_val(bigarray), &dimx, &dimy);
- return Val_unit;
- }
-\end{verbatim}
-
-\subsection{ss:C-Bigarrays-wrap}{Wrapping a C or Fortran array as an OCaml Bigarray}
-
-A pointer \var{p} to an already-allocated C or Fortran array can be
-wrapped and returned to OCaml as a Bigarray using the "caml_ba_alloc"
-or "caml_ba_alloc_dims" functions.
-\begin{itemize}
-\item
-"caml_ba_alloc("\var{kind} "|" \var{layout}, \var{numdims}, \var{p}, \var{dims}")"
-
-Return an OCaml Bigarray wrapping the data pointed to by \var{p}.
-\var{kind} is the kind of array elements (one of the "CAML_BA_"
-kind constants above). \var{layout} is "CAML_BA_C_LAYOUT" for an
-array with C layout and "CAML_BA_FORTRAN_LAYOUT" for an array with
-Fortran layout. \var{numdims} is the number of dimensions in the
-array. \var{dims} is an array of \var{numdims} long integers, giving
-the sizes of the array in each dimension.
-
-\item
-"caml_ba_alloc_dims("\var{kind} "|" \var{layout}, \var{numdims},
-\var{p}, "(long) "\nth{dim}{1}, "(long) "\nth{dim}{2}, \ldots, "(long) "\nth{dim}{numdims}")"
-
-Same as "caml_ba_alloc", but the sizes of the array in each dimension
-are listed as extra arguments in the function call, rather than being
-passed as an array.
-\end{itemize}
-%
-The following example illustrates how statically-allocated C and
-Fortran arrays can be made available to OCaml.
-\begin{verbatim}
- extern long my_c_array[100][200];
- extern float my_fortran_array_[300][400];
-
- CAMLprim value caml_get_c_array(value unit)
- {
- long dims[2];
- dims[0] = 100; dims[1] = 200;
- return caml_ba_alloc(CAML_BA_NATIVE_INT | CAML_BA_C_LAYOUT,
- 2, my_c_array, dims);
- }
-
- CAMLprim value caml_get_fortran_array(value unit)
- {
- return caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_FORTRAN_LAYOUT,
- 2, my_fortran_array_, 300L, 400L);
- }
-\end{verbatim}
-
-\section{s:C-cheaper-call}{Advanced topic: cheaper C call}
-
-This section describe how to make calling C functions cheaper.
-
-{\bf Note:} this only applies to the native compiler. So whenever you
-use any of these methods, you have to provide an alternative byte-code
-stub that ignores all the special annotations.
-
-\subsection{ss:c-unboxed}{Passing unboxed values}
-
-We said earlier that all OCaml objects are represented by the C type
-"value", and one has to use macros such as "Int_val" to decode data from
-the "value" type. It is however possible to tell the OCaml native-code
-compiler to do this for us and pass arguments unboxed to the C function.
-Similarly it is possible to tell OCaml to expect the result unboxed and box
-it for us.
-
-The motivation is that, by letting `ocamlopt` deal with boxing, it can
-often decide to suppress it entirely.
-
-For instance let's consider this example:
-
-\begin{verbatim}
-external foo : float -> float -> float = "foo"
-
-let f a b =
- let len = Array.length a in
- assert (Array.length b = len);
- let res = Array.make len 0. in
- for i = 0 to len - 1 do
- res.(i) <- foo a.(i) b.(i)
- done
-\end{verbatim}
-
-Float arrays are unboxed in OCaml, however the C function "foo" expect
-its arguments as boxed floats and returns a boxed float. Hence the
-OCaml compiler has no choice but to box "a.(i)" and "b.(i)" and unbox
-the result of "foo". This results in the allocation of "3 * len"
-temporary float values.
-
-Now if we annotate the arguments and result with "[\@unboxed]", the
-native-code compiler will be able to avoid all these allocations:
-
-\begin{verbatim}
-external foo
- : (float [@unboxed])
- -> (float [@unboxed])
- -> (float [@unboxed])
- = "foo_byte" "foo"
-\end{verbatim}
-
-In this case the C functions must look like:
-
-\begin{verbatim}
-CAMLprim double foo(double a, double b)
-{
- ...
-}
-
-CAMLprim value foo_byte(value a, value b)
-{
- return caml_copy_double(foo(Double_val(a), Double_val(b)))
-}
-\end{verbatim}
-
-For convenience, when all arguments and the result are annotated with
-"[\@unboxed]", it is possible to put the attribute only once on the
-declaration itself. So we can also write instead:
-
-\begin{verbatim}
-external foo : float -> float -> float = "foo_byte" "foo" [@@unboxed]
-\end{verbatim}
-
-The following table summarize what OCaml types can be unboxed, and
-what C types should be used in correspondence:
-
-\begin{tableau}{|l|l|}{OCaml type}{C type}
-\entree{"float"}{"double"}
-\entree{"int32"}{"int32_t"}
-\entree{"int64"}{"int64_t"}
-\entree{"nativeint"}{"intnat"}
-\end{tableau}
-
-Similarly, it is possible to pass untagged OCaml integers between
-OCaml and C. This is done by annotating the arguments and/or result
-with "[\@untagged]":
-
-\begin{verbatim}
-external f : string -> (int [@untagged]) = "f_byte" "f"
-\end{verbatim}
-
-The corresponding C type must be "intnat".
-
-{\bf Note:} do not use the C "int" type in correspondence with "(int
-[\@untagged])". This is because they often differ in size.
-
-\subsection{ss:c-direct-call}{Direct C call}
-
-In order to be able to run the garbage collector in the middle of
-a C function, the OCaml native-code compiler generates some bookkeeping
-code around C calls. Technically it wraps every C call with the C function
-"caml_c_call" which is part of the OCaml runtime.
-
-For small functions that are called repeatedly, this indirection can have
-a big impact on performances. However this is not needed if we know that
-the C function doesn't allocate, doesn't raise exceptions, and doesn't release
-the master lock (see section~\ref{ss:parallel-execution-long-running-c-code}).
-We can instruct the OCaml native-code compiler of this fact by annotating the
-external declaration with the attribute "[\@\@noalloc]":
-
-\begin{verbatim}
-external bar : int -> int -> int = "foo" [@@noalloc]
-\end{verbatim}
-
-In this case calling "bar" from OCaml is as cheap as calling any other
-OCaml function, except for the fact that the OCaml compiler can't
-inline C functions...
-
-\subsection{ss:c-direct-call-example}{Example: calling C library functions without indirection}
-
-Using these attributes, it is possible to call C library functions
-with no indirection. For instance many math functions are defined this
-way in the OCaml standard library:
-
-\begin{verbatim}
-external sqrt : float -> float = "caml_sqrt_float" "sqrt"
- [@@unboxed] [@@noalloc]
-(** Square root. *)
-
-external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
-(** Exponential. *)
-
-external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
-(** Natural logarithm. *)
-\end{verbatim}
-
-\section{s:C-multithreading}{Advanced topic: multithreading}
-
-Using multiple threads (shared-memory concurrency) in a mixed OCaml/C
-application requires special precautions, which are described in this
-section.
-
-\subsection{ss:c-thread-register}{Registering threads created from C}
-
-Callbacks from C to OCaml are possible only if the calling thread is
-known to the OCaml run-time system. Threads created from OCaml (through
-the "Thread.create" function of the system threads library) are
-automatically known to the run-time system. If the application
-creates additional threads from C and wishes to callback into OCaml
-code from these threads, it must first register them with the run-time
-system. The following functions are declared in the include file
-"<caml/threads.h>".
-
-\begin{itemize}
-\item
-"caml_c_thread_register()" registers the calling thread with the OCaml
-run-time system. Returns 1 on success, 0 on error. Registering an
-already-registered thread does nothing and returns 0.
-\item
-"caml_c_thread_unregister()" must be called before the thread
- terminates, to unregister it from the OCaml run-time system.
-Returns 1 on success, 0 on error. If the calling thread was not
-previously registered, does nothing and returns 0.
-\end{itemize}
-
-\subsection{ss:parallel-execution-long-running-c-code}{Parallel execution of long-running C code}
-
-The OCaml run-time system is not reentrant: at any time, at most one
-thread can be executing OCaml code or C code that uses the OCaml
-run-time system. Technically, this is enforced by a ``master lock''
-that any thread must hold while executing such code.
-
-When OCaml calls the C code implementing a primitive, the master lock
-is held, therefore the C code has full access to the facilities of the
-run-time system. However, no other thread can execute OCaml code
-concurrently with the C code of the primitive.
-
-If a C primitive runs for a long time or performs potentially blocking
-input-output operations, it can explicitly release the master lock,
-enabling other OCaml threads to run concurrently with its operations.
-The C code must re-acquire the master lock before returning to OCaml.
-This is achieved with the following functions, declared in
-the include file "<caml/threads.h>".
-
-\begin{itemize}
-\item
-"caml_release_runtime_system()"
-The calling thread releases the master lock and other OCaml resources,
-enabling other threads to run OCaml code in parallel with the execution
-of the calling thread.
-\item
-"caml_acquire_runtime_system()"
-The calling thread re-acquires the master lock and other OCaml
-resources. It may block until no other thread uses the OCaml run-time
-system.
-\end{itemize}
-
-These functions poll for pending signals by calling asynchronous
-callbacks (section~\ref{ss:c-process-pending-actions}) before releasing and
-after acquiring the lock. They can therefore execute arbitrary OCaml
-code including raising an asynchronous exception.
-
-After "caml_release_runtime_system()" was called and until
-"caml_acquire_runtime_system()" is called, the C code must not access
-any OCaml data, nor call any function of the run-time system, nor call
-back into OCaml code. Consequently, arguments provided by OCaml to the
-C primitive must be copied into C data structures before calling
-"caml_release_runtime_system()", and results to be returned to OCaml
-must be encoded as OCaml values after "caml_acquire_runtime_system()"
-returns.
-
-Example: the following C primitive invokes "gethostbyname" to find the
-IP address of a host name. The "gethostbyname" function can block for
-a long time, so we choose to release the OCaml run-time system while it
-is running.
-\begin{verbatim}
-CAMLprim stub_gethostbyname(value vname)
-{
- CAMLparam1 (vname);
- CAMLlocal1 (vres);
- struct hostent * h;
- char * name;
-
- /* Copy the string argument to a C string, allocated outside the
- OCaml heap. */
- name = caml_stat_strdup(String_val(vname));
- /* Release the OCaml run-time system */
- caml_release_runtime_system();
- /* Resolve the name */
- h = gethostbyname(name);
- /* Free the copy of the string, which we might as well do before
- acquiring the runtime system to benefit from parallelism. */
- caml_stat_free(name);
- /* Re-acquire the OCaml run-time system */
- caml_acquire_runtime_system();
- /* Encode the relevant fields of h as the OCaml value vres */
- ... /* Omitted */
- /* Return to OCaml */
- CAMLreturn (vres);
-}
-\end{verbatim}
-
-Callbacks from C to OCaml must be performed while holding the master
-lock to the OCaml run-time system. This is naturally the case if the
-callback is performed by a C primitive that did not release the
-run-time system. If the C primitive released the run-time system
-previously, or the callback is performed from other C code that was
-not invoked from OCaml (e.g. an event loop in a GUI application), the
-run-time system must be acquired before the callback and released
-after:
-\begin{verbatim}
- caml_acquire_runtime_system();
- /* Resolve OCaml function vfun to be invoked */
- /* Build OCaml argument varg to the callback */
- vres = callback(vfun, varg);
- /* Copy relevant parts of result vres to C data structures */
- caml_release_runtime_system();
-\end{verbatim}
-
-Note: the "acquire" and "release" functions described above were
-introduced in OCaml 3.12. Older code uses the following historical
-names, declared in "<caml/signals.h>":
-\begin{itemize}
-\item "caml_enter_blocking_section" as an alias for
- "caml_release_runtime_system"
-\item "caml_leave_blocking_section" as an alias for
- "caml_acquire_runtime_system"
-\end{itemize}
-Intuition: a ``blocking section'' is a piece of C code that does not
-use the OCaml run-time system, typically a blocking input/output operation.
-
-\section{s:interfacing-windows-unicode-apis}{Advanced topic: interfacing with Windows Unicode APIs}
-
-This section contains some general guidelines for writing C stubs that use
-Windows Unicode APIs.
-
-{\bf Note:} This is an experimental feature of OCaml: the set of APIs below, as
-well as their exact semantics are not final and subject to change in future
-releases.
-
-The OCaml system under Windows can be configured at build time in one of two
-modes:
-
-\begin{itemize}
-
-\item {\bf legacy mode:} All path names, environment variables, command line
-arguments, etc. on the OCaml side are assumed to be encoded using the current
-8-bit code page of the system.
-
-\item {\bf Unicode mode:} All path names, environment variables, command line
-arguments, etc. on the OCaml side are assumed to be encoded using UTF-8.
-
-\end{itemize}
-
-In what follows, we say that a string has the \emph{OCaml encoding} if it is
-encoded in UTF-8 when in Unicode mode, in the current code page in legacy mode,
-or is an arbitrary string under Unix. A string has the \emph{platform encoding}
-if it is encoded in UTF-16 under Windows or is an arbitrary string under Unix.
-
-From the point of view of the writer of C stubs, the challenges of interacting
-with Windows Unicode APIs are twofold:
-
-\begin{itemize}
-
-\item The Windows API uses the UTF-16 encoding to support Unicode. The runtime
-system performs the necessary conversions so that the OCaml programmer only
-needs to deal with the OCaml encoding. C stubs that call Windows Unicode APIs
-need to use specific runtime functions to perform the necessary conversions in a
-compatible way.
-
-\item When writing stubs that need to be compiled under both Windows and Unix,
-the stubs need to be written in a way that allow the necessary conversions under
-Windows but that also work under Unix, where typically nothing particular needs
-to be done to support Unicode.
-
-\end{itemize}
-
-The native C character type under Windows is "WCHAR", two bytes wide, while
-under Unix it is "char", one byte wide. A type "char_os" is defined in
-"<caml/misc.h>" that stands for the concrete C character type of each
-platform. Strings in the platform encoding are of type "char_os *".
-
-The following functions are exposed to help write compatible C stubs. To use
-them, you need to include both "<caml/misc.h>" and "<caml/osdeps.h>".
-
-\begin{itemize}
-
-\item "char_os* caml_stat_strdup_to_os(const char *)" copies the argument while
-translating from OCaml encoding to the platform encoding. This function is
-typically used to convert the "char *" underlying an OCaml string before passing
-it to an operating system API that takes a Unicode argument. Under Unix, it is
-equivalent to "caml_stat_strdup".
-
-{\bf Note:} For maximum backwards compatibility in Unicode mode, if the argument
-is not a valid UTF-8 string, this function will fall back to assuming that it is
-encoded in the current code page.
-
-\item "char* caml_stat_strdup_of_os(const char_os *)" copies the argument while
-translating from the platform encoding to the OCaml encoding. It is the inverse
-of "caml_stat_strdup_to_os". This function is typically used to convert a string
-obtained from the operating system before passing it on to OCaml code. Under
-Unix, it is equivalent to "caml_stat_strdup".
-
-\item "value caml_copy_string_of_os(char_os *)" allocates an OCaml string with
-contents equal to the argument string converted to the OCaml encoding. This
-function is essentially equivalent to "caml_stat_strdup_of_os" followed by
-"caml_copy_string", except that it avoids the allocation of the intermediate
-string returned by "caml_stat_strdup_of_os". Under Unix, it is equivalent to
-"caml_copy_string".
-
-\end{itemize}
-
-{\bf Note:} The strings returned by "caml_stat_strdup_to_os" and
-"caml_stat_strdup_of_os" are allocated using "caml_stat_alloc", so they need to
-be deallocated using "caml_stat_free" when they are no longer needed.
-
-\paragraph{Example} We want to bind the function "getenv" in a way that works
-both under Unix and Windows. Under Unix this function has the prototype:
-
-\begin{verbatim}
- char *getenv(const char *);
-\end{verbatim}
-While the Unicode version under Windows has the prototype:
-\begin{verbatim}
- WCHAR *_wgetenv(const WCHAR *);
-\end{verbatim}
-
-In terms of "char_os", both functions take an argument of type "char_os *" and
-return a result of the same type. We begin by choosing the right implementation
-of the function to bind:
-
-\begin{verbatim}
-#ifdef _WIN32
-#define getenv_os _wgetenv
-#else
-#define getenv_os getenv
-#endif
-\end{verbatim}
-
-The rest of the binding is the same for both platforms:
-
-\begin{verbatim}
-/* The following define is necessary because the API is experimental */
-#define CAML_NAME_SPACE
-#define CAML_INTERNALS
-
-#include <caml/mlvalues.h>
-#include <caml/misc.h>
-#include <caml/alloc.h>
-#include <caml/fail.h>
-#include <caml/osdeps.h>
-#include <stdlib.h>
-
-CAMLprim value stub_getenv(value var_name)
-{
- CAMLparam1(var_name);
- CAMLlocal1(var_value);
- char_os *var_name_os, *var_value_os;
-
- var_name_os = caml_stat_strdup_to_os(String_val(var_name));
- var_value_os = getenv_os(var_name_os);
- caml_stat_free(var_name_os);
-
- if (var_value_os == NULL)
- caml_raise_not_found();
-
- var_value = caml_copy_string_of_os(var_value_os);
-
- CAMLreturn(var_value);
-}
-\end{verbatim}
-
-\section{s:ocamlmklib}{Building mixed C/OCaml libraries: \texttt{ocamlmklib}}
-
-The "ocamlmklib" command facilitates the construction of libraries
-containing both OCaml code and C code, and usable both in static
-linking and dynamic linking modes. This command is available under
-Windows since Objective Caml 3.11 and under other operating systems since
-Objective Caml 3.03.
-
-The "ocamlmklib" command takes three kinds of arguments:
-\begin{itemize}
-\item OCaml source files and object files (".cmo", ".cmx", ".ml")
-comprising the OCaml part of the library;
-\item C object files (".o", ".a", respectively, ".obj", ".lib")
- comprising the C part of the library;
-\item Support libraries for the C part ("-l"\var{lib}).
-\end{itemize}
-It generates the following outputs:
-\begin{itemize}
-\item An OCaml bytecode library ".cma" incorporating the ".cmo" and
-".ml" OCaml files given as arguments, and automatically referencing the
-C library generated with the C object files.
-\item An OCaml native-code library ".cmxa" incorporating the ".cmx" and
-".ml" OCaml files given as arguments, and automatically referencing the
-C library generated with the C object files.
-\item If dynamic linking is supported on the target platform, a
-".so" (respectively, ".dll") shared library built from the C object files given as arguments,
-and automatically referencing the support libraries.
-\item A C static library ".a"(respectively, ".lib") built from the C object files.
-\end{itemize}
-In addition, the following options are recognized:
-\begin{options}
-\item["-cclib", "-ccopt", "-I", "-linkall"]
-These options are passed as is to "ocamlc" or "ocamlopt".
-See the documentation of these commands.
-\item["-rpath", "-R", "-Wl,-rpath", "-Wl,-R"]
-These options are passed as is to the C compiler. Refer to the
-documentation of the C compiler.
-\item["-custom"] Force the construction of a statically linked library
-only, even if dynamic linking is supported.
-\item["-failsafe"] Fall back to building a statically linked library
-if a problem occurs while building the shared library (e.g. some of
-the support libraries are not available as shared libraries).
-\item["-L"\var{dir}] Add \var{dir} to the search path for support
-libraries ("-l"\var{lib}).
-\item["-ocamlc" \var{cmd}] Use \var{cmd} instead of "ocamlc" to call
-the bytecode compiler.
-\item["-ocamlopt" \var{cmd}] Use \var{cmd} instead of "ocamlopt" to call
-the native-code compiler.
-\item["-o" \var{output}] Set the name of the generated OCaml library.
-"ocamlmklib" will generate \var{output}".cma" and/or \var{output}".cmxa".
-If not specified, defaults to "a".
-\item["-oc" \var{outputc}] Set the name of the generated C library.
-"ocamlmklib" will generate "lib"\var{outputc}".so" (if shared
-libraries are supported) and "lib"\var{outputc}".a".
-If not specified, defaults to the output name given with "-o".
-\end{options}
-
-\noindent
-On native Windows, the following environment variable is also consulted:
-
-\begin{options}
-\item["OCAML_FLEXLINK"] Alternative executable to use instead of the
-configured value. Primarily used for bootstrapping.
-\end{options}
-
-\paragraph{Example} Consider an OCaml interface to the standard "libz"
-C library for reading and writing compressed files. Assume this
-library resides in "/usr/local/zlib". This interface is
-composed of an OCaml part "zip.cmo"/"zip.cmx" and a C part "zipstubs.o"
-containing the stub code around the "libz" entry points. The
-following command builds the OCaml libraries "zip.cma" and "zip.cmxa",
-as well as the companion C libraries "dllzip.so" and "libzip.a":
-\begin{verbatim}
-ocamlmklib -o zip zip.cmo zip.cmx zipstubs.o -lz -L/usr/local/zlib
-\end{verbatim}
-If shared libraries are supported, this performs the following
-commands:
-\begin{verbatim}
-ocamlc -a -o zip.cma zip.cmo -dllib -lzip \
- -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
-ocamlopt -a -o zip.cmxa zip.cmx -cclib -lzip \
- -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
-gcc -shared -o dllzip.so zipstubs.o -lz -L/usr/local/zlib
-ar rc libzip.a zipstubs.o
-\end{verbatim}
-Note: This example is on a Unix system. The exact command lines
-may be different on other systems.
-
-If shared libraries are not supported, the following commands are
-performed instead:
-\begin{verbatim}
-ocamlc -a -custom -o zip.cma zip.cmo -cclib -lzip \
- -cclib -lz -ccopt -L/usr/local/zlib
-ocamlopt -a -o zip.cmxa zip.cmx -lzip \
- -cclib -lz -ccopt -L/usr/local/zlib
-ar rc libzip.a zipstubs.o
-\end{verbatim}
-Instead of building simultaneously the bytecode library, the
-native-code library and the C libraries, "ocamlmklib" can be called
-three times to build each separately. Thus,
-\begin{verbatim}
-ocamlmklib -o zip zip.cmo -lz -L/usr/local/zlib
-\end{verbatim}
-builds the bytecode library "zip.cma", and
-\begin{verbatim}
-ocamlmklib -o zip zip.cmx -lz -L/usr/local/zlib
-\end{verbatim}
-builds the native-code library "zip.cmxa", and
-\begin{verbatim}
-ocamlmklib -o zip zipstubs.o -lz -L/usr/local/zlib
-\end{verbatim}
-builds the C libraries "dllzip.so" and "libzip.a". Notice that the
-support libraries ("-lz") and the corresponding options
-("-L/usr/local/zlib") must be given on all three invocations of "ocamlmklib",
-because they are needed at different times depending on whether shared
-libraries are supported.
-
-
-\section{s:c-internal-guidelines}{Cautionary words: the internal runtime API}
-
-Not all header available in the "caml/" directory were described in previous
-sections. All those unmentioned headers are part of the internal runtime API,
-for which there is \emph{no} stability guarantee. If you really need access
-to this internal runtime API, this section provides some guidelines
-that may help you to write code that might not break on every new version
-of OCaml.
-\paragraph{Note} Programmers which come to rely on the internal API
-for a use-case which they find realistic and useful are encouraged to open
-a request for improvement on the bug tracker.
-
-\subsection{ss:c-internals}{Internal variables and CAML_INTERNALS}
-Since OCaml 4.04, it is possible to get access to every part of the internal
-runtime API by defining the "CAML_INTERNALS" macro before loading caml header files.
-If this macro is not defined, parts of the internal runtime API are hidden.
-
-If you are using internal C variables, do not redefine them by hand. You should
-import those variables by including the corresponding header files. The
-representation of those variables has already changed once in OCaml 4.10, and is
-still under evolution.
-If your code relies on such internal and brittle properties, it will be broken
-at some point in time.
-
-For instance, rather than redefining "caml_young_limit":
-\begin{verbatim}
-extern int caml_young_limit;
-\end{verbatim}
-which breaks in OCaml $\ge$ 4.10, you should include the "minor_gc" header:
-\begin{verbatim}
-#include <caml/minor_gc.h>
-\end{verbatim}
-
-\subsection{ss:c-internal-macros}{OCaml version macros}
-Finally, if including the right headers is not enough, or if you need to support
-version older than OCaml 4.04, the header file "caml/version.h" should help
-you to define your own compatibility layer.
-This file provides few macros defining the current OCaml version.
-In particular, the "OCAML_VERSION" macro describes the current version,
-its format is "MmmPP".
-For example, if you need some specific handling for versions older than 4.10.0,
-you could write
-\begin{verbatim}
-#include <caml/version.h>
-#if OCAML_VERSION >= 41000
-...
-#else
-...
-#endif
-\end{verbatim}
+++ /dev/null
-\chapter{Lexer and parser generators (ocamllex, ocamlyacc)}
-\label{c:ocamlyacc}
-%HEVEA\cutname{lexyacc.html}
-
-This chapter describes two program generators: "ocamllex", that
-produces a lexical analyzer from a set of regular expressions with
-associated semantic actions, and "ocamlyacc", that produces a parser
-from a grammar with associated semantic actions.
-
-These program generators are very close to the well-known "lex" and
-"yacc" commands that can be found in most C programming environments.
-This chapter assumes a working knowledge of "lex" and "yacc": while
-it describes the input syntax for "ocamllex" and "ocamlyacc" and the
-main differences with "lex" and "yacc", it does not explain the basics
-of writing a lexer or parser description in "lex" and "yacc". Readers
-unfamiliar with "lex" and "yacc" are referred to ``Compilers:
-principles, techniques, and tools'' by Aho, Sethi and Ullman
-(Addison-Wesley, 1986), or ``Lex $\&$ Yacc'', by Levine, Mason and
-Brown (O'Reilly, 1992).
-
-\section{s:ocamllex-overview}{Overview of \texttt{ocamllex}}
-
-The "ocamllex" command produces a lexical analyzer from a set of regular
-expressions with attached semantic actions, in the style of
-"lex". Assuming the input file is \var{lexer}".mll", executing
-\begin{alltt}
- ocamllex \var{lexer}.mll
-\end{alltt}
-produces OCaml code for a lexical analyzer in file \var{lexer}".ml".
-This file defines one lexing function per entry point in the lexer
-definition. These functions have the same names as the entry
-points. Lexing functions take as argument a lexer buffer, and return
-the semantic attribute of the corresponding entry point.
-
-Lexer buffers are an abstract data type implemented in the standard
-library module "Lexing". The functions "Lexing.from_channel",
-"Lexing.from_string" and "Lexing.from_function" create
-lexer buffers that read from an input channel, a character string, or
-any reading function, respectively. (See the description of module
-"Lexing" in chapter~\ref{c:stdlib}.)
-
-When used in conjunction with a parser generated by "ocamlyacc", the
-semantic actions compute a value belonging to the type "token" defined
-by the generated parsing module. (See the description of "ocamlyacc"
-below.)
-
-\subsection{ss:ocamllex-options}{Options}
-The following command-line options are recognized by "ocamllex".
-
-\begin{options}
-
-\item["-ml"]
-Output code that does not use OCaml's built-in automata
-interpreter. Instead, the automaton is encoded by OCaml functions.
-This option improves performance when using the native compiler, but
-decreases it when using the bytecode compiler.
-
-\item["-o" \var{output-file}]
-Specify the name of the output file produced by "ocamllex".
-The default is the input file name with its extension replaced by ".ml".
-
-\item["-q"]
-Quiet mode. "ocamllex" normally outputs informational messages
-to standard output. They are suppressed if option "-q" is used.
-
-\item["-v" or "-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-%
-\end{options}
-
-\section{s:ocamllex-syntax}{Syntax of lexer definitions}
-
-The format of lexer definitions is as follows:
-\begin{alltt}
-\{ \var{header} \}
-let \var{ident} = \var{regexp} \ldots
-[refill \{ \var{refill-handler} \}]
-rule \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
- parse \var{regexp} \{ \var{action} \}
- | \ldots
- | \var{regexp} \{ \var{action} \}
-and \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
- parse \ldots
-and \ldots
-\{ \var{trailer} \}
-\end{alltt}
-Comments are delimited by "(*" and "*)", as in OCaml.
-The "parse" keyword, can be replaced by the "shortest" keyword, with
-the semantic consequences explained below.
-
-Refill handlers are a recent (optional) feature introduced in 4.02,
-documented below in subsection~\ref{ss:refill-handlers}.
-
-\subsection{ss:ocamllex-header-trailer}{Header and trailer}
-The {\it header} and {\it trailer} sections are arbitrary OCaml
-text enclosed in curly braces. Either or both can be omitted. If
-present, the header text is copied as is at the beginning of the
-output file and the trailer text at the end. Typically, the
-header section contains the "open" directives required
-by the actions, and possibly some auxiliary functions used in the
-actions.
-
-\subsection{ss:ocamllex-named-regexp}{Naming regular expressions}
-
-Between the header and the entry points, one can give names to
-frequently-occurring regular expressions. This is written
-@"let" ident "=" regexp@.
-In regular expressions that follow this declaration, the identifier
-\var{ident} can be used as shorthand for \var{regexp}.
-
-\subsection{ss:ocamllex-entry-points}{Entry points}
-
-The names of the entry points must be valid identifiers for OCaml
-values (starting with a lowercase letter).
-Similarly, the arguments \texttt{\var{arg$_1$}\ldots{}
-\var{arg$_n$}} must be valid identifiers for OCaml.
-Each entry point becomes an
-OCaml function that takes $n+1$ arguments,
-the extra implicit last argument being of type "Lexing.lexbuf".
-Characters are read from the "Lexing.lexbuf" argument and matched
-against the regular expressions provided in the rule, until a prefix
-of the input matches one of the rule. The corresponding action is
-then evaluated and returned as the result of the function.
-
-
-If several regular expressions match a prefix of the input, the
-``longest match'' rule applies: the regular expression that matches
-the longest prefix of the input is selected. In case of tie, the
-regular expression that occurs earlier in the rule is selected.
-
-However, if lexer rules are introduced with the "shortest" keyword in
-place of the "parse" keyword, then the ``shortest match'' rule applies:
-the shortest prefix of the input is selected. In case of tie, the
-regular expression that occurs earlier in the rule is still selected.
-This feature is not intended for use in ordinary lexical analyzers, it
-may facilitate the use of "ocamllex" as a simple text processing tool.
-
-
-
-\subsection{ss:ocamllex-regexp}{Regular expressions}
-
-The regular expressions are in the style of "lex", with a more
-OCaml-like syntax.
-\begin{syntax}
-regexp:
- \ldots
-\end{syntax}
-\begin{options}
-
-\item[@"'" regular-char || escape-sequence "'"@]
-A character constant, with the same syntax as OCaml character
-constants. Match the denoted character.
-
-\item["_"]
-(underscore) Match any character.
-
-\item[@"eof"@]
-Match the end of the lexer input.\\
-{\bf Note:} On some systems, with interactive input, an end-of-file
-may be followed by more characters. However, "ocamllex" will not
-correctly handle regular expressions that contain "eof" followed by
-something else.
-
-\item[@'"' { string-character } '"'@]
-A string constant, with the same syntax as OCaml string
-constants. Match the corresponding sequence of characters.
-
-\item[@'[' character-set ']'@]
-Match any single character belonging to the given
-character set. Valid character sets are: single
-character constants @"'" @c@ "'"@; ranges of characters
-@"'" @c@_1 "'" "-" "'" @c@_2 "'"@ (all characters between $c_1$ and $c_2$,
-inclusive); and the union of two or more character sets, denoted by
-concatenation.
-
-\item[@'[' '^' character-set ']'@]
-Match any single character not belonging to the given character set.
-
-
-\item[@regexp_1 '#' regexp_2@]
-(difference of character sets)
-Regular expressions @regexp_1@ and @regexp_2@ must be character sets
-defined with @'['\ldots ']'@ (or a single character expression or
-underscore "_").
-Match the difference of the two specified character sets.
-
-
-\item[@regexp '*'@]
-(repetition) Match the concatenation of zero or more
-strings that match @regexp@.
-
-\item[@regexp '+'@]
-(strict repetition) Match the concatenation of one or more
-strings that match @regexp@.
-
-\item[@regexp '?'@]
-(option) Match the empty string, or a string matching @regexp@.
-
-\item[@regexp_1 '|' regexp_2@]
-(alternative) Match any string that matches @regexp_1@ or @regexp_2@
-
-\item[@regexp_1 regexp_2@]
-(concatenation) Match the concatenation of two strings, the first
-matching @regexp_1@, the second matching @regexp_2@.
-
-\item[@'(' regexp ')'@]
-Match the same strings as @regexp@.
-
-\item[@ident@]
-Reference the regular expression bound to @ident@ by an earlier
-@"let" ident "=" regexp@ definition.
-
-\item[@regexp 'as' ident@]
-Bind the substring matched by @regexp@ to identifier @ident@.
-\end{options}
-
-Concerning the precedences of operators, "#" has the highest precedence,
-followed by "*", "+" and "?",
-then concatenation, then "|" (alternation), then "as".
-
-\subsection{ss:ocamllex-actions}{Actions}
-
-The actions are arbitrary OCaml expressions. They are evaluated in
-a context where the identifiers defined by using the "as" construct
-are bound to subparts of the matched string.
-Additionally, "lexbuf" is bound to the current lexer
-buffer. Some typical uses for "lexbuf", in conjunction with the
-operations on lexer buffers provided by the "Lexing" standard library
-module, are listed below.
-
-\begin{options}
-\item["Lexing.lexeme lexbuf"]
-Return the matched string.
-
-\item["Lexing.lexeme_char lexbuf "$n$]
-Return the $n\th$
-character in the matched string. The first character corresponds to $n = 0$.
-
-\item["Lexing.lexeme_start lexbuf"]
-Return the absolute position in the input text of the beginning of the
-matched string (i.e. the offset of the first character of the matched
-string). The first character read from the input text has offset 0.
-
-\item["Lexing.lexeme_end lexbuf"]
-Return the absolute position in the input text of the end of the
-matched string (i.e. the offset of the first character after the
-matched string). The first character read from the input text has
-offset 0.
-
-\newcommand{\sub}[1]{$_{#1}$}%
-\item[\var{entrypoint} {[\var{exp\sub{1}}\ldots{} \var{exp\sub{n}}]} "lexbuf"]
-(Where \var{entrypoint} is the name of another entry point in the same
-lexer definition.) Recursively call the lexer on the given entry point.
-Notice that "lexbuf" is the last argument.
-Useful for lexing nested comments, for example.
-
-\end{options}
-
-\subsection{ss:ocamllex-variables}{Variables in regular expressions}
-The "as" construct is similar to ``\emph{groups}'' as provided by
-numerous regular expression packages.
-The type of these variables can be "string", "char", "string option"
-or "char option".
-
-We first consider the case of linear patterns, that is the case when
-all "as" bound variables are distinct.
-In @regexp 'as' ident@, the type of @ident@ normally is "string" (or
-"string option") except
-when @regexp@ is a character constant, an underscore, a string
-constant of length one, a character set specification, or an
-alternation of those. Then, the type of @ident@ is "char" (or "char
-option").
-Option types are introduced when overall rule matching does not
-imply matching of the bound sub-pattern. This is in particular the
-case of @'(' regexp 'as' ident ')' '?'@ and of
-@regexp_1 '|' '(' regexp_2 'as' ident ')'@.
-
-There is no linearity restriction over "as" bound variables.
-When a variable is bound more than once, the previous rules are to be
-extended as follows:
-\begin{itemize}
-\item A variable is a "char" variable when all its occurrences bind
-"char" occurrences in the previous sense.
-\item A variable is an "option" variable when the overall expression
-can be matched without binding this variable.
-\end{itemize}
-For instance, in
-"('a' as x) | ( 'a' (_ as x) )" the variable "x" is of type
-"char", whereas in
-"(\"ab\" as x) | ( 'a' (_ as x) ? )" the variable "x" is of type
-"string option".
-
-
-In some cases, a successful match may not yield a unique set of bindings.
-For instance the matching of \verb+aba+ by the regular expression
-"(('a'|\"ab\") as x) ((\"ba\"|'a') as y)" may result in binding
-either
-\verb+x+ to \verb+"ab"+ and \verb+y+ to \verb+"a"+, or
-\verb+x+ to \verb+"a"+ and \verb+y+ to \verb+"ba"+.
-The automata produced "ocamllex" on such ambiguous regular
-expressions will select one of the possible resulting sets of
-bindings.
-The selected set of bindings is purposely left unspecified.
-
-\subsection{ss:refill-handlers}{Refill handlers}
-
-By default, when ocamllex reaches the end of its lexing buffer, it
-will silently call the "refill_buff" function of "lexbuf" structure
-and continue lexing. It is sometimes useful to be able to take control
-of refilling action; typically, if you use a library for asynchronous
-computation, you may want to wrap the refilling action in a delaying
-function to avoid blocking synchronous operations.
-
-Since OCaml 4.02, it is possible to specify a \var{refill-handler},
-a function that will be called when refill happens. It is passed the
-continuation of the lexing, on which it has total control. The OCaml
-expression used as refill action should have a type that is an
-instance of
-\begin{verbatim}
- (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'a
-\end{verbatim}
-where the first argument is the continuation which captures the
-processing ocamllex would usually perform (refilling the buffer, then
-calling the lexing function again), and the result type that
-instantiates ['a] should unify with the result type of all lexing
-rules.
-
-As an example, consider the following lexer that is parametrized over
-an arbitrary monad:
-\begin{verbatim}
-{
-type token = EOL | INT of int | PLUS
-
-module Make (M : sig
- type 'a t
- val return: 'a -> 'a t
- val bind: 'a t -> ('a -> 'b t) -> 'b t
- val fail : string -> 'a t
-
- (* Set up lexbuf *)
- val on_refill : Lexing.lexbuf -> unit t
- end)
-= struct
-
-let refill_handler k lexbuf =
- M.bind (M.on_refill lexbuf) (fun () -> k lexbuf)
-
-}
-
-refill {refill_handler}
-
-rule token = parse
-| [' ' '\t']
- { token lexbuf }
-| '\n'
- { M.return EOL }
-| ['0'-'9']+ as i
- { M.return (INT (int_of_string i)) }
-| '+'
- { M.return PLUS }
-| _
- { M.fail "unexpected character" }
-{
-end
-}
-\end{verbatim}
-
-\subsection{ss:ocamllex-reserved-ident}{Reserved identifiers}
-
-All identifiers starting with "__ocaml_lex" are reserved for use by
-"ocamllex"; do not use any such identifier in your programs.
-
-
-\section{s:ocamlyacc-overview}{Overview of \texttt{ocamlyacc}}
-
-The "ocamlyacc" command produces a parser from a context-free grammar
-specification with attached semantic actions, in the style of "yacc".
-Assuming the input file is \var{grammar}".mly", executing
-\begin{alltt}
- ocamlyacc \var{options} \var{grammar}.mly
-\end{alltt}
-produces OCaml code for a parser in the file \var{grammar}".ml",
-and its interface in file \var{grammar}".mli".
-
-The generated module defines one parsing function per entry point in
-the grammar. These functions have the same names as the entry points.
-Parsing functions take as arguments a lexical analyzer (a function
-from lexer buffers to tokens) and a lexer buffer, and return the
-semantic attribute of the corresponding entry point. Lexical analyzer
-functions are usually generated from a lexer specification by the
-"ocamllex" program. Lexer buffers are an abstract data type
-implemented in the standard library module "Lexing". Tokens are values from
-the concrete type "token", defined in the interface file
-\var{grammar}".mli" produced by "ocamlyacc".
-
-\section{s:ocamlyacc-syntax}{Syntax of grammar definitions}
-
-Grammar definitions have the following format:
-\begin{alltt}
-\%\{
- \var{header}
-\%\}
- \var{declarations}
-\%\%
- \var{rules}
-\%\%
- \var{trailer}
-\end{alltt}
-
-Comments are enclosed between \verb|/*| and \verb|*/| (as in C) in the
-``declarations'' and ``rules'' sections, and between \verb|(*| and
-\verb|*)| (as in OCaml) in the ``header'' and ``trailer'' sections.
-
-\subsection{ss:ocamlyacc-header-trailer}{Header and trailer}
-
-The header and the trailer sections are OCaml code that is copied
-as is into file \var{grammar}".ml". Both sections are optional. The header
-goes at the beginning of the output file; it usually contains
-"open" directives and auxiliary functions required by the semantic
-actions of the rules. The trailer goes at the end of the output file.
-
-\subsection{ss:ocamlyacc-declarations}{Declarations}
-
-Declarations are given one per line. They all start with a \verb"%" sign.
-
-\begin{options}
-
-\item[@"%token" constr \ldots constr@]
-Declare the given symbols @constr \ldots constr@
-as tokens (terminal symbols). These symbols
-are added as constant constructors for the "token" concrete type.
-
-\item[@"%token" "<" typexpr ">" constr \ldots constr@]
-Declare the given symbols @constr \ldots constr@ as tokens with an
-attached attribute of the
-given type. These symbols are added as constructors with arguments of
-the given type for the "token" concrete type. The @typexpr@ part is
-an arbitrary OCaml type expression, except that all type
-constructor names must be fully qualified (e.g. "Modname.typename")
-for all types except standard built-in types, even if the proper
-\verb|open| directives (e.g. \verb|open Modname|) were given in the
-header section. That's because the header is copied only to the ".ml"
-output file, but not to the ".mli" output file, while the @typexpr@ part
-of a \verb"%token" declaration is copied to both.
-
-\item[@"%start" symbol \ldots symbol@]
-Declare the given symbols as entry points for the grammar. For each
-entry point, a parsing function with the same name is defined in the
-output module. Non-terminals that are not declared as entry points
-have no such parsing function. Start symbols must be given a type with
-the \verb|%type| directive below.
-
-\item[@"%type" "<" typexpr ">" symbol \ldots symbol@]
-Specify the type of the semantic attributes for the given symbols.
-This is mandatory for start symbols only. Other nonterminal symbols
-need not be given types by hand: these types will be inferred when
-running the output files through the OCaml compiler (unless the
-\verb"-s" option is in effect). The @typexpr@ part is an arbitrary OCaml
-type expression, except that all type constructor names must be
-fully qualified, as explained above for "%token".
-
-\item[@"%left" symbol \ldots symbol@]
-\item[@"%right" symbol \ldots symbol@]
-\item[@"%nonassoc" symbol \ldots symbol@]
-
-Associate precedences and associativities to the given symbols. All
-symbols on the same line are given the same precedence. They have
-higher precedence than symbols declared before in a \verb"%left",
-\verb"%right" or \verb"%nonassoc" line. They have lower precedence
-than symbols declared after in a \verb"%left", \verb"%right" or
-\verb"%nonassoc" line. The symbols are declared to associate to the
-left (\verb"%left"), to the right (\verb"%right"), or to be
-non-associative (\verb"%nonassoc"). The symbols are usually tokens.
-They can also be dummy nonterminals, for use with the \verb"%prec"
-directive inside the rules.
-
-The precedence declarations are used in the following way to
-resolve reduce/reduce and shift/reduce conflicts:
-\begin{itemize}
-\item Tokens and rules have precedences. By default, the precedence
- of a rule is the precedence of its rightmost terminal. You
- can override this default by using the @"%prec"@ directive in the rule.
-\item A reduce/reduce conflict
- is resolved in favor of the first rule (in the order given by the
- source file), and "ocamlyacc" outputs a warning.
-\item A shift/reduce conflict
- is resolved by comparing the precedence of the rule to be
- reduced with the precedence of the token to be shifted. If the
- precedence of the rule is higher, then the rule will be reduced;
- if the precedence of the token is higher, then the token will
- be shifted.
-\item A shift/reduce conflict between a rule and a token with the
- same precedence will be resolved using the associativity: if the
- token is left-associative, then the parser will reduce; if the
- token is right-associative, then the parser will shift. If the
- token is non-associative, then the parser will declare a syntax
- error.
-\item When a shift/reduce conflict cannot be resolved using the above
- method, then "ocamlyacc" will output a warning and the parser will
- always shift.
-\end{itemize}
-
-\end{options}
-
-\subsection{ss:ocamlyacc-rules}{Rules}
-
-The syntax for rules is as usual:
-\begin{alltt}
-\var{nonterminal} :
- \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
- | \ldots
- | \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
-;
-\end{alltt}
-%
-Rules can also contain the \verb"%prec "{\it symbol} directive in the
-right-hand side part, to override the default precedence and
-associativity of the rule with the precedence and associativity of the
-given symbol.
-
-Semantic actions are arbitrary OCaml expressions, that
-are evaluated to produce the semantic attribute attached to
-the defined nonterminal. The semantic actions can access the
-semantic attributes of the symbols in the right-hand side of
-the rule with the \verb"$" notation: \verb"$1" is the attribute for the
-first (leftmost) symbol, \verb"$2" is the attribute for the second
-symbol, etc.
-
-The rules may contain the special symbol "error" to indicate
-resynchronization points, as in "yacc".
-
-Actions occurring in the middle of rules are not supported.
-
-Nonterminal symbols are like regular OCaml symbols, except that they
-cannot end with "'" (single quote).
-
-\subsection{ss:ocamlyacc-error-handling}{Error handling}
-
-Error recovery is supported as follows: when the parser reaches an
-error state (no grammar rules can apply), it calls a function named
-"parse_error" with the string "\"syntax error\"" as argument. The default
-"parse_error" function does nothing and returns, thus initiating error
-recovery (see below). The user can define a customized "parse_error"
-function in the header section of the grammar file.
-
-The parser also enters error recovery mode if one of the grammar
-actions raises the "Parsing.Parse_error" exception.
-
-In error recovery mode, the parser discards states from the
-stack until it reaches a place where the error token can be shifted.
-It then discards tokens from the input until it finds three successive
-tokens that can be accepted, and starts processing with the first of
-these. If no state can be uncovered where the error token can be
-shifted, then the parser aborts by raising the "Parsing.Parse_error"
-exception.
-
-Refer to documentation on "yacc" for more details and guidance in how
-to use error recovery.
-
-\section{s:ocamlyacc-options}{Options}
-
-The "ocamlyacc" command recognizes the following options:
-
-\begin{options}
-
-\item["-b"{\it prefix}]
-Name the output files {\it prefix}".ml", {\it prefix}".mli",
-{\it prefix}".output", instead of the default naming convention.
-
-\item["-q"]
-This option has no effect.
-
-\item["-v"]
-Generate a description of the parsing tables and a report on conflicts
-resulting from ambiguities in the grammar. The description is put in
-file \var{grammar}".output".
-
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-"]
-Read the grammar specification from standard input. The default
-output file names are "stdin.ml" and "stdin.mli".
-
-\item["--" \var{file}]
-Process \var{file} as the grammar specification, even if its name
-starts with a dash (-) character. This option must be the last on the
-command line.
-
-\end{options}
-
-At run-time, the "ocamlyacc"-generated parser can be debugged by
-setting the "p" option in the "OCAMLRUNPARAM" environment variable
-(see section~\ref{s:ocamlrun-options}). This causes the pushdown
-automaton executing the parser to print a trace of its action (tokens
-shifted, rules reduced, etc). The trace mentions rule numbers and
-state numbers that can be interpreted by looking at the file
-\var{grammar}".output" generated by "ocamlyacc -v".
-
-\section{s:lexyacc-example}{A complete example}
-
-The all-time favorite: a desk calculator. This program reads
-arithmetic expressions on standard input, one per line, and prints
-their values. Here is the grammar definition:
-\begin{verbatim}
- /* File parser.mly */
- %token <int> INT
- %token PLUS MINUS TIMES DIV
- %token LPAREN RPAREN
- %token EOL
- %left PLUS MINUS /* lowest precedence */
- %left TIMES DIV /* medium precedence */
- %nonassoc UMINUS /* highest precedence */
- %start main /* the entry point */
- %type <int> main
- %%
- main:
- expr EOL { $1 }
- ;
- expr:
- INT { $1 }
- | LPAREN expr RPAREN { $2 }
- | expr PLUS expr { $1 + $3 }
- | expr MINUS expr { $1 - $3 }
- | expr TIMES expr { $1 * $3 }
- | expr DIV expr { $1 / $3 }
- | MINUS expr %prec UMINUS { - $2 }
- ;
-\end{verbatim}
-Here is the definition for the corresponding lexer:
-\begin{verbatim}
- (* File lexer.mll *)
- {
- open Parser (* The type token is defined in parser.mli *)
- exception Eof
- }
- rule token = parse
- [' ' '\t'] { token lexbuf } (* skip blanks *)
- | ['\n' ] { EOL }
- | ['0'-'9']+ as lxm { INT(int_of_string lxm) }
- | '+' { PLUS }
- | '-' { MINUS }
- | '*' { TIMES }
- | '/' { DIV }
- | '(' { LPAREN }
- | ')' { RPAREN }
- | eof { raise Eof }
-\end{verbatim}
-Here is the main program, that combines the parser with the lexer:
-\begin{verbatim}
- (* File calc.ml *)
- let _ =
- try
- let lexbuf = Lexing.from_channel stdin in
- while true do
- let result = Parser.main Lexer.token lexbuf in
- print_int result; print_newline(); flush stdout
- done
- with Lexer.Eof ->
- exit 0
-\end{verbatim}
-To compile everything, execute:
-\begin{verbatim}
- ocamllex lexer.mll # generates lexer.ml
- ocamlyacc parser.mly # generates parser.ml and parser.mli
- ocamlc -c parser.mli
- ocamlc -c lexer.ml
- ocamlc -c parser.ml
- ocamlc -c calc.ml
- ocamlc -o calc lexer.cmo parser.cmo calc.cmo
-\end{verbatim}
-
-\section{s:lexyacc-common-errors}{Common errors}
-
-\begin{options}
-
-\item[ocamllex: transition table overflow, automaton is too big]
-
-The deterministic automata generated by "ocamllex" are limited to at
-most 32767 transitions. The message above indicates that your lexer
-definition is too complex and overflows this limit. This is commonly
-caused by lexer definitions that have separate rules for each of the
-alphabetic keywords of the language, as in the following example.
-\begin{verbatim}
-rule token = parse
- "keyword1" { KWD1 }
-| "keyword2" { KWD2 }
-| ...
-| "keyword100" { KWD100 }
-| ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
- { IDENT id}
-\end{verbatim}
-To keep the generated automata small, rewrite those definitions with
-only one general ``identifier'' rule, followed by a hashtable lookup
-to separate keywords from identifiers:
-\begin{verbatim}
-{ let keyword_table = Hashtbl.create 53
- let _ =
- List.iter (fun (kwd, tok) -> Hashtbl.add keyword_table kwd tok)
- [ "keyword1", KWD1;
- "keyword2", KWD2; ...
- "keyword100", KWD100 ]
-}
-rule token = parse
- ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
- { try
- Hashtbl.find keyword_table id
- with Not_found ->
- IDENT id }
-\end{verbatim}
-
-\item[ocamllex: Position memory overflow, too many bindings]
-The deterministic automata generated by "ocamllex" maintain a table of
-positions inside the scanned lexer buffer. The size of this table is
-limited to at most 255 cells. This error should not show up in normal
-situations.
-
-\end{options}
+++ /dev/null
-\chapter{Native-code compilation (ocamlopt)} \label{c:nativecomp}
-%HEVEA\cutname{native.html}
-
-This chapter describes the OCaml high-performance
-native-code compiler "ocamlopt", which compiles OCaml source files to
-native code object files and links these object files to produce
-standalone executables.
-
-The native-code compiler is only available on certain platforms.
-It produces code that runs faster than the bytecode produced by
-"ocamlc", at the cost of increased compilation time and executable code
-size. Compatibility with the bytecode compiler is extremely high: the
-same source code should run identically when compiled with "ocamlc" and
-"ocamlopt".
-
-It is not possible to mix native-code object files produced by "ocamlopt"
-with bytecode object files produced by "ocamlc": a program must be
-compiled entirely with "ocamlopt" or entirely with "ocamlc". Native-code
-object files produced by "ocamlopt" cannot be loaded in the toplevel
-system "ocaml".
-
-\section{s:native-overview}{Overview of the compiler}
-
-The "ocamlopt" command has a command-line interface very close to that
-of "ocamlc". It accepts the same types of arguments, and processes them
-sequentially, after all options have been processed:
-
-\begin{itemize}
-\item
-Arguments ending in ".mli" are taken to be source files for
-compilation unit interfaces. Interfaces specify the names exported by
-compilation units: they declare value names with their types, define
-public data types, declare abstract data types, and so on. From the
-file \var{x}".mli", the "ocamlopt" compiler produces a compiled interface
-in the file \var{x}".cmi". The interface produced is identical to that
-produced by the bytecode compiler "ocamlc".
-
-\item
-Arguments ending in ".ml" are taken to be source files for compilation
-unit implementations. Implementations provide definitions for the
-names exported by the unit, and also contain expressions to be
-evaluated for their side-effects. From the file \var{x}".ml", the "ocamlopt"
-compiler produces two files: \var{x}".o", containing native object code,
-and \var{x}".cmx", containing extra information for linking and
-optimization of the clients of the unit. The compiled implementation
-should always be referred to under the name \var{x}".cmx" (when given
-a ".o" or ".obj" file, "ocamlopt" assumes that it contains code compiled from C,
-not from OCaml).
-
-The implementation is checked against the interface file \var{x}".mli"
-(if it exists) as described in the manual for "ocamlc"
-(chapter~\ref{c:camlc}).
-
-\item
-Arguments ending in ".cmx" are taken to be compiled object code. These
-files are linked together, along with the object files obtained
-by compiling ".ml" arguments (if any), and the OCaml standard
-library, to produce a native-code executable program. The order in
-which ".cmx" and ".ml" arguments are presented on the command line is
-relevant: compilation units are initialized in that order at
-run-time, and it is a link-time error to use a component of a unit
-before having initialized it. Hence, a given \var{x}".cmx" file must come
-before all ".cmx" files that refer to the unit \var{x}.
-
-\item
-Arguments ending in ".cmxa" are taken to be libraries of object code.
-Such a library packs in two files (\var{lib}".cmxa" and \var{lib}".a"/".lib")
-a set of object files (".cmx" and ".o"/".obj" files). Libraries are build with
-"ocamlopt -a" (see the description of the "-a" option below). The object
-files contained in the library are linked as regular ".cmx" files (see
-above), in the order specified when the library was built. The only
-difference is that if an object file contained in a library is not
-referenced anywhere in the program, then it is not linked in.
-
-\item
-Arguments ending in ".c" are passed to the C compiler, which generates
-a ".o"/".obj" object file. This object file is linked with the program.
-
-\item
-Arguments ending in ".o", ".a" or ".so" (".obj", ".lib" and ".dll"
-under Windows) are assumed to be C object files and
-libraries. They are linked with the program.
-
-\end{itemize}
-
-The output of the linking phase is a regular Unix or Windows
-executable file. It does not need "ocamlrun" to run.
-
-The compiler is able to emit some information on its internal stages:
-
-\begin{itemize}
-\item
-% The following two paragraphs are a duplicate from the description of the batch compiler.
-".cmt" files for the implementation of the compilation unit
-and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
-description of "-bin-annot" below).
-Each such file contains a typed abstract syntax tree (AST), that is produced
-during the type checking procedure. This tree contains all available information
-about the location and the specific type of each term in the source file.
-The AST is partial if type checking was unsuccessful.
-
-These ".cmt" and ".cmti" files are typically useful for code inspection tools.
-
-\item
-".cmir-linear" files for the implementation of the compilation unit
-if the option "-save-ir-after scheduling" is passed to it.
-Each such file contains a low-level intermediate representation,
-produced by the instruction scheduling pass.
-
-An external tool can perform low-level optimisations,
-such as code layout, by transforming a ".cmir-linear" file.
-To continue compilation, the compiler can be invoked with (a possibly modified)
-".cmir-linear" file as an argument, instead of the corresponding source file.
-\end{itemize}
-
-\section{s:native-options}{Options}
-
-The following command-line options are recognized by "ocamlopt".
-The options "-pack", "-a", "-shared", "-c" and "-output-obj" are mutually
-exclusive.
-
-% Configure boolean variables used by the macros in unified-options.etex
-\compfalse
-\nattrue
-\topfalse
-% unified-options gathers all options across the native/bytecode
-% compilers and toplevel
-\input{unified-options.tex}
-
-\paragraph{Options for the 32-bit x86 architecture}
-The 32-bit code generator for Intel/AMD x86 processors ("i386"
-architecture) supports the
-following additional option:
-
-\begin{options}
-\item["-ffast-math"] Use the processor instructions to compute
-trigonometric and exponential functions, instead of calling the
-corresponding library routines. The functions affected are:
-"atan", "atan2", "cos", "log", "log10", "sin", "sqrt" and "tan".
-The resulting code runs faster, but the range of supported arguments
-and the precision of the result can be reduced. In particular,
-trigonometric operations "cos", "sin", "tan" have their range reduced to
-$[-2^{64}, 2^{64}]$.
-\end{options}
-
-\paragraph{Options for the 64-bit x86 architecture}
-The 64-bit code generator for Intel/AMD x86 processors ("amd64"
-architecture) supports the following additional options:
-
-\begin{options}
-\item["-fPIC"] Generate position-independent machine code. This is
-the default.
-\item["-fno-PIC"] Generate position-dependent machine code.
-\end{options}
-
-\paragraph{Options for the PowerPC architecture}
-The PowerPC code generator supports the following additional options:
-
-\begin{options}
-\item["-flarge-toc"] Enables the PowerPC large model allowing the TOC (table of
-contents) to be arbitrarily large. This is the default since 4.11.
-\item["-fsmall-toc"] Enables the PowerPC small model allowing the TOC to be up
-to 64 kbytes per compilation unit. Prior to 4.11 this was the default
-behaviour.
-\end{options}
-
-\paragraph{Contextual control of command-line options}
-
-The compiler command line can be modified ``from the outside''
-with the following mechanisms. These are experimental
-and subject to change. They should be used only for experimental and
-development work, not in released packages.
-
-\begin{options}
-\item["OCAMLPARAM" \rm(environment variable)]
-A set of arguments that will be inserted before or after the arguments from
-the command line. Arguments are specified in a comma-separated list
-of "name=value" pairs. A "_" is used to specify the position of
-the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
-executed before parsing the arguments, and "b=y" after. Finally,
-an alternative separator can be specified as the
-first character of the string, within the set ":|; ,".
-\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
-A mapping of file names to lists of arguments that
-will be added to the command line (and "OCAMLPARAM") arguments.
-\item["OCAML_FLEXLINK" \rm(environment variable)]
-Alternative executable to use on native
-Windows for "flexlink" instead of the
-configured value. Primarily used for bootstrapping.
-\end{options}
-
-\section{s:native-common-errors}{Common errors}
-
-The error messages are almost identical to those of "ocamlc".
-See section~\ref{s:comp-errors}.
-
-\section{s:native:running-executable}{Running executables produced by ocamlopt}
-
-Executables generated by "ocamlopt" are native, stand-alone executable
-files that can be invoked directly. They do
-not depend on the "ocamlrun" bytecode runtime system nor on
-dynamically-loaded C/OCaml stub libraries.
-
-During execution of an "ocamlopt"-generated executable,
-the following environment variables are also consulted:
-\begin{options}
-\item["OCAMLRUNPARAM"] Same usage as in "ocamlrun"
- (see section~\ref{s:ocamlrun-options}), except that option "l"
- is ignored (the operating system's stack size limit
- is used instead).
-\item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the
- environment, then "CAMLRUNPARAM" will be used instead. If
- "CAMLRUNPARAM" is not found, then the default values will be used.
-\end{options}
-
-\section{s:compat-native-bytecode}{Compatibility with the bytecode compiler}
-
-This section lists the known incompatibilities between the bytecode
-compiler and the native-code compiler. Except on those points, the two
-compilers should generate code that behave identically.
-
-\begin{itemize}
-
-\item Signals are detected only when the program performs an
-allocation in the heap. That is, if a signal is delivered while in a
-piece of code that does not allocate, its handler will not be called
-until the next heap allocation.
-
-\item On ARM and PowerPC processors (32 and 64 bits), fused
- multiply-add (FMA) instructions can be generated for a
- floating-point multiplication followed by a floating-point addition
- or subtraction, as in "x *. y +. z". The FMA instruction avoids
- rounding the intermediate result "x *. y", which is generally
- beneficial, but produces floating-point results that differ slightly
- from those produced by the bytecode interpreter.
-
-\item On Intel/AMD x86 processors in 32-bit mode,
-some intermediate results in floating-point computations are
-kept in extended precision rather than being rounded to double
-precision like the bytecode compiler always does. Floating-point
-results can therefore differ slightly between bytecode and native code.
-
-\item The native-code compiler performs a number of optimizations that
-the bytecode compiler does not perform, especially when the Flambda
-optimizer is active. In particular, the native-code compiler
-identifies and eliminates ``dead code'', i.e.\ computations that do
-not contribute to the results of the program. For example,
-\begin{verbatim}
- let _ = ignore M.f
-\end{verbatim}
-contains a reference to compilation unit "M" when compiled to
-bytecode. This reference forces "M" to be linked and its
-initialization code to be executed. The native-code compiler
-eliminates the reference to "M", hence the compilation unit "M" may
-not be linked and executed. A workaround is to compile "M" with the
-"-linkall" flag so that it will always be linked and executed, even if
-not referenced. See also the "Sys.opaque_identity" function from the
-"Sys" standard library module.
-
-\item Before 4.10, stack overflows, typically caused by excessively
- deep recursion, are not always turned into a "Stack_overflow"
- exception like with the bytecode compiler. The runtime system makes
- a best effort to trap stack overflows and raise the "Stack_overflow"
- exception, but sometimes it fails and a ``segmentation fault'' or
- another system fault occurs instead.
-
-\end{itemize}
+++ /dev/null
-\chapter{Dependency generator (ocamldep)} \label{c:camldep}
-%HEVEA\cutname{depend.html}
-
-The "ocamldep" command scans a set of OCaml source files
-(".ml" and ".mli" files) for references to external compilation units,
-and outputs dependency lines in a format suitable for the "make"
-utility. This ensures that "make" will compile the source files in the
-correct order, and recompile those files that need to when a source
-file is modified.
-
-The typical usage is:
-\begin{alltt}
- ocamldep \var{options} *.mli *.ml > .depend
-\end{alltt}
-where "*.mli *.ml" expands to all source files in the current
-directory and ".depend" is the file that should contain the
-dependencies. (See below for a typical "Makefile".)
-
-Dependencies are generated both for compiling with the bytecode
-compiler "ocamlc" and with the native-code compiler "ocamlopt".
-
-\section{s:ocamldep-options}{Options}
-
-The following command-line options are recognized by "ocamldep".
-
-\begin{options}
-
-\item["-absname"]
-Show absolute filenames in error messages.
-
-\item["-all"]
-Generate dependencies on all required files, rather than assuming
-implicit dependencies.
-
-\item["-allow-approx"]
-Allow falling back on a lexer-based approximation when parsing fails.
-
-\item["-args" \var{filename}]
- Read additional newline-terminated command line arguments from \var{filename}.
-
-\item["-args0" \var{filename}]
- Read additional null character terminated command line arguments from \var{filename}.
-
-\item["-as-map"]
-For the following files, do not include delayed dependencies for
-module aliases.
-This option assumes that they are compiled using options
-"-no-alias-deps -w -49", and that those files or their interface are
-passed with the "-map" option when computing dependencies for other
-files. Note also that for dependencies to be correct in the
-implementation of a map file, its interface should not coerce any of
-the aliases it contains.
-
-\item["-debug-map"]
-Dump the delayed dependency map for each map file.
-
-\item["-I" \var{directory}]
-Add the given directory to the list of directories searched for
-source files. If a source file "foo.ml" mentions an external
-compilation unit "Bar", a dependency on that unit's interface
-"bar.cmi" is generated only if the source for "bar" is found in the
-current directory or in one of the directories specified with "-I".
-Otherwise, "Bar" is assumed to be a module from the standard library,
-and no dependencies are generated. For programs that span multiple
-directories, it is recommended to pass "ocamldep" the same "-I" options
-that are passed to the compiler.
-
-\item["-nocwd"]
-Do not add current working directory to the list of include directories.
-
-\item["-impl" \var{file}]
-Process \var{file} as a ".ml" file.
-
-\item["-intf" \var{file}]
-Process \var{file} as a ".mli" file.
-
-\item["-map" \var{file}]
-Read and propagate the delayed dependencies for module aliases in
-\var{file}, so that the following files will depend on the
-exported aliased modules if they use them. See the example below.
-
-\item["-ml-synonym" \var{.ext}]
-Consider the given extension (with leading dot) to be a synonym for .ml.
-
-\item["-mli-synonym" \var{.ext}]
-Consider the given extension (with leading dot) to be a synonym for .mli.
-
-\item["-modules"]
-Output raw dependencies of the form
-\begin{verbatim}
- filename: Module1 Module2 ... ModuleN
-\end{verbatim}
-where "Module1", \ldots, "ModuleN" are the names of the compilation
-units referenced within the file "filename", but these names are not
-resolved to source file names. Such raw dependencies cannot be used
-by "make", but can be post-processed by other tools such as "Omake".
-
-\item["-native"]
-Generate dependencies for a pure native-code program (no bytecode
-version). When an implementation file (".ml" file) has no explicit
-interface file (".mli" file), "ocamldep" generates dependencies on the
-bytecode compiled file (".cmo" file) to reflect interface changes.
-This can cause unnecessary bytecode recompilations for programs that
-are compiled to native-code only. The flag "-native" causes
-dependencies on native compiled files (".cmx") to be generated instead
-of on ".cmo" files. (This flag makes no difference if all source files
-have explicit ".mli" interface files.)
-
-\item["-one-line"]
-Output one line per file, regardless of the length.
-
-\item["-open" \var{module}]
-Assume that module \var{module} is opened before parsing each of the
-following files.
-
-\item["-pp" \var{command}]
-Cause "ocamldep" to call the given \var{command} as a preprocessor
-for each source file.
-
-\item["-ppx" \var{command}]
-Pipe abstract syntax trees through preprocessor \var{command}.
-
-\item["-shared"]
-Generate dependencies for native plugin files (.cmxs) in addition to
-native compiled files (.cmx).
-
-\item["-slash"]
-Under Windows, use a forward slash (/) as the path separator instead
-of the usual backward slash ($\backslash$). Under Unix, this option does
-nothing.
-
-\item["-sort"]
-Sort files according to their dependencies.
-
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-%
-\end{options}
-
-\section{s:ocamldep-makefile}{A typical Makefile}
-
-Here is a template "Makefile" for a OCaml program.
-
-\begin{verbatim}
-OCAMLC=ocamlc
-OCAMLOPT=ocamlopt
-OCAMLDEP=ocamldep
-INCLUDES= # all relevant -I options here
-OCAMLFLAGS=$(INCLUDES) # add other options for ocamlc here
-OCAMLOPTFLAGS=$(INCLUDES) # add other options for ocamlopt here
-
-# prog1 should be compiled to bytecode, and is composed of three
-# units: mod1, mod2 and mod3.
-
-# The list of object files for prog1
-PROG1_OBJS=mod1.cmo mod2.cmo mod3.cmo
-
-prog1: $(PROG1_OBJS)
- $(OCAMLC) -o prog1 $(OCAMLFLAGS) $(PROG1_OBJS)
-
-# prog2 should be compiled to native-code, and is composed of two
-# units: mod4 and mod5.
-
-# The list of object files for prog2
-PROG2_OBJS=mod4.cmx mod5.cmx
-
-prog2: $(PROG2_OBJS)
- $(OCAMLOPT) -o prog2 $(OCAMLFLAGS) $(PROG2_OBJS)
-
-# Common rules
-.SUFFIXES: .ml .mli .cmo .cmi .cmx
-
-.ml.cmo:
- $(OCAMLC) $(OCAMLFLAGS) -c $<
-
-.mli.cmi:
- $(OCAMLC) $(OCAMLFLAGS) -c $<
-
-.ml.cmx:
- $(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
-
-# Clean up
-clean:
- rm -f prog1 prog2
- rm -f *.cm[iox]
-
-# Dependencies
-depend:
- $(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend
-
-include .depend
-\end{verbatim}
-
-If you use module aliases to give shorter names to modules, you need
-to change the above definitions. Assuming that your map file is called
-"mylib.mli", here are minimal modifications.
-\begin{verbatim}
-OCAMLFLAGS=$(INCLUDES) -open Mylib
-
-mylib.cmi: mylib.mli
- $(OCAMLC) $(INCLUDES) -no-alias-deps -w -49 -c $<
-
-depend:
- $(OCAMLDEP) $(INCLUDES) -map mylib.mli $(PROG1_OBJS:.cmo=.ml) > .depend
-\end{verbatim}
-Note that in this case you should not compute dependencies for
-"mylib.mli" together with the other files, hence the need to pass
-explicitly the list of files to process.
-If "mylib.mli" itself has dependencies, you should compute them using
-"-as-map".
+++ /dev/null
-\chapter{The documentation generator (ocamldoc)} \label{c:ocamldoc}
-%HEVEA\cutname{ocamldoc.html}
-
-This chapter describes OCamldoc, a tool that generates documentation from
-special comments embedded in source files. The comments used by OCamldoc
-are of the form "(**"\ldots"*)" and follow the format described
-in section \ref{s:ocamldoc-comments}.
-
-OCamldoc can produce documentation in various formats: HTML, \LaTeX ,
-TeXinfo, Unix man pages, and "dot" dependency graphs. Moreover,
-users can add their own custom generators, as explained in
-section \ref{s:ocamldoc-custom-generators}.
-
-In this chapter, we use the word {\em element} to refer to any of the
-following parts of an OCaml source file: a type declaration, a value,
-a module, an exception, a module type, a type constructor, a record
-field, a class, a class type, a class method, a class value or a class
-inheritance clause.
-
-\section{s:ocamldoc-usage}{Usage}
-
-\subsection{ss:ocamldoc-invocation}{Invocation}
-
-OCamldoc is invoked via the command "ocamldoc", as follows:
-\begin{alltt}
- ocamldoc \var{options} \var{sourcefiles}
-\end{alltt}
-
-\subsubsection*{sss:ocamldoc-output}{Options for choosing the output format}
-
-The following options determine the format for the generated
-documentation.
-
-\begin{options}
-\item["-html"]
-Generate documentation in HTML default format. The generated HTML pages
-are stored in the current directory, or in the directory specified
-with the {\bf\tt -d} option. You can customize the style of the
-generated pages by editing the generated "style.css" file, or by providing
-your own style sheet using option "-css-style".
-The file "style.css" is not generated if it already exists or if -css-style is used.
-
-\item["-latex"]
-Generate documentation in \LaTeX\ default format. The generated
-\LaTeX\ document is saved in file "ocamldoc.out", or in the file
-specified with the {\bf\tt -o} option. The document uses the style file
-"ocamldoc.sty". This file is generated when using the "-latex" option,
-if it does not already exist.
-You can change this file to customize the style of your \LaTeX\ documentation.
-
-\item["-texi"]
-Generate documentation in TeXinfo default format. The generated
-\LaTeX\ document is saved in file "ocamldoc.out", or in the file
-specified with the {\bf\tt -o} option.
-
-\item["-man"]
-Generate documentation as a set of Unix "man" pages. The generated pages
-are stored in the current directory, or in the directory specified
-with the {\bf\tt -d} option.
-
-\item["-dot"]
-Generate a dependency graph for the toplevel modules, in a format suitable
-for displaying and processing by "dot". The "dot" tool is available from
-\url{https://graphviz.org/}.
-The textual representation of the graph is written to the file
-"ocamldoc.out", or to the file specified with the {\bf\tt -o} option.
-Use "dot ocamldoc.out" to display it.
-
-\item["-g" \var{file.cm[o,a,xs]}]
-Dynamically load the given file, which defines a custom documentation
-generator. See section \ref{ss:ocamldoc-compilation-and-usage}. This
-option is supported by the "ocamldoc" command (to load ".cmo" and ".cma" files)
-and by its native-code version "ocamldoc.opt" (to load ".cmxs" files).
-If the given file is a simple one and does not exist in
-the current directory, then ocamldoc looks for it in the custom
-generators default directory, and in the directories specified with
-optional "-i" options.
-
-\item["-customdir"]
-Display the custom generators default directory.
-
-\item["-i" \var{directory}]
-Add the given directory to the path where to look for custom generators.
-
-\end{options}
-
-\subsubsection*{sss:ocamldoc-options}{General options}
-
-\begin{options}
-
-\item["-d" \var{dir}]
-Generate files in directory \var{dir}, rather than the current directory.
-
-\item["-dump" \var{file}]
-Dump collected information into \var{file}. This information can be
-read with the "-load" option in a subsequent invocation of "ocamldoc".
-
-\item["-hide" \var{modules}]
-Hide the given complete module names in the generated documentation.
-\var{modules} is a list of complete module names separated
- by '","', without blanks. For instance: "Stdlib,M2.M3".
-
-\item["-inv-merge-ml-mli"]
-Reverse the precedence of implementations and interfaces when merging.
-All elements
-in implementation files are kept, and the {\bf\tt -m} option
-indicates which parts of the comments in interface files are merged
-with the comments in implementation files.
-
-\item["-keep-code"]
-Always keep the source code for values, methods and instance variables,
-when available.
-
-\item["-load" \var{file}]
-Load information from \var{file}, which has been produced by
-"ocamldoc -dump". Several "-load" options can be given.
-
-\item["-m" \var{flags}]
-Specify merge options between interfaces and implementations.
-(see section \ref{ss:ocamldoc-merge} for details).
-\var{flags} can be one or several of the following characters:
-\begin{options}
- \item["d"] merge description
- \item["a"] merge "\@author"
- \item["v"] merge "\@version"
- \item["l"] merge "\@see"
- \item["s"] merge "\@since"
- \item["b"] merge "\@before"
- \item["o"] merge "\@deprecated"
- \item["p"] merge "\@param"
- \item["e"] merge "\@raise"
- \item["r"] merge "\@return"
- \item["A"] merge everything
-\end{options}
-
-\item["-no-custom-tags"]
-Do not allow custom \@-tags (see section \ref{ss:ocamldoc-tags}).
-
-\item["-no-stop"]
-Keep elements placed after/between the "(**/**)" special comment(s)
-(see section \ref{s:ocamldoc-comments}).
-
-\item["-o" \var{file}]
-Output the generated documentation to \var{file} instead of "ocamldoc.out".
-This option is meaningful only in conjunction with the
-{\bf\tt -latex}, {\bf\tt -texi}, or {\bf\tt -dot} options.
-
-\item["-pp" \var{command}]
-Pipe sources through preprocessor \var{command}.
-
-\item["-impl" \var{filename}]
-Process the file \var{filename} as an implementation file, even if its
-extension is not ".ml".
-
-\item["-intf" \var{filename}]
-Process the file \var{filename} as an interface file, even if its
-extension is not ".mli".
-
-\item["-text" \var{filename}]
-Process the file \var{filename} as a text file, even if its
-extension is not ".txt".
-
-\item["-sort"]
-Sort the list of top-level modules before generating the documentation.
-
-\item["-stars"]
-Remove blank characters until the first asterisk ('"*"') in each
-line of comments.
-
-\item["-t" \var{title}]
-Use \var{title} as the title for the generated documentation.
-
-\item["-intro" \var{file}]
-Use content of \var{file} as ocamldoc text to use as introduction (HTML,
-\LaTeX{} and TeXinfo only).
-For HTML, the file is used to create the whole "index.html" file.
-
-\item["-v"]
-Verbose mode. Display progress information.
-
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-warn-error"]
-Treat Ocamldoc warnings as errors.
-
-\item["-hide-warnings"]
-Do not print OCamldoc warnings.
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-%
-\end{options}
-
-\subsubsection*{sss:ocamldoc-type-checking}{Type-checking options}
-
-OCamldoc calls the OCaml type-checker to obtain type
-information. The following options impact the type-checking phase.
-They have the same meaning as for the "ocamlc" and "ocamlopt" commands.
-
-\begin{options}
-
-\item["-I" \var{directory}]
-Add \var{directory} to the list of directories search for compiled
-interface files (".cmi" files).
-
-\item["-nolabels"]
-Ignore non-optional labels in types.
-
-\item["-rectypes"]
-Allow arbitrary recursive types. (See the "-rectypes" option to "ocamlc".)
-
-\end{options}
-
-\subsubsection*{sss:ocamldoc-html}{Options for generating HTML pages}
-
-The following options apply in conjunction with the "-html" option:
-
-\begin{options}
-\item["-all-params"]
-Display the complete list of parameters for functions and methods.
-
-\item["-charset" \var{charset}]
-Add information about character encoding being \var{charset}
-(default is iso-8859-1).
-
-\item["-colorize-code"]
-Colorize the OCaml code enclosed in "[ ]" and "{[ ]}", using colors
-to emphasize keywords, etc. If the code fragments are not
-syntactically correct, no color is added.
-
-\item["-css-style" \var{filename}]
-Use \var{filename} as the Cascading Style Sheet file.
-
-\item["-index-only"]
-Generate only index files.
-
-\item["-short-functors"]
-Use a short form to display functors:
-\begin{alltt}
-module M : functor (A:Module) -> functor (B:Module2) -> sig .. end
-\end{alltt}
-is displayed as:
-\begin{alltt}
-module M (A:Module) (B:Module2) : sig .. end
-\end{alltt}
-
-\end{options}
-
-\subsubsection*{sss:ocamldoc-latex}{Options for generating \LaTeX\ files}
-
-The following options apply in conjunction with the "-latex" option:
-
-\begin{options}
-\item["-latex-value-prefix" \var{prefix}]
-Give a prefix to use for the labels of the values in the generated
-\LaTeX\ document.
-The default prefix is the empty string. You can also use the options
-{\tt -latex-type-prefix}, {\tt -latex-exception-prefix},
-{\tt -latex-module-prefix},
-{\tt -latex-module-type-prefix}, {\tt -latex-class-prefix},
-{\tt -latex-class-type-prefix},
-{\tt -latex-attribute-prefix} and {\tt -latex-method-prefix}.
-
-These options are useful when you have, for example, a type and a value with
- the same name. If you do not specify prefixes, \LaTeX\ will complain about
-multiply defined labels.
-
-\item["-latextitle" \var{n,style}]
-Associate style number \var{n} to the given \LaTeX\ sectioning command
-\var{style}, e.g. "section" or "subsection". (\LaTeX\ only.) This is
-useful when including the generated document in another \LaTeX\ document,
-at a given sectioning level. The default association is 1 for "section",
-2 for "subsection", 3 for "subsubsection", 4 for "paragraph" and 5 for
-"subparagraph".
-
-\item["-noheader"]
-Suppress header in generated documentation.
-
-\item["-notoc"]
-Do not generate a table of contents.
-
-\item["-notrailer"]
-Suppress trailer in generated documentation.
-
-\item["-sepfiles"]
-Generate one ".tex" file per toplevel module, instead of the global
-"ocamldoc.out" file.
-\end{options}
-
-\subsubsection*{sss:ocamldoc-info}{Options for generating TeXinfo files}
-
-The following options apply in conjunction with the "-texi" option:
-
-\begin{options}
-\item["-esc8"]
-Escape accented characters in Info files.
-
-\item["-info-entry"]
-Specify Info directory entry.
-
-\item["-info-section"]
-Specify section of Info directory.
-
-\item["-noheader"]
-Suppress header in generated documentation.
-
-\item["-noindex"]
-Do not build index for Info files.
-
-\item["-notrailer"]
-Suppress trailer in generated documentation.
-\end{options}
-
-\subsubsection*{sss:ocamldoc-dot}{Options for generating "dot" graphs}
-
-The following options apply in conjunction with the "-dot" option:
-
-\begin{options}
-\item["-dot-colors" \var{colors}]
-Specify the colors to use in the generated "dot" code.
-When generating module dependencies, "ocamldoc" uses different colors
-for modules, depending on the directories in which they reside.
-When generating types dependencies, "ocamldoc" uses different colors
-for types, depending on the modules in which they are defined.
-\var{colors} is a list of color names separated by '","', as
-in "Red,Blue,Green". The available colors are the ones supported by
-the "dot" tool.
-
-\item["-dot-include-all"]
-Include all modules in the "dot" output, not only modules given
-on the command line or loaded with the {\bf\tt -load} option.
-
-\item["-dot-reduce"]
-Perform a transitive reduction of the dependency graph before
-outputting the "dot" code. This can be useful if there are
-a lot of transitive dependencies that clutter the graph.
-
-\item["-dot-types"]
-Output "dot" code describing the type dependency graph instead of
-the module dependency graph.
-\end{options}
-
-\subsubsection*{sss:ocamldoc-man}{Options for generating man files}
-
-The following options apply in conjunction with the "-man" option:
-
-\begin{options}
-\item["-man-mini"]
-Generate man pages only for modules, module types, classes and class
-types, instead of pages for all elements.
-
-\item["-man-suffix" \var{suffix}]
-Set the suffix used for generated man filenames. Default is '"3o"',
-as in "List.3o".
-
-\item["-man-section" \var{section}]
-Set the section number used for generated man filenames. Default is '"3"'.
-
-\end{options}
-
-\subsection{ss:ocamldoc-merge}{Merging of module information}
-
-Information on a module can be extracted either from the ".mli" or ".ml"
-file, or both, depending on the files given on the command line.
-When both ".mli" and ".ml" files are given for the same module,
-information extracted from these files is merged according to the
-following rules:
-\begin{itemize}
-\item Only elements (values, types, classes, ...) declared in the ".mli"
-file are kept. In other terms, definitions from the ".ml" file that are
-not exported in the ".mli" file are not documented.
-\item Descriptions of elements and descriptions in \@-tags are handled
-as follows. If a description for the same element or in the same
-\@-tag of the same element is present in both files, then the
-description of the ".ml" file is concatenated to the one in the ".mli" file,
-if the corresponding "-m" flag is given on the command line.
-If a description is present in the ".ml" file and not in the
-".mli" file, the ".ml" description is kept.
-In either case, all the information given in the ".mli" file is kept.
-\end{itemize}
-
-\subsection{ss:ocamldoc-rules}{Coding rules}
-The following rules must be respected in order to avoid name clashes
-resulting in cross-reference errors:
-\begin{itemize}
-\item In a module, there must not be two modules, two module types or
- a module and a module type with the same name.
- In the default HTML generator, modules "ab" and "AB" will be printed
- to the same file on case insensitive file systems.
-\item In a module, there must not be two classes, two class types or
- a class and a class type with the same name.
-\item In a module, there must not be two values, two types, or two
- exceptions with the same name.
-\item Values defined in tuple, as in "let (x,y,z) = (1,2,3)"
-are not kept by OCamldoc.
-\item Avoid the following construction:
-\begin{caml_eval}
-module Foo = struct module Bar = struct let x = 1 end end;;
-\end{caml_eval}
-\begin{caml_example*}{verbatim}
-open Foo (* which has a module Bar with a value x *)
-module Foo =
- struct
- module Bar =
- struct
- let x = 1
- end
- end
- let dummy = Bar.x
-\end{caml_example*}
-In this case, OCamldoc will associate "Bar.x" to the "x" of module
-"Foo" defined just above, instead of to the "Bar.x" defined in the
-opened module "Foo".
-\end{itemize}
-
-\section{s:ocamldoc-comments}{Syntax of documentation comments}
-
-Comments containing documentation material are called {\em special
-comments} and are written between "(**" and "*)". Special comments
-must start exactly with "(**". Comments beginning with "(" and more
-than two "*" are ignored.
-
-\subsection{ss:ocamldoc-placement}{Placement of documentation comments}
-OCamldoc can associate comments to some elements of the language
-encountered in the source files. The association is made according to
-the locations of comments with respect to the language elements. The
-locations of comments in ".mli" and ".ml" files are different.
-
-%%%%%%%%%%%%%
-\subsubsection{sss:ocamldoc-mli}{Comments in ".mli" files}
-A special comment is associated to an element if it is placed before or
-after the element.\\
-A special comment before an element is associated to this element if~:
-\begin{itemize}
-\item There is no blank line or another special comment between the special
-comment and the element. However, a regular comment can occur between
-the special comment and the element.
-\item The special comment is not already associated to the previous element.
-\item The special comment is not the first one of a toplevel module.
-\end{itemize}
-
-A special comment after an element is associated to this element if
-there is no blank line or comment between the special comment and the
-element.
-
-There are two exceptions: for constructors and record fields in
-type definitions, the associated comment can only be placed after the
-constructor or field definition, without blank lines or other comments
-between them. The special comment for a constructor
-with another constructor following must be placed before the '"|"'
-character separating the two constructors.
-
-The following sample interface file "foo.mli" illustrates the
-placement rules for comments in ".mli" files.
-
-\begin{caml_eval}
-class cl = object end
-\end{caml_eval}
-\begin{caml_example*}{signature}
-(** The first special comment of the file is the comment associated
- with the whole module.*)
-
-
-(** Special comments can be placed between elements and are kept
- by the OCamldoc tool, but are not associated to any element.
- @-tags in these comments are ignored.*)
-
-(*******************************************************************)
-(** Comments like the one above, with more than two asterisks,
- are ignored. *)
-
-(** The comment for function f. *)
-val f : int -> int -> int
-(** The continuation of the comment for function f. *)
-
-(** Comment for exception My_exception, even with a simple comment
- between the special comment and the exception.*)
-(* Hello, I'm a simple comment :-) *)
-exception My_exception of (int -> int) * int
-
-(** Comment for type weather *)
-type weather =
-| Rain of int (** The comment for constructor Rain *)
-| Sun (** The comment for constructor Sun *)
-
-(** Comment for type weather2 *)
-type weather2 =
-| Rain of int (** The comment for constructor Rain *)
-| Sun (** The comment for constructor Sun *)
-(** I can continue the comment for type weather2 here
- because there is already a comment associated to the last constructor.*)
-
-(** The comment for type my_record *)
-type my_record = {
- foo : int ; (** Comment for field foo *)
- bar : string ; (** Comment for field bar *)
- }
- (** Continuation of comment for type my_record *)
-
-(** Comment for foo *)
-val foo : string
-(** This comment is associated to foo and not to bar. *)
-val bar : string
-(** This comment is associated to bar. *)
-
-(** The comment for class my_class *)
-class my_class :
- object
- (** A comment to describe inheritance from cl *)
- inherit cl
-
- (** The comment for attribute tutu *)
- val mutable tutu : string
-
- (** The comment for attribute toto. *)
- val toto : int
-
- (** This comment is not attached to titi since
- there is a blank line before titi, but is kept
- as a comment in the class. *)
-
- val titi : string
-
- (** Comment for method toto *)
- method toto : string
-
- (** Comment for method m *)
- method m : float -> int
- end
-
-(** The comment for the class type my_class_type *)
-class type my_class_type =
- object
- (** The comment for variable x. *)
- val mutable x : int
-
- (** The comment for method m. *)
- method m : int -> int
-end
-
-(** The comment for module Foo *)
-module Foo :
- sig
- (** The comment for x *)
- val x : int
-
- (** A special comment that is kept but not associated to any element *)
- end
-
-(** The comment for module type my_module_type. *)
-module type my_module_type =
- sig
- (** The comment for value x. *)
- val x : int
-
- (** The comment for module M. *)
- module M :
- sig
- (** The comment for value y. *)
- val y : int
-
- (* ... *)
- end
-
- end
-
-\end{caml_example*}
-
-%%%%%%%%%%%%%
-\subsubsection{sss:ocamldoc-comments-ml}{Comments in {\tt .ml} files}
-
-A special comment is associated to an element if it is placed before
-the element and there is no blank line between the comment and the
-element. Meanwhile, there can be a simple comment between the special
-comment and the element. There are two exceptions, for
-constructors and record fields in type definitions, whose associated
-comment must be placed after the constructor or field definition,
-without blank line between them. The special comment for a constructor
-with another constructor following must be placed before the '"|"'
-character separating the two constructors.
-
-The following example of file "toto.ml" shows where to place comments
-in a ".ml" file.
-
-\begin{caml_example*}{verbatim}
-(** The first special comment of the file is the comment associated
- to the whole module. *)
-
-(** The comment for function f *)
-let f x y = x + y
-
-(** This comment is not attached to any element since there is another
- special comment just before the next element. *)
-
-(** Comment for exception My_exception, even with a simple comment
- between the special comment and the exception.*)
-(* A simple comment. *)
-exception My_exception of (int -> int) * int
-
-(** Comment for type weather *)
-type weather =
-| Rain of int (** The comment for constructor Rain *)
-| Sun (** The comment for constructor Sun *)
-
-(** The comment for type my_record *)
-type my_record = {
- foo : int ; (** Comment for field foo *)
- bar : string ; (** Comment for field bar *)
- }
-
-(** The comment for class my_class *)
-class my_class =
- object
- (** A comment to describe inheritance from cl *)
- inherit cl
-
- (** The comment for the instance variable tutu *)
- val mutable tutu = "tutu"
- (** The comment for toto *)
- val toto = 1
- val titi = "titi"
- (** Comment for method toto *)
- method toto = tutu ^ "!"
- (** Comment for method m *)
- method m (f : float) = 1
- end
-
-(** The comment for class type my_class_type *)
-class type my_class_type =
- object
- (** The comment for the instance variable x. *)
- val mutable x : int
- (** The comment for method m. *)
- method m : int -> int
- end
-
-(** The comment for module Foo *)
-module Foo =
- struct
- (** The comment for x *)
- let x = 0
- (** A special comment in the class, but not associated to any element. *)
- end
-
-(** The comment for module type my_module_type. *)
-module type my_module_type =
- sig
- (* Comment for value x. *)
- val x : int
- (* ... *)
- end
-\end{caml_example}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-stop}{The Stop special comment}
-The special comment "(**/**)" tells OCamldoc to discard
-elements placed after this comment, up to the end of the current
-class, class type, module or module type, or up to the next stop comment.
-For instance:
-\begin{caml_example*}{signature}
-class type foo =
- object
- (** comment for method m *)
- method m : string
-
- (**/**)
-
- (** This method won't appear in the documentation *)
- method bar : int
- end
-
-(** This value appears in the documentation, since the Stop special comment
- in the class does not affect the parent module of the class.*)
-val foo : string
-
-(**/**)
-(** The value bar does not appear in the documentation.*)
-val bar : string
-(**/**)
-
-(** The type t appears since in the documentation since the previous stop comment
-toggled off the "no documentation mode". *)
-type t = string
-\end{caml_example*}
-
-The {\bf\tt -no-stop} option to "ocamldoc" causes the Stop special
-comments to be ignored.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-syntax}{Syntax of documentation comments}
-
-The inside of documentation comments "(**"\ldots"*)" consists of
-free-form text with optional formatting annotations, followed by
-optional {\em tags} giving more specific information about parameters,
-version, authors, \ldots\ The tags are distinguished by a leading "\@"
-character. Thus, a documentation comment has the following shape:
-\begin{verbatim}
-(** The comment begins with a description, which is text formatted
- according to the rules described in the next section.
- The description continues until the first non-escaped '@' character.
- @author Mr Smith
- @param x description for parameter x
-*)
-\end{verbatim}
-Some elements support only a subset of all \@-tags. Tags that are not
-relevant to the documented element are simply ignored. For instance,
-all tags are ignored when documenting type constructors, record
-fields, and class inheritance clauses. Similarly, a "\@param" tag on a
-class instance variable is ignored.
-
-At last, "(**)" is the empty documentation comment.
-
-%%%%%%%%%%%%%
-
-% enable section numbering for subsubsections (PR#6189, item 3)
-\setcounter{secnumdepth}{3}
-
-\subsection{ss:ocamldoc-formatting}{Text formatting}
-
-Here is the BNF grammar for the simple markup language used to format
-text descriptions.
-
-\newpage
-
-\begin{syntax}
-text: {{text-element}}
-;
-\end{syntax}
-
-\noindent
-\begin{syntaxleft}
-\nonterm{text-element}\is{}
-\end{syntaxleft}
-
-\begin{tabular}{rlp{10cm}}
-@||@&@ '{' {{ "0" \ldots "9" }} text '}' @ & format @text@ as a section header;
- the integer following "{" indicates the sectioning level. \\
-@||@&@ '{' {{ "0" \ldots "9" }} ':' @ \nt{label} @ text '}' @ &
- same, but also associate the name \nt{label} to the current point.
- This point can be referenced by its fully-qualified label in a
- "{!" command, just like any other element. \\
-@||@&@ '{b' text '}' @ & set @text@ in bold. \\
-@||@&@ '{i' text '}' @ & set @text@ in italic. \\
-@||@&@ '{e' text '}' @ & emphasize @text@. \\
-@||@&@ '{C' text '}' @ & center @text@. \\
-@||@&@ '{L' text '}' @ & left align @text@. \\
-@||@&@ '{R' text '}' @ & right align @text@. \\
-@||@&@ '{ul' list '}' @ & build a list. \\
-@||@&@ '{ol' list '}' @ & build an enumerated list. \\
-@||@&@ '{{:' string '}' text '}' @ & put a link to the given address
-(given as @string@) on the given @text@. \\
-@||@&@ '[' string ']' @ & set the given @string@ in source code style. \\
-@||@&@ '{[' string ']}' @ & set the given @string@ in preformatted
- source code style.\\
-@||@&@ '{v' string 'v}' @ & set the given @string@ in verbatim style. \\
-@||@&@ '{%' string '%}' @ & target-specific content
- (\LaTeX\ code by default, see details
- in \ref{sss:ocamldoc-target-specific-syntax}) \\
-@||@&@ '{!' string '}' @ & insert a cross-reference to an element
- (see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\
-@||@&@ '{!modules:' string string ... '}' @ & insert an index table
-for the given module names. Used in HTML only.\\
-@||@&@ '{!indexlist}' @ & insert a table of links to the various indexes
-(types, values, modules, ...). Used in HTML only.\\
-@||@&@ '{^' text '}' @ & set text in superscript.\\
-@||@&@ '{_' text '}' @ & set text in subscript.\\
-@||@& \nt{escaped-string} & typeset the given string as is;
-special characters ('"{"', '"}"', '"["', '"]"' and '"\@"')
-must be escaped by a '"\\"'\\
-@||@& \nt{blank-line} & force a new line.
-\end{tabular} \\
-
-\subsubsection{sss:ocamldoc-list}{List formatting}
-
-\begin{syntax}
-list:
-| {{ '{-' text '}' }}
-| {{ '{li' text '}' }}
-\end{syntax}
-
-A shortcut syntax exists for lists and enumerated lists:
-\begin{verbatim}
-(** Here is a {b list}
-- item 1
-- item 2
-- item 3
-
-The list is ended by the blank line.*)
-\end{verbatim}
-is equivalent to:
-\begin{verbatim}
-(** Here is a {b list}
-{ul {- item 1}
-{- item 2}
-{- item 3}}
-The list is ended by the blank line.*)
-\end{verbatim}
-
-The same shortcut is available for enumerated lists, using '"+"'
-instead of '"-"'.
-Note that only one list can be defined by this shortcut in nested lists.
-
-\subsubsection{sss:ocamldoc-crossref}{Cross-reference formatting}
-
-Cross-references are fully qualified element names, as in the example
-"{!Foo.Bar.t}". This is an ambiguous reference as it may designate
-a type name, a value name, a class name, etc. It is possible to make
-explicit the intended syntactic class, using "{!type:Foo.Bar.t}" to
-designate a type, and "{!val:Foo.Bar.t}" a value of the same name.
-
-The list of possible syntactic class is as follows:
-\begin{center}
-\begin{tabular}{rl}
-\multicolumn{1}{c}{"tag"} & \multicolumn{1}{c}{syntactic class}\\ \hline
-"module:" & module \\
-"modtype:" & module type \\
-"class:" & class \\
-"classtype:" & class type \\
-"val:" & value \\
-"type:" & type \\
-"exception:" & exception \\
-"attribute:" & attribute \\
-"method:" & class method \\
-"section:" & ocamldoc section \\
-"const:" & variant constructor \\
-"recfield:" & record field
-\end{tabular}
-\end{center}
-
-In the case of variant constructors or record field, the constructor
-or field name should be preceded by the name of the correspond type --
-to avoid the ambiguity of several types having the same constructor
-names. For example, the constructor "Node" of the type "tree" will be
-referenced as "{!tree.Node}" or "{!const:tree.Node}", or possibly
-"{!Mod1.Mod2.tree.Node}" from outside the module.
-
-\subsubsection{sss:ocamldoc-preamble}{First sentence}
-
-In the description of a value, type, exception, module, module type, class
-or class type, the {\em first sentence} is sometimes used in indexes, or
-when just a part of the description is needed. The first sentence
-is composed of the first characters of the description, until
-\begin{itemize}
-\item the first dot followed by a blank, or
-\item the first blank line
-\end{itemize}
-outside of the following text formatting :
-@ '{ul' list '}' @,
-@ '{ol' list '}' @,
-@ '[' string ']' @,
-@ '{[' string ']}' @,
-@ '{v' string 'v}' @,
-@ '{%' string '%}' @,
-@ '{!' string '}' @,
-@ '{^' text '}' @,
-@ '{_' text '}' @.
-
-\subsubsection{sss:ocamldoc-target-specific-syntax}{Target-specific formatting}
-
-The content inside "{%foo: ... %}" is target-specific and will only be
-interpreted by the backend "foo", and ignored by the others. The
-backends of the distribution are "latex", "html", "texi" and "man". If
-no target is specified (syntax "{% ... %}"), "latex" is chosen by
-default. Custom generators may support their own target prefix.
-
-\subsubsection{sss:ocamldoc-html-tags}{Recognized HTML tags}
-The HTML tags "<b>..</b>",
-"<code>..</code>",
-"<i>..</i>",
-"<ul>..</ul>",
-"<ol>..</ol>",
-"<li>..</li>",
-"<center>..</center>" and
-"<h[0-9]>..</h[0-9]>" can be used instead of, respectively,
-@ '{b ..}' @,
-@ '[..]' @,
-@ '{i ..}' @,
-@ '{ul ..}' @,
-@ '{ol ..}' @,
-@ '{li ..}' @,
-@ '{C ..}' @ and
-"{[0-9] ..}".
-
-%disable section numbering for subsubsections
-\setcounter{secnumdepth}{2}
-
-%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-tags}{Documentation tags (\@-tags)}
-
-
-\subsubsection{sss:ocamldoc-builtin-tags}{Predefined tags}
-The following table gives the list of predefined \@-tags, with their
-syntax and meaning.\\
-
-\begin{tabular}{|p{5cm}|p{10cm}|}\hline
-@ "@author" string @ & The author of the element. One author per
-"\@author" tag.
-There may be several "\@author" tags for the same element. \\ \hline
-
-@ "@deprecated" text @ & The @text@ should describe when the element was
-deprecated, what to use as a replacement, and possibly the reason
-for deprecation. \\ \hline
-
-@ "@param" id text @ & Associate the given description (@text@) to the
-given parameter name @id@. This tag is used for functions,
-methods, classes and functors. \\ \hline
-
-@ "@raise" Exc text @ & Explain that the element may raise
- the exception @Exc@. \\ \hline
-
-@ "@return" text @ & Describe the return value and
- its possible values. This tag is used for functions
- and methods. \\ \hline
-
-@ "@see" '<' URL '>' text @ & Add a reference to the @URL@
-with the given @text@ as comment. \\ \hline
-
-@ "@see" "'"@\nt{filename}@"'" text @ & Add a reference to the given file name
-(written between single quotes), with the given @text@ as comment. \\ \hline
-
-@ "@see" '"'@\nt{document-name}@'"' text @ & Add a reference to the given
-document name (written between double quotes), with the given @text@
-as comment. \\ \hline
-
-@ "@since" string @ & Indicate when the element was introduced. \\ \hline
-
-@ "@before" @ \nt{version} @ text @ & Associate the given description (@text@)
-to the given \nt{version} in order to document compatibility issues. \\ \hline
-
-@ "@version" string @ & The version number for the element. \\ \hline
-\end{tabular}
-
-\subsubsection{sss:ocamldoc-custom-tags}{Custom tags}
-You can use custom tags in the documentation comments, but they will
-have no effect if the generator used does not handle them. To use a
-custom tag, for example "foo", just put "\@foo" with some text in your
-comment, as in:
-\begin{verbatim}
-(** My comment to show you a custom tag.
-@foo this is the text argument to the [foo] custom tag.
-*)
-\end{verbatim}
-
-To handle custom tags, you need to define a custom generator,
-as explained in section \ref{ss:ocamldoc-handling-custom-tags}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{s:ocamldoc-custom-generators}{Custom generators}
-
-OCamldoc operates in two steps:
-\begin{enumerate}
-\item analysis of the source files;
-\item generation of documentation, through a documentation generator,
- which is an object of class "Odoc_args.class_generator".
-\end{enumerate}
-Users can provide their own documentation generator to be used during
-step 2 instead of the default generators.
-All the information retrieved during the analysis step is available through
-the "Odoc_info" module, which gives access to all the types and functions
- representing the elements found in the given modules, with their associated
-description.
-
-The files you can use to define custom generators are installed in the
-"ocamldoc" sub-directory of the OCaml standard library.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-generators}{The generator modules}
-The type of a generator module depends on the kind of generated documentation.
-Here is the list of generator module types, with the name of the generator
-class in the module~:
-\begin{itemize}
-\item for HTML~: "Odoc_html.Html_generator" (class "html"),
-\item for \LaTeX~: "Odoc_latex.Latex_generator" (class "latex"),
-\item for TeXinfo~: "Odoc_texi.Texi_generator" (class "texi"),
-\item for man pages~: "Odoc_man.Man_generator" (class "man"),
-\item for graphviz (dot)~: "Odoc_dot.Dot_generator" (class "dot"),
-\item for other kinds~: "Odoc_gen.Base" (class "generator").
-\end{itemize}
-That is, to define a new generator, one must implement a module with
-the expected signature, and with the given generator class, providing
-the "generate" method as entry point to make the generator generates
-documentation for a given list of modules~:
-
-\begin{verbatim}
- method generate : Odoc_info.Module.t_module list -> unit
-\end{verbatim}
-
-\noindent{}This method will be called with the list of analysed and possibly
-merged "Odoc_info.t_module" structures.
-
-It is recommended to inherit from the current generator of the same
-kind as the one you want to define. Doing so, it is possible to
-load various custom generators to combine improvements brought by each one.
-
-This is done using first class modules (see chapter \ref{s:first-class-modules}).
-
-The easiest way to define a custom generator is the following this example,
-here extending the current HTML generator. We don't have to know if this is
-the original HTML generator defined in ocamldoc or if it has been extended
-already by a previously loaded custom generator~:
-
-\begin{verbatim}
-module Generator (G : Odoc_html.Html_generator) =
-struct
- class html =
- object(self)
- inherit G.html as html
- (* ... *)
-
- method generate module_list =
- (* ... *)
- ()
-
- (* ... *)
- end
-end;;
-
-let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
-\end{verbatim}
-
-To know which methods to override and/or which methods are available,
-have a look at the different base implementations, depending on the
-kind of generator you are extending~:
-\newcommand\ocamldocsrc[2]{\href{https://github.com/ocaml/ocaml/blob/{\ocamlversion}/ocamldoc/odoc_#1.ml}{#2}}
-\begin{itemize}
-\item for HTML~: \ocamldocsrc{html}{"odoc_html.ml"},
-\item for \LaTeX~: \ocamldocsrc{latex}{"odoc_latex.ml"},
-\item for TeXinfo~: \ocamldocsrc{texi}{"odoc_texi.ml"},
-\item for man pages~: \ocamldocsrc{man}{"odoc_man.ml"},
-\item for graphviz (dot)~: \ocamldocsrc{dot}{"odoc_dot.ml"}.
-\end{itemize}
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-handling-custom-tags}{Handling custom tags}
-
-Making a custom generator handle custom tags (see
-\ref{sss:ocamldoc-custom-tags}) is very simple.
-
-\subsubsection*{sss:ocamldoc-html-generator}{For HTML}
-Here is how to develop a HTML generator handling your custom tags.
-
-The class "Odoc_html.Generator.html" inherits
-from the class "Odoc_html.info", containing a field "tag_functions" which is a
-list pairs composed of a custom tag (e.g. "\"foo\"") and a function taking
-a "text" and returning HTML code (of type "string").
-To handle a new tag "bar", extend the current HTML generator
- and complete the "tag_functions" field:
-\begin{verbatim}
-module Generator (G : Odoc_html.Html_generator) =
-struct
- class html =
- object(self)
- inherit G.html
-
- (** Return HTML code for the given text of a bar tag. *)
- method html_of_bar t = (* your code here *)
-
- initializer
- tag_functions <- ("bar", self#html_of_bar) :: tag_functions
- end
-end
-let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
-\end{verbatim}
-
-Another method of the class "Odoc_html.info" will look for the
-function associated to a custom tag and apply it to the text given to
-the tag. If no function is associated to a custom tag, then the method
-prints a warning message on "stderr".
-
-\subsubsection{sss:ocamldoc-other-generators}{For other generators}
-You can act the same way for other kinds of generators.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{s:ocamldoc-adding-flags}{Adding command line options}
-The command line analysis is performed after loading the module containing the
-documentation generator, thus allowing command line options to be added to the
- list of existing ones. Adding an option can be done with the function
-\begin{verbatim}
- Odoc_args.add_option : string * Arg.spec * string -> unit
-\end{verbatim}
-\noindent{}Note: Existing command line options can be redefined using
-this function.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%
-\subsection{ss:ocamldoc-compilation-and-usage}{Compilation and usage}
-
-%%%%%%%%%%%%%%
-\subsubsection{sss:ocamldoc-generator-class}{Defining a custom generator class in one file}
-Let "custom.ml" be the file defining a new generator class.
-Compilation of "custom.ml" can be performed by the following command~:
-\begin{alltt}
- ocamlc -I +ocamldoc -c custom.ml
-\end{alltt}
-\noindent{}The file "custom.cmo" is created and can be used this way~:
-\begin{alltt}
- ocamldoc -g custom.cmo \var{other-options} \var{source-files}
-\end{alltt}
-\noindent{}Options selecting a built-in generator to "ocamldoc", such as
-"-html", have no effect if a custom generator of the same kind is provided using
-"-g". If the kinds do not match, the selected built-in generator is used and the
-custom one is ignored.
-
-%%%%%%%%%%%%%%
-\subsubsection{sss:ocamldoc-modular-generator}{Defining a custom generator class in several files}
-It is possible to define a generator class in several modules, which
-are defined in several files \var{\nth{file}{1}}".ml"["i"],
-\var{\nth{file}{2}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]. A ".cma"
-library file must be created, including all these files.
-
-The following commands create the "custom.cma" file from files
-\var{\nth{file}{1}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]~:
-\begin{alltt}
-ocamlc -I +ocamldoc -c \var{\nth{file}{1}}.ml\textrm{[}i\textrm{]}
-ocamlc -I +ocamldoc -c \var{\nth{file}{2}}.ml\textrm{[}i\textrm{]}
-...
-ocamlc -I +ocamldoc -c \var{\nth{file}{n}}.ml\textrm{[}i\textrm{]}
-ocamlc -o custom.cma -a \var{\nth{file}{1}}.cmo \var{\nth{file}{2}}.cmo ... \var{\nth{file}{n}}.cmo
-\end{alltt}
-\noindent{}Then, the following command uses "custom.cma" as custom generator:
-\begin{alltt}
- ocamldoc -g custom.cma \var{other-options} \var{source-files}
-\end{alltt}
+++ /dev/null
-\chapter{Profiling (ocamlprof)} \label{c:profiler}
-%HEVEA\cutname{profil.html}
-
-This chapter describes how the execution of OCaml
-programs can be profiled, by recording how many times functions are
-called, branches of conditionals are taken, \ldots
-
-\section{s:ocamlprof-compiling}{Compiling for profiling}
-
-Before profiling an execution, the program must be compiled in
-profiling mode, using the "ocamlcp" front-end to the "ocamlc" compiler
-(see chapter~\ref{c:camlc}) or the "ocamloptp" front-end to the
-"ocamlopt" compiler (see chapter~\ref{c:nativecomp}). When compiling
-modules separately, "ocamlcp" or "ocamloptp" must be used when
-compiling the modules (production of ".cmo" or ".cmx" files), and can
-also be used (though this is not strictly necessary) when linking them
-together.
-
-\lparagraph{p:ocamlprof-warning}{Note} If a module (".ml" file) doesn't have a corresponding
-interface (".mli" file), then compiling it with "ocamlcp" will produce
-object files (".cmi" and ".cmo") that are not compatible with the ones
-produced by "ocamlc", which may lead to problems (if the ".cmi" or
-".cmo" is still around) when switching between profiling and
-non-profiling compilations. To avoid this problem, you should always
-have a ".mli" file for each ".ml" file. The same problem exists with
-"ocamloptp".
-
-\lparagraph{p:ocamlprof-reserved}{Note} To make sure your programs can be compiled in
-profiling mode, avoid using any identifier that begins with
-"__ocaml_prof".
-
-The amount of profiling information can be controlled through the "-P"
-option to "ocamlcp" or "ocamloptp", followed by one or several letters
-indicating which parts of the program should be profiled:
-
-%% description des options
-\begin{options}
-\item["a"] all options
-\item["f"] function calls : a count point is set at the beginning of
-each function body
-\item["i"] {\bf if \ldots then \ldots else \ldots} : count points are set in
-both {\bf then} branch and {\bf else} branch
-\item["l"] {\bf while, for} loops: a count point is set at the beginning of
-the loop body
-\item["m"] {\bf match} branches: a count point is set at the beginning of the
-body of each branch
-\item["t"] {\bf try \ldots with \ldots} branches: a count point is set at the
-beginning of the body of each branch
-\end{options}
-
-For instance, compiling with "ocamlcp -P film" profiles function calls,
-if\ldots then\ldots else\ldots, loops and pattern matching.
-
-Calling "ocamlcp" or "ocamloptp" without the "-P" option defaults to
-"-P fm", meaning that only function calls and pattern matching are
-profiled.
-
-\paragraph{Note} For compatibility with previous releases, "ocamlcp"
-also accepts the "-p" option, with the same arguments and behaviour as
-"-P".
-
-The "ocamlcp" and "ocamloptp" commands also accept all the options of
-the corresponding "ocamlc" or "ocamlopt" compiler, except the "-pp"
-(preprocessing) option.
-
-
-\section{s:ocamlprof-profiling}{Profiling an execution}
-
-Running an executable that has been compiled with "ocamlcp" or
-"ocamloptp" records the execution counts for the specified parts of
-the program and saves them in a file called "ocamlprof.dump" in the
-current directory.
-
-If the environment variable "OCAMLPROF_DUMP" is set when the program
-exits, its value is used as the file name instead of "ocamlprof.dump".
-
-The dump file is written only if the program terminates
-normally (by calling "exit" or by falling through). It is not written
-if the program terminates with an uncaught exception.
-
-If a compatible dump file already exists in the current directory, then the
-profiling information is accumulated in this dump file. This allows, for
-instance, the profiling of several executions of a program on
-different inputs. Note that dump files produced by byte-code
-executables (compiled with "ocamlcp") are compatible with the dump
-files produced by native executables (compiled with "ocamloptp").
-
-\section{s:ocamlprof-printing}{Printing profiling information}
-
-The "ocamlprof" command produces a source listing of the program modules
-where execution counts have been inserted as comments. For instance,
-\begin{verbatim}
- ocamlprof foo.ml
-\end{verbatim}
-prints the source code for the "foo" module, with comments indicating
-how many times the functions in this module have been called. Naturally,
-this information is accurate only if the source file has not been modified
-after it was compiled.
-
-The following options are recognized by "ocamlprof":
-
-\begin{options}
-
-\item["-args" \var{filename}]
- Read additional newline-terminated command line arguments from \var{filename}.
-
-\item["-args0" \var{filename}]
- Read additional null character terminated command line arguments from \var{filename}.
-
-\item["-f" \var{dumpfile}]
-Specifies an alternate dump file of profiling information to be read.
-
-\item["-F" \var{string}]
-Specifies an additional string to be output with profiling information.
-By default, "ocamlprof" will annotate programs with comments of the form
-{\tt (* \var{n} *)} where \var{n} is the counter value for a profiling
-point. With option {\tt -F \var{s}}, the annotation will be
-{\tt (* \var{s}\var{n} *)}.
-
-\item["-impl" \var{filename}]
-Process the file \var{filename} as an implementation file, even if its
-extension is not ".ml".
-
-\item["-intf" \var{filename}]
-Process the file \var{filename} as an interface file, even if its
-extension is not ".mli".
-
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-%
-\end{options}
-
-\section{s:ocamlprof-time-profiling}{Time profiling}
-
-Profiling with "ocamlprof" only records execution counts, not the actual
-time spent within each function. There is currently no way to perform
-time profiling on bytecode programs generated by "ocamlc". For time
-profiling of native code, users are recommended to use standard tools
-such as perf (on Linux), Instruments (on macOS) and DTrace. Profiling
-with "gprof" is no longer supported.
+++ /dev/null
-\chapter{The runtime system (ocamlrun)} \label{c:runtime}
-%HEVEA\cutname{runtime.html}
-
-The "ocamlrun" command executes bytecode files produced by the
-linking phase of the "ocamlc" command.
-
-\section{s:ocamlrun-overview}{Overview}
-
-The "ocamlrun" command comprises three main parts: the bytecode
-interpreter, that actually executes bytecode files; the memory
-allocator and garbage collector; and a set of C functions that
-implement primitive operations such as input/output.
-
-The usage for "ocamlrun" is:
-\begin{alltt}
- ocamlrun \var{options} \var{bytecode-executable} \nth{arg}{1} ... \nth{arg}{n}
-\end{alltt}
-The first non-option argument is taken to be the name of the file
-containing the executable bytecode. (That file is searched in the
-executable path as well as in the current directory.) The remaining
-arguments are passed to the OCaml program, in the string array
-"Sys.argv". Element 0 of this array is the name of the
-bytecode executable file; elements 1 to \var{n} are the remaining
-arguments \nth{arg}{1} to \nth{arg}{n}.
-
-As mentioned in chapter~\ref{c:camlc}, the bytecode executable files
-produced by the "ocamlc" command are self-executable, and manage to
-launch the "ocamlrun" command on themselves automatically. That is,
-assuming "a.out" is a bytecode executable file,
-\begin{alltt}
- a.out \nth{arg}{1} ... \nth{arg}{n}
-\end{alltt}
-works exactly as
-\begin{alltt}
- ocamlrun a.out \nth{arg}{1} ... \nth{arg}{n}
-\end{alltt}
-Notice that it is not possible to pass options to "ocamlrun" when
-invoking "a.out" directly.
-
-\begin{windows}
-Under several versions of Windows, bytecode executable files are
-self-executable only if their name ends in ".exe". It is recommended
-to always give ".exe" names to bytecode executables, e.g. compile
-with "ocamlc -o myprog.exe ..." rather than "ocamlc -o myprog ...".
-\end{windows}
-
-\section{s:ocamlrun-options}{Options}
-The following command-line options are recognized by "ocamlrun".
-
-\begin{options}
-
-\item["-b"]
-When the program aborts due to an uncaught exception, print a detailed
-``back trace'' of the execution, showing where the exception was
-raised and which function calls were outstanding at this point. The
-back trace is printed only if the bytecode executable contains
-debugging information, i.e. was compiled and linked with the "-g"
-option to "ocamlc" set. This is equivalent to setting the "b" flag
-in the "OCAMLRUNPARAM" environment variable (see below).
-\item["-I" \var{dir}]
-Search the directory \var{dir} for dynamically-loaded libraries,
-in addition to the standard search path (see
-section~\ref{s:ocamlrun-dllpath}).
-\item["-m"]
-Print the magic number of the bytecode executable given as argument
-and exit.
-\item["-M"]
-Print the magic number expected by this version of the runtime and exit.
-\item["-p"]
-Print the names of the primitives known to this version of
-"ocamlrun" and exit.
-\item["-v"]
-Direct the memory manager to print some progress messages on
-standard error. This is equivalent to setting "v=63" in the
-"OCAMLRUNPARAM" environment variable (see below).
-\item["-version"]
-Print version string and exit.
-\item["-vnum"]
-Print short version number and exit.
-
-\end{options}
-
-\noindent
-The following environment variables are also consulted:
-
-\begin{options}
-\item["CAML_LD_LIBRARY_PATH"] Additional directories to search for
- dynamically-loaded libraries (see section~\ref{s:ocamlrun-dllpath}).
-
-\item["OCAMLLIB"] The directory containing the OCaml standard
- library. (If "OCAMLLIB" is not set, "CAMLLIB" will be used instead.)
- Used to locate the "ld.conf" configuration file for
- dynamic loading (see section~\ref{s:ocamlrun-dllpath}). If not set,
- default to the library directory specified when compiling OCaml.
-
-\item["OCAMLRUNPARAM"] Set the runtime system options
- and garbage collection parameters.
- (If "OCAMLRUNPARAM" is not set, "CAMLRUNPARAM" will be used instead.)
- This variable must be a sequence of parameter specifications separated
- by commas.
- For convenience, commas at the beginning of the variable are ignored,
- and multiple runs of commas are interpreted as a single one.
- A parameter specification is an option letter followed by an "="
- sign, a decimal number (or an hexadecimal number prefixed by "0x"),
- and an optional multiplier. The options are documented below;
- the last six correspond to the fields of the
- "control" record documented in
-\ifouthtml
- \ahref{libref/Gc.html}{Module \texttt{Gc}}.
-\else
- section~\ref{Gc}.
-\fi
- \begin{options}
- \item[b] (backtrace) Trigger the printing of a stack backtrace
- when an uncaught exception aborts the program. An optional argument can
- be provided: "b=0" turns backtrace printing off; "b=1" is equivalent to
- "b" and turns backtrace printing on; "b=2" turns backtrace printing on
- and forces the runtime system to load debugging information at program
- startup time instead of at backtrace printing time. "b=2" can be used if
- the runtime is unable to load debugging information at backtrace
- printing time, for example if there are no file descriptors available.
- \item[p] (parser trace) Turn on debugging support for
- "ocamlyacc"-generated parsers. When this option is on,
- the pushdown automaton that executes the parsers prints a
- trace of its actions. This option takes no argument.
- \item[R] (randomize) Turn on randomization of all hash tables by default
- (see
-\ifouthtml
- \ahref{libref/Hashtbl.html}{Module \texttt{Hashtbl}}).
-\else
- section~\ref{Hashtbl}).
-\fi
- This option takes no argument.
- \item[h] The initial size of the major heap (in words).
- \item[a] ("allocation_policy")
- The policy used for allocating in the OCaml heap. Possible values
- are "0" for the next-fit policy, "1" for the first-fit
- policy, and "2" for the best-fit policy. Best-fit is still experimental,
- but probably the best of the three. The default is "0" (next-fit).
- See the Gc module documentation for details.
- \item[s] ("minor_heap_size") Size of the minor heap. (in words)
- \item[i] ("major_heap_increment") Default size increment for the
- major heap. (in words)
- \item[o] ("space_overhead") The major GC speed setting.
- See the Gc module documentation for details.
- \item[O] ("max_overhead") The heap compaction trigger setting.
- \item[l] ("stack_limit") The limit (in words) of the stack size. This is only
- relevant to the byte-code runtime, as the native code runtime uses the
- operating system's stack.
- \item[v] ("verbose") What GC messages to print to stderr. This
- is a sum of values selected from the following:
- \begin{options}
- \item[1 (= 0x001)] Start and end of major GC cycle.
- \item[2 (= 0x002)] Minor collection and major GC slice.
- \item[4 (= 0x004)] Growing and shrinking of the heap.
- \item[8 (= 0x008)] Resizing of stacks and memory manager tables.
- \item[16 (= 0x010)] Heap compaction.
- \item[32 (= 0x020)] Change of GC parameters.
- \item[64 (= 0x040)] Computation of major GC slice size.
- \item[128 (= 0x080)] Calling of finalization functions
- \item[256 (= 0x100)] Startup messages (loading the bytecode
- executable file, resolving shared libraries).
- \item[512 (= 0x200)] Computation of compaction-triggering condition.
- \item[1024 (= 0x400)] Output GC statistics at program exit.
- \end{options}
- \item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see
- "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables
- pooling (as in "caml_startup_pooled"). This mode can be used to detect
- leaks with a third-party memory debugger.
- % FIXME missing: H, t, w, W see MPR#7870
- \item[M] ("custom_major_ratio") Target ratio of floating garbage to
- major heap size for out-of-heap memory held by custom values
- (e.g. bigarrays) located in the major heap. The GC speed is adjusted
- to try to use this much memory for dead values that are not yet
- collected. Expressed as a percentage of major heap size. Default:
- 44. Note: this only applies to values allocated with
- "caml_alloc_custom_mem".
- \item[m] ("custom_minor_ratio") Bound on floating garbage for
- out-of-heap memory
- held by custom values in the minor heap. A minor GC is triggered
- when this much memory is held by custom values located in the minor
- heap. Expressed as a percentage of minor heap size. Default:
- 100. Note: this only applies to values allocated with
- "caml_alloc_custom_mem".
- \item[n] ("custom_minor_max_size") Maximum amount of out-of-heap
- memory for each custom value allocated in the minor heap. When a custom
- value is allocated on the minor heap and holds more than this many
- bytes, only this value is counted against "custom_minor_ratio" and
- the rest is directly counted against "custom_major_ratio".
- Default: 8192 bytes. Note:
- this only applies to values allocated with "caml_alloc_custom_mem".
- \end{options}
- The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
- $2^{20}$, and $2^{30}$ respectively.
-
- If the option letter is not recognized, the whole parameter is ignored;
- if the equal sign or the number is missing, the value is taken as 1;
- if the multiplier is not recognized, it is ignored.
-
- For example, on a 32-bit machine, under "bash" the command
-\begin{verbatim}
- export OCAMLRUNPARAM='b,s=256k,v=0x015'
-\end{verbatim}
- tells a subsequent "ocamlrun" to print backtraces for uncaught exceptions,
- set its initial minor heap size to 1~megabyte and
- print a message at the start of each major GC cycle, when the heap
- size changes, and when compaction is triggered.
-
-\item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the
- environment, then "CAMLRUNPARAM" will be used instead. If
- "CAMLRUNPARAM" is also not found, then the default values will be used.
-
-\item["PATH"] List of directories searched to find the bytecode
-executable file.
-\end{options}
-
-\section{s:ocamlrun-dllpath}{Dynamic loading of shared libraries}
-
-On platforms that support dynamic loading, "ocamlrun" can link
-dynamically with C shared libraries (DLLs) providing additional C primitives
-beyond those provided by the standard runtime system. The names for
-these libraries are provided at link time as described in
-section~\ref{ss:dynlink-c-code}), and recorded in the bytecode executable
-file; "ocamlrun", then, locates these libraries and resolves references
-to their primitives when the bytecode executable program starts.
-
-The "ocamlrun" command searches shared libraries in the following
-directories, in the order indicated:
-\begin{enumerate}
-\item Directories specified on the "ocamlrun" command line with the
-"-I" option.
-\item Directories specified in the "CAML_LD_LIBRARY_PATH" environment
-variable.
-\item Directories specified at link-time via the "-dllpath" option to
-"ocamlc". (These directories are recorded in the bytecode executable
-file.)
-\item Directories specified in the file "ld.conf". This file resides
-in the OCaml standard library directory, and lists directory
-names (one per line) to be searched. Typically, it contains only one
-line naming the "stublibs" subdirectory of the OCaml standard
-library directory. Users can add there the names of other directories
-containing frequently-used shared libraries; however, for consistency
-of installation, we recommend that shared libraries are installed
-directly in the system "stublibs" directory, rather than adding lines
-to the "ld.conf" file.
-\item Default directories searched by the system dynamic loader.
-Under Unix, these generally include "/lib" and "/usr/lib", plus the
-directories listed in the file "/etc/ld.so.conf" and the environment
-variable "LD_LIBRARY_PATH". Under Windows, these include the Windows
-system directories, plus the directories listed in the "PATH"
-environment variable.
-\end{enumerate}
-
-\section{s:ocamlrun-common-errors}{Common errors}
-
-This section describes and explains the most frequently encountered
-error messages.
-
-\begin{options}
-
-\item[{\it filename}": no such file or directory"]
-If {\it filename} is the name of a self-executable bytecode file, this
-means that either that file does not exist, or that it failed to run
-the "ocamlrun" bytecode interpreter on itself. The second possibility
-indicates that OCaml has not been properly installed on your
-system.
-
-\item["Cannot exec ocamlrun"]
-(When launching a self-executable bytecode file.) The "ocamlrun"
- could not be found in the executable path. Check that OCaml
- has been properly installed on your system.
-
-\item["Cannot find the bytecode file"]
-The file that "ocamlrun" is trying to execute (e.g. the file given as
-first non-option argument to "ocamlrun") either does not exist, or is
-not a valid executable bytecode file.
-
-\item["Truncated bytecode file"]
-The file that "ocamlrun" is trying to execute is not a valid executable
-bytecode file. Probably it has been truncated or mangled since
-created. Erase and rebuild it.
-
-\item["Uncaught exception"]
-The program being executed contains a ``stray'' exception. That is,
-it raises an exception at some point, and this exception is never
-caught. This causes immediate termination of the program. The name of
-the exception is printed, along with its string, byte sequence, and
-integer arguments
-(arguments of more complex types are not correctly printed).
-To locate the context of the uncaught exception, compile the program
-with the "-g" option and either run it again under the "ocamldebug"
-debugger (see chapter~\ref{c:debugger}), or run it with "ocamlrun -b"
-or with the "OCAMLRUNPARAM" environment variable set to "b=1".
-
-\item["Out of memory"]
-The program being executed requires more memory than available. Either
-the program builds excessively large data structures; or the program
-contains too many nested function calls, and the stack overflows. In
-some cases, your program is perfectly correct, it just requires more
-memory than your machine provides. In other cases, the ``out of
-memory'' message reveals an error in your program: non-terminating
-recursive function, allocation of an excessively large array,
-string or byte sequence, attempts to build an infinite list or other
-data structure, \ldots
-
-To help you diagnose this error, run your program with the "-v" option
-to "ocamlrun", or with the "OCAMLRUNPARAM" environment variable set to
-"v=63". If it displays lots of ``"Growing stack"\ldots''
-messages, this is probably a looping recursive function. If it
-displays lots of ``"Growing heap"\ldots'' messages, with the heap size
-growing slowly, this is probably an attempt to construct a data
-structure with too many (infinitely many?) cells. If it displays few
-``"Growing heap"\ldots'' messages, but with a huge increment in the
-heap size, this is probably an attempt to build an excessively large
-array, string or byte sequence.
-
-\end{options}
+++ /dev/null
-\chapter{The toplevel system or REPL (ocaml)} \label{c:camllight}
-%HEVEA\cutname{toplevel.html}
-
-This chapter describes the toplevel system for OCaml, that permits
-interactive use of the OCaml system
-through a read-eval-print loop (REPL). In this mode, the system repeatedly
-reads OCaml phrases from the input, then typechecks, compile and
-evaluate them, then prints the inferred type and result value, if
-any. The system prints a "#" (sharp) prompt before reading each
-phrase.
-
-Input to the toplevel can span several lines. It is terminated by @";;"@ (a
-double-semicolon). The toplevel input consists in one or several
-toplevel phrases, with the following syntax:
-
-\begin{syntax}
-toplevel-input:
- {{ definition }} ';;'
- | expr ';;'
- | '#' ident [ directive-argument ] ';;'
-;
-directive-argument:
- string-literal
- | integer-literal
- | value-path
- | 'true' || 'false'
-\end{syntax}
-
-A phrase can consist of a definition, like those found in
-implementations of compilation units or in @'struct' \ldots 'end'@
-module expressions. The definition can bind value names, type names,
-an exception, a module name, or a module type name. The toplevel
-system performs the bindings, then prints the types and values (if
-any) for the names thus defined.
-
-A phrase may also consist in a value expression
-(section~\ref{s:value-expr}). It is simply evaluated
-without performing any bindings, and its value is
-printed.
-
-Finally, a phrase can also consist in a toplevel directive,
-starting with @"#"@ (the sharp sign). These directives control the
-behavior of the toplevel; they are listed below in
-section~\ref{s:toplevel-directives}.
-
-\begin{unix}
-The toplevel system is started by the command "ocaml", as follows:
-\begin{alltt}
- ocaml \var{options} \var{objects} # interactive mode
- ocaml \var{options} \var{objects} \var{scriptfile} # script mode
-\end{alltt}
-\var{options} are described below.
-\var{objects} are filenames ending in ".cmo" or ".cma"; they are
-loaded into the interpreter immediately after \var{options} are set.
-\var{scriptfile} is any file name not ending in ".cmo" or ".cma".
-
-If no \var{scriptfile} is given on the command line, the toplevel system
-enters interactive mode: phrases are read on standard input, results
-are printed on standard output, errors on standard error. End-of-file
-on standard input terminates "ocaml" (see also the "#quit" directive
-in section~\ref{s:toplevel-directives}).
-
-On start-up (before the first phrase is read), if the file
-".ocamlinit" exists in the current directory,
-its contents are read as a sequence of OCaml phrases
-and executed as per the "#use" directive
-described in section~\ref{s:toplevel-directives}.
-The evaluation outcode for each phrase are not displayed.
-If the current directory does not contain an ".ocamlinit" file,
-the file "XDG_CONFIG_HOME/ocaml/init.ml" is looked up according
-to the XDG base directory specification and used instead (on Windows
-this is skipped). If that file doesn't exist then an [.ocamlinit] file
-in the users' home directory (determined via environment variable "HOME") is
-used if existing.
-
-The toplevel system does not perform line editing, but it can
-easily be used in conjunction with an external line editor such as
-"ledit", or "rlwrap". An improved toplevel, "utop", is also available.
-Another option is to use "ocaml" under Gnu Emacs, which gives the
-full editing power of Emacs (command "run-caml" from library "inf-caml").
-
-At any point, the parsing, compilation or evaluation of the current
-phrase can be interrupted by pressing "ctrl-C" (or, more precisely,
-by sending the "INTR" signal to the "ocaml" process). The toplevel
-then immediately returns to the "#" prompt.
-
-If \var{scriptfile} is given on the command-line to "ocaml", the toplevel
-system enters script mode: the contents of the file are read as a
-sequence of OCaml phrases and executed, as per the "#use"
-directive (section~\ref{s:toplevel-directives}). The outcome of the
-evaluation is not printed. On reaching the end of file, the "ocaml"
-command exits immediately. No commands are read from standard input.
-"Sys.argv" is transformed, ignoring all OCaml parameters, and
-starting with the script file name in "Sys.argv.(0)".
-
-In script mode, the first line of the script is ignored if it starts
-with "#!". Thus, it should be possible to make the script
-itself executable and put as first line "#!/usr/local/bin/ocaml",
-thus calling the toplevel system automatically when the script is
-run. However, "ocaml" itself is a "#!" script on most installations
-of OCaml, and Unix kernels usually do not handle nested "#!"
-scripts. A better solution is to put the following as the first line
-of the script:
-\begin{verbatim}
- #!/usr/local/bin/ocamlrun /usr/local/bin/ocaml
-\end{verbatim}
-
-\end{unix}
-
-\section{s:toplevel-options}{Options}
-
-The following command-line options are recognized by the "ocaml" command.
-% Configure boolean variables used by the macros in unified-options.etex
-\compfalse
-\natfalse
-\toptrue
-% unified-options gathers all options across the native/bytecode
-% compilers and toplevel
-\input{unified-options.tex}
-
-\begin{unix}
-The following environment variables are also consulted:
-\begin{options}
-\item["OCAMLTOP_INCLUDE_PATH"] Additional directories to search for compiled
- object code files (".cmi", ".cmo" and ".cma"). The specified directories are
- considered from left to right, after the include directories specified on the
- command line via "-I" have been searched. Available since OCaml 4.08.
-
-\item["OCAMLTOP_UTF_8"] When printing string values, non-ascii bytes
-($ {} > "\0x7E" $) are printed as decimal escape sequence if "OCAMLTOP_UTF_8" is
-set to false. Otherwise, they are printed unescaped.
-
-\item["TERM"] When printing error messages, the toplevel system
-attempts to underline visually the location of the error. It
-consults the "TERM" variable to determines the type of output terminal
-and look up its capabilities in the terminal database.
-
-\item["XDG_CONFIG_HOME", "HOME"]
-".ocamlinit" lookup procedure (see above).
-\end{options}
-\end{unix}
-
-\section{s:toplevel-directives}{Toplevel directives}
-
-The following directives control the toplevel behavior, load files in
-memory, and trace program execution.
-
-{\bf Note:} all directives start with a "#" (sharp) symbol. This "#"
-must be typed before the directive, and must not be confused with the
-"#" prompt displayed by the interactive loop. For instance,
-typing "#quit;;" will exit the toplevel loop, but typing "quit;;"
-will result in an ``unbound value "quit"'' error.
-
-%
-% Remark: this list of options should be kept synchronized with the documentation
-% in toplevel/topdirs.ml.
-%
-\begin{options}
-\item[General]
- \begin{options}
- \item["#help;;"]
- Prints a list of all available directives, with corresponding argument type
- if appropriate.
- \item["#quit;;"]
- Exit the toplevel loop and terminate the "ocaml" command.
- \end{options}
-
-\item[Loading codes]
- \begin{options}
-
- \item["#cd \""\var{dir-name}"\";;"]
- Change the current working directory.
-
- \item["#directory \""\var{dir-name}"\";;"]
- Add the given directory to the list of directories searched for
- source and compiled files.
-
- \item["#remove_directory \""\var{dir-name}"\";;"]
- Remove the given directory from the list of directories searched for
- source and compiled files. Do nothing if the list does not contain
- the given directory.
-
- \item["#load \""\var{file-name}"\";;"]
- Load in memory a bytecode object file (".cmo" file) or library file
- (".cma" file) produced by the batch compiler "ocamlc".
-
- \item["#load_rec \""\var{file-name}"\";;"]
- Load in memory a bytecode object file (".cmo" file) or library file
- (".cma" file) produced by the batch compiler "ocamlc".
- When loading an object file that depends on other modules
- which have not been loaded yet, the .cmo files for these modules
- are searched and loaded as well, recursively. The loading order
- is not specified.
-
- \item["#use \""\var{file-name}"\";;"]
- Read, compile and execute source phrases from the given file.
- This is textual inclusion: phrases are processed just as if
- they were typed on standard input. The reading of the file stops at
- the first error encountered.
-
- \item["#use_output \""\var{command}"\";;"]
- Execute a command and evaluate its output as if it had been captured
- to a file and passed to "#use".
-
- \item["#mod_use \""\var{file-name}"\";;"]
- Similar to "#use" but also wrap the code into a top-level module of the
- same name as capitalized file name without extensions, following
- semantics of the compiler.
- \end{options}
-
-For directives that take file names as arguments, if the given file
-name specifies no directory, the file is searched in the following
-directories:
-\begin{enumerate}
- \item In script mode, the directory containing the script currently
- executing; in interactive mode, the current working directory.
- \item Directories added with the "#directory" directive.
- \item Directories given on the command line with "-I" options.
- \item The standard library directory.
-\end{enumerate}
-
-\item[Environment queries]
- \begin{options}
- \item["#show_class "\var{class-path}";;"]\vspace{-4.7ex}
- \item["#show_class_type "\var{class-path}";;"]\vspace{-4.7ex}
- \item["#show_exception "\var{ident}";;"]\vspace{-4.7ex}
- \item["#show_module "\var{module-path}";;"]\vspace{-4.7ex}
- \item["#show_module_type "\var{modtype-path}";;"]\vspace{-4.7ex}
- \item["#show_type "\var{typeconstr}";;"]\vspace{-4.7ex}
- \item["#show_val "\var{value-path}";;"]
- Print the signature of the corresponding component.
-
- \item["#show "\var{ident}";;"]
- Print the signatures of components with name \var{ident} in all the
- above categories.
- \end{options}
-
-\item[Pretty-printing]
- \begin{options}
-
- \item["#install_printer "\var{printer-name}";;"]
- This directive registers the function named \var{printer-name} (a
- value path) as a printer for values whose types match the argument
- type of the function. That is, the toplevel loop will call
- \var{printer-name} when it has such a value to print.
-
- The printing function \var{printer-name} should have type
- @"Format.formatter" "->" @t@ "->" "unit"@, where @@t@@ is the
- type for the values to be printed, and should output its textual
- representation for the value of type @@t@@ on the given formatter,
- using the functions provided by the "Format" library. For backward
- compatibility, \var{printer-name} can also have type
- @@t@ "->" "unit"@ and should then output on the standard
- formatter, but this usage is deprecated.
-
- \item["#print_depth "\var{n}";;"]
- Limit the printing of values to a maximal depth of \var{n}.
- The parts of values whose depth exceeds \var{n} are printed as "..."
- (ellipsis).
-
- \item["#print_length "\var{n}";;"]
- Limit the number of value nodes printed to at most \var{n}.
- Remaining parts of values are printed as "..." (ellipsis).
-
- \item["#remove_printer "\var{printer-name}";;"]
- Remove the named function from the table of toplevel printers.
-\end{options}
-
-\item[Tracing]
- \begin{options}
- \item["#trace "\var{function-name}";;"]
- After executing this directive, all calls to the function named
- \var{function-name} will be ``traced''. That is, the argument and the
- result are displayed for each call, as well as the exceptions escaping
- out of the function, raised either by the function itself or by
- another function it calls. If the function is curried, each argument
- is printed as it is passed to the function.
-
- \item["#untrace "\var{function-name}";;"]
- Stop tracing the given function.
-
- \item["#untrace_all;;"]
- Stop tracing all functions traced so far.
- \end{options}
-
-\item[Compiler options]
- \begin{options}
- \item["#labels "\var{bool}";;"]
- Ignore labels in function types if argument is "false", or switch back
- to default behaviour (commuting style) if argument is "true".
-
- \item["#ppx \""\var{file-name}"\";;"]
- After parsing, pipe the abstract syntax tree through the preprocessor
- command.
-
- \item["#principal "\var{bool}";;"]
- If the argument is "true", check information paths during
- type-checking, to make sure that all types are derived in a principal
- way. If the argument is "false", do not check information paths.
-
- \item["#rectypes;;"]
- Allow arbitrary recursive types during type-checking. Note: once
- enabled, this option cannot be disabled because that would lead to
- unsoundness of the type system.
-
- \item["#warn_error \""\var{warning-list}"\";;"]
- Treat as errors the warnings enabled by the argument and as normal
- warnings the warnings disabled by the argument.
-
- \item["#warnings \""\var{warning-list}"\";;"]
- Enable or disable warnings according to the argument.
-
- \end{options}
-
-\end{options}
-
-\section{s:toplevel-modules}{The toplevel and the module system}
-
-Toplevel phrases can refer to identifiers defined in compilation units
-with the same mechanisms as for separately compiled units: either by
-using qualified names ("Modulename.localname"), or by using
-the "open" construct and unqualified names (see section~\ref{s:names}).
-
-However, before referencing another compilation unit, an
-implementation of that unit must be present in memory.
-At start-up, the toplevel system contains implementations for all the
-modules in the the standard library. Implementations for user modules
-can be entered with the "#load" directive described above. Referencing
-a unit for which no implementation has been provided
-results in the error "Reference to undefined global `...'".
-
-Note that entering "open "\var{Mod} merely accesses the compiled
-interface (".cmi" file) for \var{Mod}, but does not load the
-implementation of \var{Mod}, and does not cause any error if no
-implementation of \var{Mod} has been loaded. The error
-``reference to undefined global \var{Mod}'' will occur only when
-executing a value or module definition that refers to \var{Mod}.
-
-\section{s:toplevel-common-errors}{Common errors}
-
-This section describes and explains the most frequently encountered
-error messages.
-
-\begin{options}
-
-\item[Cannot find file \var{filename}]
-The named file could not be found in the current directory, nor in the
-directories of the search path.
-
-If \var{filename} has the format \var{mod}".cmi", this
-means you have referenced the compilation unit \var{mod}, but its
-compiled interface could not be found. Fix: compile \var{mod}".mli" or
-\var{mod}".ml" first, to create the compiled interface \var{mod}".cmi".
-
-If \var{filename} has the format \var{mod}".cmo", this
-means you are trying to load with "#load" a bytecode object file that
-does not exist yet. Fix: compile \var{mod}".ml" first.
-
-If your program spans several directories, this error can also appear
-because you haven't specified the directories to look into. Fix: use
-the "#directory" directive to add the correct directories to the
-search path.
-
-\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
-See section~\ref{s:comp-errors}.
-
-\item[Reference to undefined global \var{mod}]
-You have neglected to load in memory an implementation for a module
-with "#load". See section~\ref{s:toplevel-modules} above.
-
-\end{options}
-
-\section{s:custom-toplevel}{Building custom toplevel systems: \texttt{ocamlmktop}}
-
-The "ocamlmktop" command builds OCaml toplevels that
-contain user code preloaded at start-up.
-
-The "ocamlmktop" command takes as argument a set of ".cmo" and ".cma"
-files, and links them with the object files that implement the OCaml toplevel.
-The typical use is:
-\begin{verbatim}
- ocamlmktop -o mytoplevel foo.cmo bar.cmo gee.cmo
-\end{verbatim}
-This creates the bytecode file "mytoplevel", containing the OCaml toplevel
-system, plus the code from the three ".cmo"
-files. This toplevel is directly executable and is started by:
-\begin{verbatim}
- ./mytoplevel
-\end{verbatim}
-This enters a regular toplevel loop, except that the code from
-"foo.cmo", "bar.cmo" and "gee.cmo" is already loaded in memory, just as
-if you had typed:
-\begin{verbatim}
- #load "foo.cmo";;
- #load "bar.cmo";;
- #load "gee.cmo";;
-\end{verbatim}
-on entrance to the toplevel. The modules "Foo", "Bar" and "Gee" are
-not opened, though; you still have to do
-\begin{verbatim}
- open Foo;;
-\end{verbatim}
-yourself, if this is what you wish.
-
-\subsection{ss:ocamlmktop-options}{Options}
-
-The following command-line options are recognized by "ocamlmktop".
-
-\begin{options}
-
-\item["-cclib" \var{libname}]
-Pass the "-l"\var{libname} option to the C linker when linking in
-``custom runtime'' mode. See the corresponding option for
-"ocamlc", in chapter~\ref{c:camlc}.
-
-\item["-ccopt" \var{option}]
-Pass the given option to the C compiler and linker, when linking in
-``custom runtime'' mode. See the corresponding option for
-"ocamlc", in chapter~\ref{c:camlc}.
-
-\item["-custom"]
-Link in ``custom runtime'' mode. See the corresponding option for
-"ocamlc", in chapter~\ref{c:camlc}.
-
-\item["-I" \var{directory}]
-Add the given directory to the list of directories searched for
-compiled object code files (".cmo" and ".cma").
-
-\item["-o" \var{exec-file}]
-Specify the name of the toplevel file produced by the linker.
-The default is "a.out".
-
-\end{options}
-
-\section{s:ocamlnat}{The native toplevel: \texttt{ocamlnat}\ (experimental)}
-
-{\bf This section describes a tool that is not yet officially supported %
-but may be found useful.}
-
-OCaml code executing in the traditional toplevel system uses the bytecode
-interpreter. When increased performance is required, or for testing
-programs that will only execute correctly when compiled to native code,
-the {\em native toplevel} may be used instead.
-
-For the majority of installations the native toplevel will not have been
-installed along with the rest of the OCaml toolchain. In such circumstances
-it will be necessary to build the OCaml distribution from source.
-From the built source tree of the distribution you may use
-{\tt make natruntop} to build and execute a native toplevel. (Alternatively
-{\tt make ocamlnat} can be used, which just performs the build step.)
-
-If the {\tt make install} command is run after having built the native
-toplevel then the {\tt ocamlnat} program (either from the source or the
-installation directory) may be invoked directly rather than using
-{\tt make natruntop}.
+++ /dev/null
-%
-% This file describes the native/bytecode compiler and toplevel
-% options. Since specific options can exist in only a subset of
-% \{toplevel, bytecode compiler, native compiler \} and their description
-% might differ across this subset, this file uses macros to adapt the
-% description tool by tool:
-\long\def\comp#1{\ifcomp#1\else\fi}
-% \long is needed for multiparagraph macros
-\long\def\nat#1{\ifnat#1\else\fi}
-\long\def\top#1{\iftop#1\else\fi}
-\long\def\notop#1{\iftop\else#1\fi}
-% ( Note that the previous definitions relies on the three boolean values
-% \top, \nat and \comp. The manual section must therefore
-% set these boolean values accordingly.
-% )
-% The macros (\comp, \nat, \top) adds a supplementary text
-% if we are respectively in the (bytecode compiler, native compiler, toplevel)
-% section.
-% The toplevel options are quite different from the compilers' options.
-% It is therefore useful to have also a substractive \notop macro
-% that prints its content only outside of the topvel section
-%
-% For instance, to add an option "-foo" that applies to the native and
-% bytecode compiler, one can write
-% \notop{\item["-foo"]
-% ...
-% }
-%
-% Similarly, an option "-bar" only available in the native compiler
-% can be introduced with
-% \nat{\item["-bar"]
-% ...
-% }
-% These macros can be also used to add information that are only relevant to
-% some tools or differ slightly from one tool to another. For instance, we
-% define the following macro for the pairs cma/cmxa cmo/cmxo and ocamlc/ocamlopt
-%
-\def\cma{\comp{.cma}\nat{.cmxa}}
-\def\cmo{\comp{.cmo}\nat{.cmx}}
-\def\qcmo{{\machine\cmo}}
-\def\qcma{{\machine\cma}}
-\def\ocamlx{\comp{ocamlc}\nat{ocamlopt}}
-%
-%
-\begin{options}
-\notop{%
-\item["-a"]
-Build a library(\nat{".cmxa" and ".a"/".lib" files}\comp{".cma" file})
-with the object files (\nat{".cmx" and ".o"/".obj" files}\comp{ ".cmo" files})
-given on the command line, instead of linking them into an executable file.
-The name of the library must be set with the "-o" option.
-
-If \comp{"-custom", }"-cclib" or "-ccopt" options are passed on the command
-line, these options are stored in the resulting \qcma library. Then,
-linking with this library automatically adds back the \comp{"-custom", }
-"-cclib" and "-ccopt" options as if they had been provided on the
-command line, unless the "-noautolink" option is given.
-}%notop
-
-\item["-absname"]
-Force error messages to show absolute paths for file names.
-
-\notop{\item["-annot"]
-Deprecated since OCaml 4.11. Please use "-bin-annot" instead.
-}%notop
-
-\item["-args" \var{filename}]
-Read additional newline-terminated command line arguments from \var{filename}.
-\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
-}%top
-\item["-args0" \var{filename}]
- Read additional null character terminated command line arguments from
- \var{filename}.
-\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
-}%top
-
-
-\notop{\item["-bin-annot"]
-Dump detailed information about the compilation (types, bindings,
-tail-calls, etc) in binary format. The information for file \var{src}".ml"
-(resp. \var{src}".mli") is put into file \var{src}".cmt"
-(resp. \var{src}".cmti"). In case of a type error, dump
-all the information inferred by the type-checker before the error.
-The "*.cmt" and "*.cmti" files produced by "-bin-annot" contain
-more information and are much more compact than the files produced by
-"-annot".
-}%notop
-
-\notop{\item["-c"]
-Compile only. Suppress the linking phase of the
-compilation. Source code files are turned into compiled files, but no
-executable file is produced. This option is useful to
-compile modules separately.
-}%notop
-
-\notop{%
-\item["-cc" \var{ccomp}]
-Use \var{ccomp} as the C linker \nat{called to build the final executable }
-\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}
-and as the C compiler for compiling ".c" source files.
-}%notop
-
-\notop{%
-\item["-cclib" "-l"\var{libname}]
-Pass the "-l"\var{libname} option to the \comp{C} linker
-\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}.
-This causes the given C library to be linked with the program.
-}%notop
-
-\notop{%
-\item["-ccopt" \var{option}]
-Pass the given option to the C compiler and linker.
-\comp{When linking in ``custom runtime'' mode, for instance}%
-\nat{For instance,}%
-"-ccopt -L"\var{dir} causes the C linker to search for C libraries in
-directory \var{dir}.\comp{(See the "-custom" option.)}
-}%notop
-
-\notop{%
-\item["-color" \var{mode}]
-Enable or disable colors in compiler messages (especially warnings and errors).
-The following modes are supported:
-\begin{description}
- \item["auto"] use heuristics to enable colors only if the output supports them
- (an ANSI-compatible tty terminal);
- \item["always"] enable colors unconditionally;
- \item["never"] disable color output.
-\end{description}
-The default setting is 'auto', and the current heuristic
-checks that the "TERM" environment variable exists and is
-not empty or "dumb", and that 'isatty(stderr)' holds.
-
-The environment variable "OCAML_COLOR" is considered if "-color" is not
-provided. Its values are auto/always/never as above.
-}%notop
-
-\notop{%
-\item["-error-style" \var{mode}]
-Control the way error messages and warnings are printed.
-The following modes are supported:
-\begin{description}
- \item["short"] only print the error and its location;
- \item["contextual"] like "short", but also display the source code snippet
- corresponding to the location of the error.
- \end{description}
-The default setting is "contextual".
-
-The environment variable "OCAML_ERROR_STYLE" is considered if "-error-style" is
-not provided. Its values are short/contextual as above.
-}%notop
-
-\comp{%
-\item["-compat-32"]
-Check that the generated bytecode executable can run on 32-bit
-platforms and signal an error if it cannot. This is useful when
-compiling bytecode on a 64-bit machine.
-}%comp
-
-\nat{%
-\item["-compact"]
-Optimize the produced code for space rather than for time. This
-results in slightly smaller but slightly slower programs. The default is to
-optimize for speed.
-}%nat
-
-\notop{%
-\item["-config"]
-Print the version number of {\machine\ocamlx} and a detailed
-summary of its configuration, then exit.
-}%notop
-
-\notop{%
-\item["-config-var" \var{var}]
-Print the value of a specific configuration variable from the
-"-config" output, then exit. If the variable does not exist, the exit
-code is non-zero. This option is only available since OCaml 4.08,
-so script authors should have a fallback for older versions.
-}%notop
-
-\comp{%
-\item["-custom"]
-Link in ``custom runtime'' mode. In the default linking mode, the
-linker produces bytecode that is intended to be executed with the
-shared runtime system, "ocamlrun". In the custom runtime mode, the
-linker produces an output file that contains both the runtime system
-and the bytecode for the program. The resulting file is larger, but it
-can be executed directly, even if the "ocamlrun" command is not
-installed. Moreover, the ``custom runtime'' mode enables static
-linking of OCaml code with user-defined C functions, as described in
-chapter~\ref{c:intf-c}.
-\begin{unix}
-Never use the "strip" command on executables produced by "ocamlc -custom",
-this would remove the bytecode part of the executable.
-\end{unix}
-\begin{unix}
-Security warning: never set the ``setuid'' or ``setgid'' bits on executables
-produced by "ocamlc -custom", this would make them vulnerable to attacks.
-\end{unix}
-}%comp
-
-\notop{%
-\item["-depend" \var{ocamldep-args}]
-Compute dependencies, as the "ocamldep" command would do. The remaining
-arguments are interpreted as if they were given to the "ocamldep" command.
-}%notop
-
-\comp{
-\item["-dllib" "-l"\var{libname}]
-Arrange for the C shared library "dll"\var{libname}".so"
-("dll"\var{libname}".dll" under Windows) to be loaded dynamically
-by the run-time system "ocamlrun" at program start-up time.
-}%comp
-
-\comp{\item["-dllpath" \var{dir}]
-Adds the directory \var{dir} to the run-time search path for shared
-C libraries. At link-time, shared libraries are searched in the
-standard search path (the one corresponding to the "-I" option).
-The "-dllpath" option simply stores \var{dir} in the produced
-executable file, where "ocamlrun" can find it and use it as
-described in section~\ref{s:ocamlrun-dllpath}.
-}%comp
-
-\notop{%
-\item["-for-pack" \var{module-path}]
-Generate an object file (\qcmo\nat{ and ".o"/".obj" files})
-that can later be included
-as a sub-module (with the given access path) of a compilation unit
-constructed with "-pack". For instance,
-{\machine\ocamlx\ -for-pack\ P\ -c\ A.ml}
-will generate {\machine a.\cmo}\nat{ and "a.o" files} that can
-later be used with {\machine \ocamlx\ -pack\ -o\ P\cmo\ a\cmo}.
-Note: you can still pack a module that was compiled without
-"-for-pack" but in this case exceptions will be printed with the wrong
-names.
-}%notop
-
-\notop{%
-\item["-g"]
-Add debugging information while compiling and linking. This option is
-required in order to \comp{be able to debug the program with "ocamldebug"
-(see chapter~\ref{c:debugger}), and to} produce stack backtraces when
-the program terminates on an uncaught exception (see
-section~\ref{s:ocamlrun-options}).
-}%notop
-
-\notop{%
-\item["-i"]
-Cause the compiler to print all defined names (with their inferred
-types or their definitions) when compiling an implementation (".ml"
-file). No compiled files (".cmo" and ".cmi" files) are produced.
-This can be useful to check the types inferred by the
-compiler. Also, since the output follows the syntax of interfaces, it
-can help in writing an explicit interface (".mli" file) for a file:
-just redirect the standard output of the compiler to a ".mli" file,
-and edit that file to remove all declarations of unexported names.
-}%notop
-
-\item["-I" \var{directory}]
-Add the given directory to the list of directories searched for
-\nat{compiled interface files (".cmi"), compiled object code files (".cmx"),
-and libraries (".cmxa").}
-\comp{compiled interface files (".cmi"), compiled object code files ".cmo",
-libraries (".cma") and C libraries specified with "-cclib -lxxx".}
-\top{source and compiled files.}
-By default, the current directory is searched first, then the standard
-library directory. Directories added with "-I" are searched after the
-current directory, in the order in which they were given on the command line,
-but before the standard library directory. See also option "-nostdlib".
-
-If the given directory starts with "+", it is taken relative to the
-standard library directory. For instance, "-I +unix" adds the
-subdirectory "unix" of the standard library to the search path.
-
-\top{%
-Directories can also be added to the list once
-the toplevel is running with the "#directory" directive
-(section~\ref{s:toplevel-directives}).
-}%top
-
-\top{%
-\item["-init" \var{file}]
-Load the given file instead of the default initialization file.
-The default file is ".ocamlinit" in the current directory if it
-exists, otherwise "XDG_CONFIG_HOME/ocaml/init.ml" or
-".ocamlinit" in the user's home directory.
-}%top
-
-\notop{%
-\item["-impl" \var{filename}]
-Compile the file \var{filename} as an implementation file, even if its
-extension is not ".ml".
-}%notop
-
-\nat{%
-\item["-inline" \var{n}]
-Set aggressiveness of inlining to \var{n}, where \var{n} is a positive
-integer. Specifying "-inline 0" prevents all functions from being
-inlined, except those whose body is smaller than the call site. Thus,
-inlining causes no expansion in code size. The default aggressiveness,
-"-inline 1", allows slightly larger functions to be inlined, resulting
-in a slight expansion in code size. Higher values for the "-inline"
-option cause larger and larger functions to become candidate for
-inlining, but can result in a serious increase in code size.
-}%nat
-
-\notop{%
-\item["-intf" \var{filename}]
-Compile the file \var{filename} as an interface file, even if its
-extension is not ".mli".
-}%notop
-
-\notop{%
-\item["-intf-suffix" \var{string}]
-Recognize file names ending with \var{string} as interface files
-(instead of the default ".mli").
-}%\notop
-
-\item["-labels"]
-Labels are not ignored in types, labels may be used in applications,
-and labelled parameters can be given in any order. This is the default.
-
-\notop{%
-\item["-linkall"]
-Force all modules contained in libraries to be linked in. If this
-flag is not given, unreferenced modules are not linked in. When
-building a library (option "-a"), setting the "-linkall" option forces all
-subsequent links of programs involving that library to link all the
-modules contained in the library. When compiling a module (option
-"-c"), setting the "-linkall" option ensures that this module will
-always be linked if it is put in a library and this library is linked.
-}%notop
-
-\nat{%
-\item["-linscan"]
-Use linear scan register allocation. Compiling with this allocator is faster
-than with the usual graph coloring allocator, sometimes quite drastically so for
-long functions and modules. On the other hand, the generated code can be a bit
-slower.
-}%nat
-
-\comp{%
-\item["-make-runtime"]
-Build a custom runtime system (in the file specified by option "-o")
-incorporating the C object files and libraries given on the command
-line. This custom runtime system can be used later to execute
-bytecode executables produced with the
-"ocamlc -use-runtime" \var{runtime-name} option.
-See section~\ref{ss:custom-runtime} for more information.
-}%comp
-
-\notop{%
-\item["-match-context-rows"]
-Set the number of rows of context used for optimization during
-pattern matching compilation. The default value is 32. Lower values
-cause faster compilation, but less optimized code. This advanced
-option is meant for use in the event that a pattern-match-heavy
-program leads to significant increases in compilation time.
-}%notop
-
-\notop{%
-\item["-no-alias-deps"]
-Do not record dependencies for module aliases. See
-section~\ref{s:module-alias} for more information.
-}%notop
-
-\item["-no-app-funct"]
-Deactivates the applicative behaviour of functors. With this option,
-each functor application generates new types in its result and
-applying the same functor twice to the same argument yields two
-incompatible structures.
-
-\nat{%
-\item["-no-float-const-prop"]
-Deactivates the constant propagation for floating-point operations.
-This option should be given if the program changes the float rounding
-mode during its execution.
-}%nat
-
-\item["-noassert"]
-Do not compile assertion checks. Note that the special form
-"assert false" is always compiled because it is typed specially.
-\notop{This flag has no effect when linking already-compiled files.}
-
-\notop{%
-\item["-noautolink"]
-When linking \qcma libraries, ignore \comp{"-custom",} "-cclib" and "-ccopt"
-options potentially contained in the libraries (if these options were
-given when building the libraries). This can be useful if a library
-contains incorrect specifications of C libraries or C options; in this
-case, during linking, set "-noautolink" and pass the correct C
-libraries and options on the command line.
-}%
-
-\nat{%
-\item["-nodynlink"]
-Allow the compiler to use some optimizations that are valid only for
-code that is statically linked to produce a non-relocatable
-executable. The generated code cannot be linked to produce a shared
-library nor a position-independent executable (PIE). Many operating
-systems produce PIEs by default, causing errors when linking code
-compiled with "-nodynlink". Either do not use "-nodynlink" or pass
-the option "-ccopt -no-pie" at link-time.
-}%nat
-
-\item["-nolabels"]
-Ignore non-optional labels in types. Labels cannot be used in
-applications, and parameter order becomes strict.
-
-\top{%
-\item["-noprompt"]
-Do not display any prompt when waiting for input.
-}%top
-
-\top{%
-\item["-nopromptcont"]
-Do not display the secondary prompt when waiting for continuation
-lines in multi-line inputs. This should be used e.g. when running
-"ocaml" in an "emacs" window.
-}%top
-
-\item["-nostdlib"]
-\top{%
-Do not include the standard library directory in the list of
-directories searched for source and compiled files.
-}%top
-\comp{%
-Do not include the standard library directory in the list of
-directories searched for
-compiled interface files (".cmi"), compiled object code files
-(".cmo"), libraries (".cma"), and C libraries specified with
-"-cclib -lxxx". See also option "-I".
-}%comp
-\nat{%
-Do not automatically add the standard library directory to the list of
-directories searched for compiled interface files (".cmi"), compiled
-object code files (".cmx"), and libraries (".cmxa"). See also option
-"-I".
-}%nat
-
-\notop{%
-\item["-o" \var{exec-file}]
-Specify the name of the output file produced by the
-\nat{linker}\comp{compiler}. The
-default output name is "a.out" under Unix and "camlprog.exe" under
-Windows. If the "-a" option is given, specify the name of the library
-produced. If the "-pack" option is given, specify the name of the
-packed object file produced. If the "-output-obj" option is given,
-specify the name of the output file produced.
-\nat{If the "-shared" option is given, specify the name of plugin
-file produced.}
-\comp{If the "-c" option is given, specify the name of the object
-file produced for the {\em next} source file that appears on the
-command line.}
-}%notop
-
-\notop{%
-\item["-opaque"]
-When the native compiler compiles an implementation, by default it
-produces a ".cmx" file containing information for cross-module
-optimization. It also expects ".cmx" files to be present for the
-dependencies of the currently compiled source, and uses them for
-optimization. Since OCaml 4.03, the compiler will emit a warning if it
-is unable to locate the ".cmx" file of one of those dependencies.
-
-The "-opaque" option, available since 4.04, disables cross-module
-optimization information for the currently compiled unit. When
-compiling ".mli" interface, using "-opaque" marks the compiled ".cmi"
-interface so that subsequent compilations of modules that depend on it
-will not rely on the corresponding ".cmx" file, nor warn if it is
-absent. When the native compiler compiles a ".ml" implementation,
-using "-opaque" generates a ".cmx" that does not contain any
-cross-module optimization information.
-
-Using this option may degrade the quality of generated code, but it
-reduces compilation time, both on clean and incremental
-builds. Indeed, with the native compiler, when the implementation of
-a compilation unit changes, all the units that depend on it may need
-to be recompiled -- because the cross-module information may have
-changed. If the compilation unit whose implementation changed was
-compiled with "-opaque", no such recompilation needs to occur. This
-option can thus be used, for example, to get faster edit-compile-test
-feedback loops.
-}%notop
-
-\notop{%
-\item["-open" \var{Module}]
-Opens the given module before processing the interface or
-implementation files. If several "-open" options are given,
-they are processed in order, just as if
-the statements "open!" \var{Module1}";;" "..." "open!" \var{ModuleN}";;"
-were added at the top of each file.
-}%notop
-
-\notop{%
-\item["-output-obj"]
-Cause the linker to produce a C object file instead of
-\comp{a bytecode executable file}\nat{an executable file}.
-This is useful to wrap OCaml code as a C library,
-callable from any C program. See chapter~\ref{c:intf-c},
-section~\ref{ss:c-embedded-code}. The name of the output object file
-must be set with the "-o" option.
-This option can also be used to produce a \comp{C source file (".c" extension)
-or a} compiled shared/dynamic library (".so" extension, ".dll" under Windows).
-}%notop
-
-\comp{%
-\item["-output-complete-exe"]
-Build a self-contained executable by linking a C object file containing the
-bytecode program, the OCaml runtime system and any other static C code given to
-"ocamlc". The resulting effect is similar to "-custom", except that the bytecode
-is embedded in the C code so it is no longer accessible to tools such as
-"ocamldebug". On the other hand, the resulting binary is resistant to "strip".
-}%comp
-
-\nat{%
-\item["-pack"]
-Build an object file (".cmx" and ".o"/".obj" files) and its associated compiled
-interface (".cmi") that combines the ".cmx" object
-files given on the command line, making them appear as sub-modules of
-the output ".cmx" file. The name of the output ".cmx" file must be
-given with the "-o" option. For instance,
-\begin{verbatim}
- ocamlopt -pack -o P.cmx A.cmx B.cmx C.cmx
-\end{verbatim}
-generates compiled files "P.cmx", "P.o" and "P.cmi" describing a
-compilation unit having three sub-modules "A", "B" and "C",
-corresponding to the contents of the object files "A.cmx", "B.cmx" and
-"C.cmx". These contents can be referenced as "P.A", "P.B" and "P.C"
-in the remainder of the program.
-
-The ".cmx" object files being combined must have been compiled with
-the appropriate "-for-pack" option. In the example above,
-"A.cmx", "B.cmx" and "C.cmx" must have been compiled with
-"ocamlopt -for-pack P".
-
-Multiple levels of packing can be achieved by combining "-pack" with
-"-for-pack". Consider the following example:
-\begin{verbatim}
- ocamlopt -for-pack P.Q -c A.ml
- ocamlopt -pack -o Q.cmx -for-pack P A.cmx
- ocamlopt -for-pack P -c B.ml
- ocamlopt -pack -o P.cmx Q.cmx B.cmx
-\end{verbatim}
-The resulting "P.cmx" object file has sub-modules "P.Q", "P.Q.A"
-and "P.B".
-}%nat
-
-\comp{%
-\item["-pack"]
-Build a bytecode object file (".cmo" file) and its associated compiled
-interface (".cmi") that combines the object
-files given on the command line, making them appear as sub-modules of
-the output ".cmo" file. The name of the output ".cmo" file must be
-given with the "-o" option. For instance,
-\begin{verbatim}
- ocamlc -pack -o p.cmo a.cmo b.cmo c.cmo
-\end{verbatim}
-generates compiled files "p.cmo" and "p.cmi" describing a compilation
-unit having three sub-modules "A", "B" and "C", corresponding to the
-contents of the object files "a.cmo", "b.cmo" and "c.cmo". These
-contents can be referenced as "P.A", "P.B" and "P.C" in the remainder
-of the program.
-}%comp
-
-\notop{%
-\item["-pp" \var{command}]
-Cause the compiler to call the given \var{command} as a preprocessor
-for each source file. The output of \var{command} is redirected to
-an intermediate file, which is compiled. If there are no compilation
-errors, the intermediate file is deleted afterwards.
-}%notop
-
-\item["-ppx" \var{command}]
-After parsing, pipe the abstract syntax tree through the preprocessor
-\var{command}. The module "Ast_mapper", described in
-\ifouthtml
-chapter~\ref{c:parsinglib}:
-\ahref{compilerlibref/Ast\_mapper.html}{ \texttt{Ast_mapper} }
-\else section~\ref{Ast-underscoremapper}\fi,
-implements the external interface of a preprocessor.
-
-\item["-principal"]
-Check information path during type-checking, to make sure that all
-types are derived in a principal way. When using labelled arguments
-and/or polymorphic methods, this flag is required to ensure future
-versions of the compiler will be able to infer types correctly, even
-if internal algorithms change.
-All programs accepted in "-principal" mode are also accepted in the
-default mode with equivalent types, but different binary signatures,
-and this may slow down type checking; yet it is a good idea to
-use it once before publishing source code.
-
-\item["-rectypes"]
-Allow arbitrary recursive types during type-checking. By default,
-only recursive types where the recursion goes through an object type
-are supported.\notop{Note that once you have created an interface using this
-flag, you must use it again for all dependencies.}
-
-\notop{%
-\item["-runtime-variant" \var{suffix}]
-Add the \var{suffix} string to the name of the runtime library used by
-the program. Currently, only one such suffix is supported: "d", and
-only if the OCaml compiler was configured with option
-"-with-debug-runtime". This suffix gives the debug version of the
-runtime, which is useful for debugging pointer problems in low-level
-code such as C stubs.
-}%notop
-
-\notop{
-\item["-stop-after" \var{pass}]
-Stop compilation after the given compilation pass. The currently
-supported passes are:
-"parsing", "typing"\nat{, "scheduling", "emit"}.
-}%notop
-
-\nat{
-\item["-save-ir-after" \var{pass}]
-Save intermediate representation after the given compilation pass
-to a file.
-The currently supported passes and the corresponding file extensions are:
-"scheduling" (".cmir-linear").
-
-This experimental feature enables external tools to inspect and manipulate
-compiler's intermediate representation of the program
-using "compiler-libs" library (see
-\ifouthtml chapter~\ref{c:parsinglib} and
-\ahref{compilerlibref/Compiler\_libs.html}{ \texttt{Compiler_libs} }
-\else section~\ref{Compiler-underscorelibs}\fi
-).
-}%nat
-
-\nat{%
-\item["-S"]
-Keep the assembly code produced during the compilation. The assembly
-code for the source file \var{x}".ml" is saved in the file \var{x}".s".
-}%nat
-
-\nat{%
-\item["-shared"]
-Build a plugin (usually ".cmxs") that can be dynamically loaded with
-the "Dynlink" module. The name of the plugin must be
-set with the "-o" option. A plugin can include a number of OCaml
-modules and libraries, and extra native objects (".o", ".obj", ".a",
-".lib" files). Building native plugins is only supported for some
-operating system. Under some systems (currently,
-only Linux AMD 64), all the OCaml code linked in a plugin must have
-been compiled without the "-nodynlink" flag. Some constraints might also
-apply to the way the extra native objects have been compiled (under
-Linux AMD 64, they must contain only position-independent code).
-}%nat
-
-\item["-safe-string"]
-Enforce the separation between types "string" and "bytes",
-thereby making strings read-only. This is the default.
-
-\item["-short-paths"]
-When a type is visible under several module-paths, use the shortest
-one when printing the type's name in inferred interfaces and error and
-warning messages. Identifier names starting with an underscore "_" or
-containing double underscores "__" incur a penalty of $+10$ when computing
-their length.
-
-\top{
-\item["-stdin"]
-Read the standard input as a script file rather than starting an
-interactive session.
-}%top
-
-\item["-strict-sequence"]
-Force the left-hand part of each sequence to have type unit.
-
-\item["-strict-formats"]
-Reject invalid formats that were accepted in legacy format
-implementations. You should use this flag to detect and fix such
-invalid formats, as they will be rejected by future OCaml versions.
-
-\notop{%
-\item["-unboxed-types"]
-When a type is unboxable (i.e. a record with a single argument or a
-concrete datatype with a single constructor of one argument) it will
-be unboxed unless annotated with "[@@ocaml.boxed]".
-}%notop
-
-\notop{%
-\item["-no-unboxed-types"]
-When a type is unboxable it will be boxed unless annotated with
-"[@@ocaml.unboxed]". This is the default.
-}%notop
-
-\item["-unsafe"]
-Turn bound checking off for array and string accesses (the "v.(i)" and
-"s.[i]" constructs). Programs compiled with "-unsafe" are therefore
-\comp{slightly} faster, but unsafe: anything can happen if the program
-accesses an array or string outside of its bounds.
-\notop{%
-Additionally, turn off the check for zero divisor in integer division
- and modulus operations. With "-unsafe", an integer division
-(or modulus) by zero can halt the program or continue with an
-unspecified result instead of raising a "Division_by_zero" exception.
-}%notop
-
-\item["-unsafe-string"]
-Identify the types "string" and "bytes", thereby making strings writable.
-This is intended for compatibility with old source code and should not
-be used with new software.
-
-\comp{%
-\item["-use-runtime" \var{runtime-name}]
-Generate a bytecode executable file that can be executed on the custom
-runtime system \var{runtime-name}, built earlier with
-"ocamlc -make-runtime" \var{runtime-name}.
-See section~\ref{ss:custom-runtime} for more information.
-}%comp
-
-\item["-v"]
-Print the version number of the compiler and the location of the
-standard library directory, then exit.
-
-\item["-verbose"]
-Print all external commands before they are executed,
-\nat{in particular invocations of the assembler, C compiler, and linker.}
-\comp{in particular invocations of the C compiler and linker in "-custom" mode.}
-Useful to debug C library problems.
-
-\notop{%
-\item["-version" or "-vnum"]
-Print the version number of the compiler in short form (e.g. "3.11.0"),
-then exit.
-}%notop
-
-\top{%
-\item["-version"]
-Print version string and exit.
-
-\item["-vnum"]
-Print short version number and exit.
-
-\item["-no-version"]
-Do not print the version banner at startup.
-}%top
-
-\item["-w" \var{warning-list}]
-Enable, disable, or mark as fatal the warnings specified by the argument
-\var{warning-list}.
-Each warning can be {\em enabled} or {\em disabled}, and each warning
-can be {\em fatal} or {\em non-fatal}.
-If a warning is disabled, it isn't displayed and doesn't affect
-compilation in any way (even if it is fatal). If a warning is
-enabled, it is displayed normally by the compiler whenever the source
-code triggers it. If it is enabled and fatal, the compiler will also
-stop with an error after displaying it.
-
-The \var{warning-list} argument is a sequence of warning specifiers,
-with no separators between them. A warning specifier is one of the
-following:
-
-\begin{options}
-\item["+"\var{num}] Enable warning number \var{num}.
-\item["-"\var{num}] Disable warning number \var{num}.
-\item["@"\var{num}] Enable and mark as fatal warning number \var{num}.
-\item["+"\var{num1}..\var{num2}] Enable warnings in the given range.
-\item["-"\var{num1}..\var{num2}] Disable warnings in the given range.
-\item["@"\var{num1}..\var{num2}] Enable and mark as fatal warnings in
-the given range.
-\item["+"\var{letter}] Enable the set of warnings corresponding to
-\var{letter}. The letter may be uppercase or lowercase.
-\item["-"\var{letter}] Disable the set of warnings corresponding to
-\var{letter}. The letter may be uppercase or lowercase.
-\item["@"\var{letter}] Enable and mark as fatal the set of warnings
-corresponding to \var{letter}. The letter may be uppercase or
-lowercase.
-\item[\var{uppercase-letter}] Enable the set of warnings corresponding
-to \var{uppercase-letter}.
-\item[\var{lowercase-letter}] Disable the set of warnings corresponding
-to \var{lowercase-letter}.
-\end{options}
-
-Alternatively, \var{warning-list} can specify a single warning using its
-mnemonic name (see below), as follows:
-
-\begin{options}
-\item["+"\var{name}] Enable warning \var{name}.
-\item["-"\var{name}] Disable warning \var{name}.
-\item["@"\var{name}] Enable and mark as fatal warning \var{name}.
-\end{options}
-
-Warning numbers, letters and names which are not currently defined are
-ignored. The warnings are as follows (the name following each number specifies
-the mnemonic for that warning).
-\begin{options}
-\input{warnings-help.tex}
-\end{options}
-
-The default setting is "-w +a-4-6-7-9-27-29-32..42-44-45-48-50-60".
-It is displayed by {\machine\ocamlx\ -help}.
-Note that warnings 5 and 10 are not always triggered, depending on
-the internals of the type checker.
-
-
-\item["-warn-error" \var{warning-list}]
-Mark as fatal the warnings specified in the argument \var{warning-list}.
-The compiler will stop with an error when one of these warnings is
-emitted. The \var{warning-list} has the same meaning as for
-the "-w" option: a "+" sign (or an uppercase letter) marks the
-corresponding warnings as fatal, a "-"
-sign (or a lowercase letter) turns them back into non-fatal warnings,
-and a "@" sign both enables and marks as fatal the corresponding
-warnings.
-
-Note: it is not recommended to use warning sets (i.e. letters) as
-arguments to "-warn-error"
-in production code, because this can break your build when future versions
-of OCaml add some new warnings.
-
-The default setting is "-warn-error -a+31" (only warning 31 is fatal).
-
-\item["-warn-help"]
-Show the description of all available warning numbers.
-
-\notop{%
-\item["-where"]
-Print the location of the standard library, then exit.
-}%notop
-
-\notop{%
-\item["-with-runtime"]
-Include the runtime system in the generated program. This is the default.
-}
-
-\notop{%
-\item["-without-runtime"]
-The compiler does not include the runtime system (nor a reference to it) in the
-generated program; it must be supplied separately.
-}
-
-\item["-" \var{file}]
-\notop{Process \var{file} as a file name, even if it starts with a dash ("-")
-character.}
-\top{Use \var{file} as a script file name, even when it starts with a
-hyphen (-).}
-
-\item["-help" or "--help"]
-Display a short usage summary and exit.
-
-\end{options}
-%
+++ /dev/null
-\chapter*{Foreword}
-\markboth{Foreword}{}
-%HEVEA\cutname{foreword.html}
-
-This manual documents the release \ocamlversion\ of the OCaml
-system. It is organized as follows.
-\begin{itemize}
-\item Part~\ref{p:tutorials}, ``An introduction to OCaml'',
-gives an overview of the language.
-\item Part~\ref{p:refman}, ``The OCaml language'', is the
-reference description of the language.
-\item Part~\ref{p:commands}, ``The OCaml tools'', documents
-the compilers, toplevel system, and programming utilities.
-\item Part~\ref{p:library}, ``The OCaml library'', describes the
-modules provided in the standard library.
-\begin{latexonly}
-\item Part~\ref{p:indexes}, ``Indexes'', contains an
-index of all identifiers defined in the standard library, and an
-index of keywords.
-\end{latexonly}
-\end{itemize}
-
-\section*{conventions}{Conventions}
-
-OCaml runs on several operating systems. The parts of
-this manual that are specific to one operating system are presented as
-shown below:
-
-\begin{unix} This is material specific to the Unix family of operating
-systems, including Linux and macOS.
-\end{unix}
-
-\begin{windows} This is material specific to Microsoft Windows
- (Vista, 7, 8, 10).
-\end{windows}
-
-\section*{license}{License}
-
-The OCaml system is copyright \copyright\ 1996--\number\year\
-Institut National de Recherche en Informatique et en
-Automatique (INRIA).
-INRIA holds all ownership rights to the OCaml system.
-
-The OCaml system is open source and can be freely
-redistributed. See the file "LICENSE" in the distribution for
-licensing information.
-
-The OCaml documentation and user's manual is
-copyright \copyright\ \number\year\
-Institut National de Recherche en Informatique et en
-Automatique (INRIA).
-
-\begin{latexonly}
-The OCaml documentation and user's manual is licensed under a Creative
-Commons Attribution-ShareAlike 4.0 International License (CC BY-SA
-4.0), \url{https://creativecommons.org/licenses/by-sa/4.0/}.
-\end{latexonly}
-
-\begin{htmlonly}
-\begin{rawhtml}
-<a id="cc_license_logo" rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by-sa/4.0/88x31.png"></a>
-The OCaml documentation and user's manual is licensed under a
-<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">Creative Commons Attribution-ShareAlike 4.0 International License</a>.
-\end{rawhtml}
-\end{htmlonly}
-
-\section*{availability}{Availability}
-
-\begin{latexonly}
-The complete OCaml distribution can be accessed via the website
-\url{https://ocaml.org/}. This site contains a lot of additional
-information on OCaml.
-\end{latexonly}
-
-\begin{htmlonly}
-The complete OCaml distribution can be accessed via the
-\href{https://ocaml.org/}{ocaml.org website}.
-This site contains a lot of additional information on OCaml.
-\end{htmlonly}
+++ /dev/null
-dune
-markup.ml
-uchar
-uutf
-lambdasoup
-ocaml-re
-.sass-cache
+++ /dev/null
-DUNE_CMD := $(if $(wildcard dune/dune.exe),dune/dune.exe,dune)
-DUNE ?= $(DUNE_CMD)
-
-DEBUG ?= 0
-ifeq ($(DEBUG), 1)
- DBG=
-else
- DBG=quiet
-endif
-
-WEBDIR = ../webman
-WEBDIRMAN = $(WEBDIR)/manual
-WEBDIRAPI = $(WEBDIR)/api
-WEBDIRCOMP = $(WEBDIRAPI)/compilerlibref
-
-# The "all" target generates the Web Manual in the directories
-# ../webman/manual, ../webman/api, and ../webman/api/compilerlibref
-all: css js img
- $(DUNE) exec --root=. src/process_manual.exe $(DBG)
- $(DUNE) exec --root=. src/process_api.exe overwrite $(DBG)
- $(DUNE) exec --root=. src/process_api.exe compiler overwrite $(DBG)
-
-$(WEBDIR):
- mkdir -p $(WEBDIRMAN)
- mkdir -p $(WEBDIRCOMP)
-
-$(WEBDIRMAN)/manual.css: scss/_common.scss scss/manual.scss $(WEBDIR)
- sass scss/manual.scss > $(WEBDIRMAN)/manual.css
-
-$(WEBDIRAPI)/style.css: scss/_common.scss scss/style.scss $(WEBDIR)
- sass scss/style.scss > $(WEBDIRAPI)/style.css
- cp $(WEBDIRAPI)/style.css $(WEBDIRCOMP)/style.css
-
-css: $(WEBDIRMAN)/manual.css $(WEBDIRAPI)/style.css
-
-# Just copy the JS files
-JS_FILES0 := scroll.js navigation.js
-JS_FILES1 := $(JS_FILES0) search.js
-JS_FILES := $(addprefix $(WEBDIRAPI)/, $(JS_FILES1)) $(addprefix $(WEBDIRCOMP)/, $(JS_FILES1)) $(addprefix $(WEBDIRMAN)/, $(JS_FILES0))
-
-# There must be a more clever way
-$(WEBDIRAPI)/%.js: js/%.js
- cp $< $@
-
-$(WEBDIRMAN)/%.js: js/%.js
- cp $< $@
-
-$(WEBDIRCOMP)/%.js: js/%.js
- cp $< $@
-
-js: $(WEBDIR) $(JS_FILES)
-
-# download images for local use
-SEARCH := search_icon.svg
-$(WEBDIRAPI)/search_icon.svg: $(WEBDIR)
- curl "https://ocaml.org/img/search.svg" > $(WEBDIRAPI)/$(SEARCH)
- cp $(WEBDIRAPI)/$(SEARCH) $(WEBDIRCOMP)/$(SEARCH)
-
-LOGO := colour-logo.svg
-$(WEBDIRAPI)/colour-logo.svg: $(WEBDIR)
- curl "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/SVG/colour-logo.svg" > $(WEBDIRAPI)/$(LOGO)
- cp $(WEBDIRAPI)/$(LOGO) $(WEBDIRMAN)/$(LOGO)
- cp $(WEBDIRAPI)/$(LOGO) $(WEBDIRCOMP)/$(LOGO)
-
-ICON := favicon.ico
-$(WEBDIRAPI)/favicon.ico: $(WEBDIR)
- curl "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/Favicon/32x32.ico" > $(WEBDIRAPI)/$(ICON)
- cp $(WEBDIRAPI)/$(ICON) $(WEBDIRMAN)/$(ICON)
- cp $(WEBDIRAPI)/$(ICON) $(WEBDIRCOMP)/$(ICON)
-
-IMG_FILES0 := colour-logo.svg
-IMG_FILES := $(addprefix $(WEBDIRAPI)/, $(IMG_FILES0)) $(addprefix $(WEBDIRCOMP)/, $(IMG_FILES0)) $(addprefix $(WEBDIRMAN)/, $(IMG_FILES0))
-
-img: $(WEBDIR) $(WEBDIRAPI)/search_icon.svg $(WEBDIRAPI)/favicon.ico $(WEBDIRCOMP)/search_icon.svg $(WEBDIRCOMP)/favicon.ico $(IMG_FILES)
-
-clean:
- rm -rf $(WEBDIR) src/.merlin _build
-
-distclean::
- rm -rf .sass-cache
-
-# We need Dune and Lambda Soup; Markup.ml and Uutf are dependencies
-DUNE_TAG = 2.6.2
-LAMBDASOUP_TAG = 0.7.1
-MARKUP_TAG = 0.8.2
-UUTF_TAG = v1.0.2
-RE_TAG = 1.9.0
-
-# Duniverse rules - set-up dune and the dependencies in-tree for CI
-duniverse: dune/dune.exe re markup.ml uutf lambdasoup
-
-dune/dune.exe: dune
- cd dune; ocaml bootstrap.ml
-
-GIT_CHECKOUT = git -c advice.detachedHead=false checkout
-
-dune:
- git clone https://github.com/ocaml/dune.git -n -o upstream
- cd dune; $(GIT_CHECKOUT) $(DUNE_TAG)
-
-distclean::
- rm -rf dune
-
-re:
- git clone https://github.com/ocaml/ocaml-re.git -n -o upstream
- cd ocaml-re; $(GIT_CHECKOUT) $(RE_TAG)
-
-distclean::
- rm -rf ocaml-re
-
-lambdasoup:
- git clone https://github.com/aantron/lambdasoup.git -n -o upstream
- cd lambdasoup; $(GIT_CHECKOUT) $(LAMBDASOUP_TAG)
-
-distclean::
- rm -rf lambdasoup
-
-markup.ml:
- git clone https://github.com/aantron/markup.ml.git -n -o upstream
- cd markup.ml; $(GIT_CHECKOUT) $(MARKUP_TAG)
-
-distclean::
- rm -rf markup.ml
-
-uutf:
- git clone https://github.com/dbuenzli/uutf.git -n -o upstream
- cd uutf; $(GIT_CHECKOUT) $(UUTF_TAG)
- cd uutf; \
- mv opam uutf.opam; \
- echo '(lang dune 1.0)' > dune-project; \
- echo '(name uutf)' >> dune-project; \
- echo '(library (name uutf)(public_name uutf)(flags (:standard -w -3-27))(wrapped false))' > src/dune
-
-distclean::
- rm -rf uutf
-
-.PHONY: css js img duniverse
+++ /dev/null
-# HTML post-processing
-
-This directory contains material for enhancing the html of the manual
-and the API (from the `../htmlman` directory), including a quick
-search widget for the API.
-
-The process will create the `../webman` dir, and output the new html
-files (and assets) in `../webman/manual` (the manual) and `../webman/api` (the
-API).
-
-## manual and api
-
-There are two different scripts, `process_manual.ml` and
-`process_api.ml`. The first one deals with all the chapters of the
-manual, while the latter deals with the api generated with `ocamldoc`.
-They both use a common module `common.ml`.
-
-## How to build
-
-With dependencies to build the whole manual:
-```
-cd ..
-make web
-```
-
-Or, much faster if you know that `htmlman` is already up-to-date, from
-within the `html_processing` dir:
-
-```
-make
-```
-
-You need a working
-[`sass`](https://sass-lang.com/) CSS processor (tested with version
-"3.4.23").
-
-## How to browse
-
-From the `html_processing` directory:
-
-`firefox ../webman/api/index.html`
-
-`firefox ../webman/manual/index.html`
-
-## Debug
-
-```
-make DEBUG=1
-```
-
-By default all html files are re-created by `make`, but the javascript
-index `webman/api/index.js` and `webman/api/compilerlibref/index.js`
-are kept if they already exist. You can use `make clean` to delete all
-generated files.
-
-The javascript files in the `html_processing/js` dir add functionality
-but the web-manual is still browsable without them:
-
-- `scroll.js`: adds smooth scrolling in the html page, but only for
- near targets. The reason is that when you jump to another place in a
- text, if the jump is immediate (no scrolling), you easily get lost;
- for instance you usually don't even realize that the target of the
- link is just half a page below! Thus smooth scrolling helps
- _understanding the structure_ of the document. However, when the
- target is very far, the browser will scroll a huge amount of text
- very quickly, and this becomes useless, and even painful for the
- eye. Hence we disable smooth scrolling for far targets.
-
-- `search.js`: adds an 'as-you-type quick search widget', which
- recognize values, modules, and type signatures. It is very useful,
- but of course not strictly necessary.
+++ /dev/null
-(lang dune 1.11)
+++ /dev/null
-// NaVigation helpers for the manual, especially in mobile mode.
-
-// copyright 2020 San Vu Ngoc
-//
-
-// Permission to use, copy, modify, and/or distribute this software
-// for any purpose with or without fee is hereby granted, provided
-// that the above copyright notice and this permission notice appear
-// in all copies.
-
-// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
-// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
-// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
-// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
-// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
-// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
-// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
-// In mobile mode, both left navigation bar and top part menu are
-// closed by default.
-
-var MENU_HEIGHT = 0;
-
-function closeSidebarExceptSearch (event) {
- if ( event && event.target && event.target.classList.contains("api_search") ) {
- false;
- } else {
- closeSidebar ();
- true;
- }
-}
-
-// This closes the sidebar in mobile mode. This should have no effect
-// in desktop mode.
-function closeSidebar () {
- let bar = document.getElementById("sidebar");
- let w = getComputedStyle(bar).width;
- bar.style.left = "-" + w;
- document.body.removeEventListener("click", closeSidebarExceptSearch);
-}
-
-function toggleSidebar () {
- let bar = document.getElementById("sidebar");
- let l = getComputedStyle(bar).left;
- if (l == "0px") {
- closeSidebar ();
- } else {
- bar.style.left = "0px";
- setTimeout(function(){
- // Any click anywhere but in search widget will close the sidebar
- document.body.addEventListener("click", closeSidebarExceptSearch);
- }, 1000);
- }
-}
-
-function togglePartMenu () {
- let pm = document.getElementById("part-menu");
- let h = pm.offsetHeight;
- if ( h == 0 ) {
- pm.style.height = MENU_HEIGHT.toString() + "px";
- } else {
- pm.style.height = "0px";
- }
-}
-
-function partMenu () {
- let pm = document.getElementById("part-menu");
- if ( pm != null ) {
- MENU_HEIGHT = pm.scrollHeight; // This should give the true
- // height of the menu, even if
- // it was initialized to 0 in
- // the CSS (mobile view).
- // In desktop mode, the height is initially on "auto"; we
- // have to detect it in
- // order for the css animmations to work.
- // TODO update this when window is resized
- let currentHeight = pm.offsetHeight;
- pm.style.height = currentHeight.toString() + "px";
- let p = document.getElementById("part-title");
- if ( p != null ) {
- p.onclick = togglePartMenu;
- }
- }
-}
-
-function sideBar () {
- closeSidebar();
- let btn = document.getElementById("sidebar-button");
- btn.onclick = toggleSidebar;
-}
-
-// We add it to the chain of window.onload
-window.onload=(function(previousLoad){
- return function (){
- previousLoad && previousLoad ();
- partMenu ();
- sideBar ();
- }
-})(window.onload);
-
-
+++ /dev/null
-// Smooth scrolling only for near targets
-// copyright 2019-2020 San Vu Ngoc
-//
-
-// Permission to use, copy, modify, and/or distribute this software
-// for any purpose with or without fee is hereby granted, provided
-// that the above copyright notice and this permission notice appear
-// in all copies.
-
-// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
-// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
-// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
-// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
-// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
-// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
-// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
-
-// Goal: if a link is located at distance larger than MAX_DISTANCE, we
-// don't use a smooth scrolling.
-//
-// usage: to activate this, run setSmooth within window.onload:
-// window.onload = setSmooth
-// Here instead we create a loading chain because we have other things
-// to add window.onload later.
-
-const MAX_DISTANCE = 1000;
-const SCROLL_DURATION = 600;
-
-const url = window.location.pathname;
-var filename = url.substring(url.lastIndexOf('/')+1);
-if (filename == "") { filename = "index.html"; }
-
-function localLink (link) {
- return (link.length > 0 &&
- (link.charAt(0) == '#'
- || link.substring(0,filename.length) == filename));
-}
-
-//aaa.html#s%3Adatatypes --> s:datatypes
-function getId (link) {
- let uri = link.substring(link.lastIndexOf('#')+1);
- return decodeURIComponent(uri)
- // for instance decodeURIComponent("s%3Adatatypes") == 's:datatypes'
-}
-
-// Get absolute y position of element.
-// modified from:
-// https://www.kirupa.com/html5/get_element_position_using_javascript.htm
-// assuming effective licence CC0, see
-// https://forum.kirupa.com/t/get-an-elements-position-using-javascript/352186/3
-function getPosition(el) {
- let yPos = 0;
- while (el) {
- yPos += (el.offsetTop + el.clientTop);
- el = el.offsetParent;
- }
- return yPos;
-}
-
-// This function scans all "a" tags with a valid "href", and for those
-// that are local links (links within the same file) it adds a special
-// onclick function for smooth scrolling.
-function setSmooth () {
- let a = document.getElementsByTagName("a");
- let container = document.body.parentNode;
- let i;
- for (i = 0; i < a.length; i++) {
- let href = a[i].getAttribute("href");
- if (href != null && localLink(href)) {
- a[i].onclick = function () {
- let id = getId(href);
- let target = "";
- if ( id == "" ) {
- target = container;
- } else {
- target = document.getElementById(id); }
- if (! target) {
- console.log ("Error, no target for id=" + id);
- target = container; }
- let top = container.scrollTop;
- let dist = top - getPosition(target)
- if (Math.abs(dist) < MAX_DISTANCE) {
- target.scrollIntoView({ block: "start", inline: "nearest", behavior: 'smooth' });
- setTimeout(function () {
- location.href = href;
- // this will set the "target" property.
- }, SCROLL_DURATION);
- return false;
- // so we don't follow the link immediately
- }
- }
- }
- }
-}
-
-// We add it to the chain of window.onload
-window.onload=(function(previousLoad){
- return function (){
- previousLoad && previousLoad ();
- setSmooth ();
- }
-})(window.onload);
+++ /dev/null
-// Searching the OCAML API.
-// Copyright 2019-2020 San VU NGOC
-
-// Permission to use, copy, modify, and/or distribute this software
-// for any purpose with or without fee is hereby granted, provided
-// that the above copyright notice and this permission notice appear
-// in all copies.
-
-// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
-// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
-// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
-// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
-// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
-// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
-// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
-// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
-
-// Thanks @steinuil for help on deferred loading.
-// Thanks @osener, @UnixJunkie, @Armael for very helpful suggestions
-// Thanks to all testers!
-
-const MAX_RESULTS = 20;
-const MAX_ERROR = 10;
-const DESCR_INDEX = 4; // index of HTML description in index.js
-const SIG_INDEX = 6; // index of HTML signature in index.js
-const ERR_INDEX = 8; // length of each line in index.js. This is used
- // for storing the computed error, except if we
- // don't want description and type signature,
- // then ERR_INDEX becomes DESCR_INDEX.
-
-let indexState = 'NOT_LOADED';
-
-// return true if we are loading the index file
-function loadingIndex (includeDescr) {
- switch (indexState) {
- case 'NOT_LOADED':
- indexState = 'LOADING';
-
- const script = document.createElement('script');
- script.src = 'index.js';
- script.addEventListener('load', () => {
- indexState = 'HAS_LOADED';
- mySearch(includeDescr);
- });
- document.head.appendChild(script);
- return true;
-
- case 'LOADING':
- return true;
-
- case 'HAS_LOADED':
- return false;
- }
-}
-
-// line is a string array. We check if sub is a substring of one of
-// the elements of the array. The start/end of the string s are marked
-// by "^" and "$", and hence these chars can be used in sub to refine
-// the search. Case sensitive is better for OCaml modules. Searching
-// within line.join() is slightly more efficient that iterating 'line'
-// with .findIndex (my benchmarks show about 15% faster; except if we
-// search for the value at the beginning of line). However it might
-// use more memory.
-function hasSubString (sub, line) {
- let lineAll = "^" + line.join("$^") + "$";
- return (lineAll.includes(sub));
-}
-
-// Check if one of the strings in subs is a substring of one of the
-// strings in line.
-function hasSubStrings (subs, line) {
- let lineAll = "^" + line.join("$^") + "$";
- return (subs.findIndex(function (sub) {
- return (lineAll.includes(sub))}) !== -1);
-}
-// Error of sub being a substring of s. Best if starts at 0. Except
-// for strings containing "->", which is then best if the substring is
-// at the most right-hand position (representing the "return type").
-// markers "^" and "$" for start/end of string can be used: if they
-// are not satisfied, the MAX_ERROR is returned.
-function subError (sub, s) {
- let StartOnly = false;
- let EndOnly = false;
- if (sub.length>1) {
- if (sub[0] == "^") {
- StartOnly = true;
- sub = sub.substring(1);
- }
- if (sub[sub.length - 1] == "$") {
- EndOnly = true;
- sub = sub.substring(0, sub.length - 1);
- }
- }
- let err = s.indexOf(sub);
- if (err == -1 ||
- (StartOnly && err != 0) ||
- (EndOnly && err != s.length - sub.length)) {
- err = MAX_ERROR;
- } else {
- if ( sub.includes("->") ) {
- err = Math.min(s.length - sub.length - err,1); // 0 or 1
- // err = 0 if the substring is right-aligned
- } else {
- err = Math.min(err,1); // 0 or 1
- // err = 0 if the substring
- }
- err += Math.abs((s.length - sub.length) / s.length);}
- return (err)
- // between 0 and 2, except if MAX_ERROR
-}
-
-// Minimal substring error. In particular, it returns 0 if the string
-// 'sub' has an exact match with one of the strings in 'line'.
-function subMinError (sub, line) {
- let errs = line.map(function (s) { return subError (sub, s); });
- return Math.min(...errs); // destructuring assignment
-}
-
-
-function add (acc, a) {
- return acc + a;
-}
-
-// for each sub we compute the minimal error within 'line', and then
-// take the average over all 'subs'. Thus it returns 0 if each sub has
-// an exact match with one of the strings in 'line'.
-function subsAvgMinError (subs, line) {
- let errs = subs.map(function (sub) { return subMinError (sub, line); });
- return errs.reduce(add,0) / subs.length;
-}
-
-function formatLine (line) {
- let li = '<li>';
- let html = `<code class="code"><a href="${line[1]}"><span class="constructor">${line[0]}</span></a>.<a href="${line[3]}">${line[2]}</a></code>`;
- if (line.length > 5) {
- if ( line[ERR_INDEX] == 0 ) {
- li = '<li class="match">';
- }
- html = `<pre>${html} : ${line[SIG_INDEX]}</pre>${line[DESCR_INDEX]}`; }
- return (li + html + "</li>\n");
-}
-
-// Split a string into an array of non-empty words, or phrases
-// delimited by quotes ("")
-function splitWords (s) {
- let phrases = s.split('"');
- let words = [];
- phrases.forEach(function (phrase,i) {
- if ( i%2 == 0 ) {
- words.push(...phrase.split(" "));
- } else {
- words.push(phrase);
- }
- });
- return (words.filter(function (s) {
- return (s !== "")}));
-}
-
-// The initial format of an entry of the GENERAL_INDEX array is
-// [ module, module_link,
-// value, value_link,
-// html_description, bare_description,
-// html_signature, bare_signature ]
-
-// If includeDescr is false, the line is truncated to its first 4
-// elements. When searching, the search error is added at the end of
-// each line.
-
-// In order to reduce the size of the index.js file, one could create
-// the bare_description on-the-fly using .textContent, see
-// https://stackoverflow.com/questions/28899298/extract-the-text-out-of-html-string-using-javascript,
-// but it would probably make searching slower (haven't tested).
-function mySearch (includeDescr) {
- if (loadingIndex (includeDescr)) {
- return;
- }
- let text = document.getElementById('api_search').value;
- let results = [];
- let html = "";
- let count = 0;
- let err_index = DESCR_INDEX;
-
- if (text !== "") {
- if ( includeDescr ) {
- err_index = ERR_INDEX;
- }
-
- let t0 = performance.now();
- let exactMatches = 0;
- results = GENERAL_INDEX.filter(function (line) {
- // We remove the html hrefs and add the Module.value complete name:
- let cleanLine = [line[0], line[2], line[0] + '.' + line[2]];
- line.length = err_index; // This truncates the line:
- // this removes the description part if includeDescr =
- // false (which modifies the lines of the GENERAL_INDEX.)
- if ( includeDescr ) {
- cleanLine.push(line[DESCR_INDEX+1]);
- cleanLine.push(line[SIG_INDEX+1]);
- // add the description and signature (txt format)
- }
- let error = MAX_ERROR;
- if ( exactMatches <= MAX_RESULTS ) {
- // We may stop searching when exactMatches >
- // MAX_RESULTS because the ranking between all exact
- // matches is unspecified (depends on the construction
- // of the GENERAL_INDEX array)
- if ( hasSubString(text, cleanLine) ) {
- error = subMinError(text, cleanLine);
- // one could merge hasSubString and subMinError
- // for efficiency
- }
- if ( error != 0 && includeDescr ) {
- let words = splitWords(text);
- if ( hasSubStrings(words, cleanLine) ) {
- // if there is no exact match for text and
- // includeDescr=true, we also search for all separated
- // words
- error = subsAvgMinError(words, cleanLine);
- }
- }
- if ( error == 0 ) { exactMatches += 1; }
- }
- line[err_index] = error;
- // we add the error as element #err_index
- return ( error != MAX_ERROR );
- });
- // We sort the results by relevance:
- results.sort(function(line1, line2) {
- return (line1[err_index] - line2[err_index])});
- count = results.length;
- console.log("Search results = " + (count.toString()));
- results.length = Math.min(results.length, MAX_RESULTS);
- html = "no results";
- }
- // inject new html
- if (results.length > 0) {
- html = "<ul>";
- function myIter(line, index, array) {
- html = html + formatLine(line);
- }
- results.forEach(myIter);
- html += "</ul>";
- if (count > results.length) {
- html += "(...)";
- }
- }
- document.getElementById("search_results").innerHTML = html;
-}
+++ /dev/null
-// SCSS Module for manual.scss and style.scss
-
-// set this to true for integration into the ocaml.org wesite
-$ocamlorg:false;
-/* ocaml logo color */
-$logocolor:#ec6a0d;
-$logo_height:67px;
-
-@if $ocamlorg {
- .container {
- margin-left:0;
- margin-right:0;
- }
-}
-
-
-/* Fonts */
-@import url(https://fonts.googleapis.com/css?family=Fira+Mono:400,500);
-@import url(https://fonts.googleapis.com/css?family=Noticia+Text:400,400i,700);
-@import url(https://fonts.googleapis.com/css?family=Fira+Sans:400,400i,500,500i,600,600i,700,700i);
-
-$font-sans: "Fira Sans", Helvetica, Arial, sans-serif;
-$font-mono: "Fira Mono", courier, monospace;
-$font-serif: "Noticia Text", Georgia, serif;
-
-/* Reset */
-.pre,a,b,body,code,div,em,form,h1,h2,h3,h4,h5,h6,header,html,i,img,li,mark,menu,nav,object,output,p,pre,s,section,span,time,ul,td,var{
- margin:0;
- padding:0;
- border:0;
- font-size:inherit;
- font:inherit;
- line-height:inherit;
- vertical-align:baseline;
- text-align:inherit;
- color:inherit;
- background:0 0
-}
-*,:after,:before{
- box-sizing:border-box
-}
-
-html.smooth-scroll {
- scroll-behavior:smooth;
-}
-
-@media (prefers-reduced-motion: reduce) {
- html {
- scroll-behavior:auto;
- }
-}
-
-body{
- font-family: $font-sans;
- text-align:left;
- color:#333;
- background:#fff
-}
-
-html {
- font-size: 16px;
- .dt-thefootnotes{
- height:1ex;
- }
- .footnotetext{
- font-size: 13px;
- }
-}
-
-#sidebar-button{
- float:right;
- cursor: context-menu;
- span{
- font-size:28px;
- }
- display:none;
- }
-
-.content, .api {
- &>header {
- margin-bottom: 30px;
- nav {
- font-family: $font-sans;
- }
- }
-}
-
-@mixin content-frame {
- max-width:90ex;
- margin-left:calc(10vw + 20ex);
- margin-right:4ex;
- margin-top:20px;
- margin-bottom:50px;
- font-family: $font-serif;
- line-height:1.5
-}
-
-/* Menu in the left bar */
-@mixin nav-toc {
- display: block;
- padding-top: 10px;
- position:fixed;
- @if $ocamlorg {
- top:0;
- } @else {
- top:$logo_height;
- }
- bottom:0;
- left:0;
- max-width:30ex;
- min-width:26ex;
- width:20%;
- background:linear-gradient(to left,#ccc,transparent);
- overflow:auto;
- color:#1F2D3D;
- padding-left:2ex;
- padding-right:2ex;
- .toc_version {
- font-size:smaller;
- text-align:right;
- a {
- color:#888;
- }
- }
- ul{
- list-style-type:none;
- li{
- margin:0;
- ul{
- margin:0
- }
- li{
- border-left:1px solid #ccc;
- margin-left:5px;
- padding-left:12px;
- }
- a {
- font-family: $font-sans;
- font-size:.95em;
- color:#333;
- font-weight:400;
- line-height:1.6em;
- display:block;
- &:hover {
- box-shadow:none;
- background-color: #edbf84;}
- }
- &.top a {
- color: #848484;
- &:hover {
- background-color: unset;
- text-decoration: underline;
- }
- }
- }
- }
- &>ul>li {
- margin-bottom:.3em;
- &>a { /* First level titles */
- font-weight:500;}
- }
-}
-
-/* OCaml Logo */
-@mixin brand {
- @if $ocamlorg {
- display:none;
- }
- top:0;
- height:$logo_height;
- img{
- margin-top:14px;
- height:36px
- }
-}
-
-@mixin mobile {
- .api, .content{
- margin:auto;
- padding:2em;
- h1 {
- margin-top:0;
- }
- }
-}
-
-@mixin nav-toc-mobile {
- position:static;
- width:auto;
- min-width:unset;
- border:none;
- padding:.2em 1em;
- border-radius:5px 0;
- &.brand {border-radius: 0 5px;}
-}
-
-/* Header is used as a side-bar */
-@mixin header-mobile {
- margin-bottom:0;
- position:fixed;
- left:-10000px; /* initially hidden */
- background-color:#ffefe7;
- transition:left 0.4s;
- top:0;
- max-width:calc(100% - 2em);
- max-height: 100%;
- overflow-y: auto;
- box-shadow:0.4rem 0rem 0.8rem #bbb;
-}
-
-@mixin sidebar-button {
- #sidebar-button{
- display:inline-block;
- position:fixed;
- top:1.5em;
- right:1ex;
- }
-}
-
-/* Print adjustements. */
-/* This page can be nicely printed or saved to PDF (local version) */
-
-@media print {
- body {
- color: black;
- background: white;
- }
- body nav:first-child {
- position: absolute;
- background: transparent;
- }
- .content, .api {
- nav.toc {
- margin-right: 1em;
- float: left;
- position: initial;
- background: #eee;
- }
- margin-left: 3em;
- margin-right: 3em;
- }
-}
-
-@mixin caret {
- content:"▶";
- color:$logocolor;
- font-size:smaller;
- margin-right:4px;
- margin-left:-1em
-}
-
-@mixin disc {
- content:"●";
- color:$logocolor;
- margin-right:4px;
- margin-left:-1em;
- font-family: $font-sans;
- font-size:13px;
- vertical-align:1px;
-}
-
-@mixin diamond {
- content:"◆";
- color:$logocolor;
- margin-right:4px;
- margin-left:-1em;
- font-family: $font-sans;
- font-size:14px;
- vertical-align:1px;
-}
+++ /dev/null
-// SOURCE FILE
-
-/* If the above line does not say "SOURCE FILE", then do not edit. It */
-/* means this file is generated from [sass manual.scss] */
-
-/* CSS file for the Ocaml manual */
-
-/* San Vu Ngoc, 2019-2020 */
-
-@import "common";
-@charset "UTF-8";
-
-.content{
- @include content-frame;
- #part-title{
- float:left;
- color:#777;
- cursor: context-menu;
- font-family: $font-sans;
- span{ /* menu icon */
- font-size:22px;
- margin-right:1ex;
- }
- }
- ul{list-style:none;}
- ul.itemize li::before{@include disc;}
-
- /* When the TOC is repeated in the main content */
- ul.ul-content {
- }
- /* navigation links at the bottom of page */
- .bottom-navigation {
- margin-bottom:1em;
- a.next {
- float: right;
- }
- }
- .copyright{
- font-size:smaller;
- display:inline-block;
- }
-}
-.index{ /* index.html */
- ul{
- list-style: none;
- li {
- margin-left: 0.5ex;
- span {
- color:#c88b5f;
- }
- span.c003{
- color:#564233;
- }
- }
- }
- /* only for Contents/Foreword in index.html: */
- ul.ul-content li::before{
- @include disc;
- margin-left: 0;
- }
- /* table of contents: (manual.001.html): */
- ul.toc ul.toc ul.toc{
- font-size:smaller;
- }
- section>ul>li>a{ /* for Parts title */
- font-family: $font-sans;
- font-size:larger;
- background:linear-gradient(to left,#fff 0,#ede8e5 100%);
- }
- section>ul>li>ul>li:hover{ /* Chapters */
- background:linear-gradient(to left,#fff 0,#ede8e5 100%);
- }
- section>ul>li>ul>li{
- transition: background 0.5s;
- }
-}
-b{
- font-weight:500
-}
-em,i{
- font-style:italic
-}
-.ocaml {
- background:#f7f5f4;
-}
-.ocaml,pre{
- margin-top:.8em;
- margin-bottom:1.2em
-}
-.ocaml .pre{
- white-space:pre
-}
-p,ul{
- margin-top:.5em;
- margin-bottom:1em
-}
-ul{
- list-style-position:outside
-}
-ul>li{
- margin-left:22px
-}
-li>:first-child{
- margin-top:0
-}
-.left{
- text-align:left
-}
-.right{
- text-align:right
-}
-a{
- text-decoration:none;
- color:#92370a
-}
-a:hover{
- box-shadow:0 1px 0 0 #92370a
-}
-:target{
- background-color:rgba(255,215,181,.3)!important;
- box-shadow:0 0 0 1px rgba(255,215,181,.8)!important;
- border-radius:1px
-}
-:hover>a.section-anchor{
- visibility:visible
-}
-a.section-anchor:before{
- content:"#"
-}
-a.section-anchor:hover{
- box-shadow:none;
- text-decoration:none;
- color:#555
-}
-a.section-anchor{
- visibility:hidden;
- position:absolute;
- margin-left:-1.3em;
- font-weight:400;
- font-style:normal;
- padding-right:.4em;
- padding-left:.4em;
- color:#d5d5d5
-}
-.h10,.h7,.h8,.h9,h1,h2,h3,h4,h5,h6{
- font-family: $font-sans;
- font-weight:400;
- margin:.5em 0 .5em 0;
- padding-top:.1em;
- line-height:1.2;
- overflow-wrap:break-word
-}
-h1{
- font-weight:500;
- font-size:2.441em;
- margin-top:1.214em
-}
-h1{
- font-weight:500;
- font-size:1.953em;
- box-shadow:0 1px 0 0 #ddd
-}
-h2{
- font-size:1.563em
-}
-h3{
- font-size:1.25em
-}
-h1 code{
- font-size:inherit;
- font-weight:inherit
-}
-h2 code{
- font-size:inherit;
- font-weight:inherit
-}
-h3 code{
- font-size:inherit;
- font-weight:inherit
-}
-h3 code{
- font-size:inherit;
- font-weight:inherit
-}
-h4{
- font-size:1.12em
-}
-h2, h3, h4, h5 {
- font-weight: 500;
-}
-.ocaml,.pre,code,pre,tt{
- font-family: $font-mono;
- font-weight:400
-}
-.pre,pre{
- border-left:4px solid #e69c7f;
- overflow-x:auto;
- padding-left:1ex
-}
-.ocaml .pre{
- overflow-x:initial;
-}
-.caml-example .ocaml{
- overflow-x:auto;
-}
-li code,p code{
- background-color:#f6f8fa;
- color:#0d2b3e;
- border-radius:3px;
- padding:0 .3ex
-}
-.pre .code,.pre.code,pre code{
- background-color:inherit
-}
-p a>code{
- color:#92370a}
-.pre code.ocaml,.pre.code.ocaml,pre code.ocaml{
- font-size:.893rem}
-.keyword,.ocamlkeyword{
- font-weight:500}
-section+section{
- margin-top:25px}
-
-/* Table of Contents in the Left-hand sidebar */
-nav.toc{
- @include nav-toc;
- &.brand{
- @include brand;
- }
- .toc_title{
- display:block;
- margin:.5em 0 1.414em}
-/* .toc_title a{ */
-/* color:#777; */
-/* font-size:1em; */
-/* line-height:1.2; */
- /* font-weight:500} */
-
-}
-.tableau {
- table {
- border-collapse: collapse;
- }
- td {
- background:#f8f7f6;
- border:1px solid #ccc;
- padding-left:3px;
- padding-right:3px;
- }
-}
-
-pre{
- background:linear-gradient(to left,#fff 0,#ede8e5 100%)
-}
-code.caml-output.ok,div.caml-output.ok{
- color:#045804
-}
-code.caml-output.error,div.caml-output.error{
- color:#ff4500;
- white-space:normal
-}
-.chapter span,.tutorial span,.maintitle h1 span{
- color:$logocolor
-}
-h1 span{
- color: #d28853;
-}
-blockquote.quote{
- /*font-size: smaller;*/
- hr{
- display:none;
- }
-}
-#part-menu{
- font-family: $font-sans;
- text-align:right;
- list-style:none;
- overflow-y:hidden;
- transition:height 0.3s;
-}
-#part-menu li.active a{
- color:#000;
- &::before{@include diamond}
-}
-.center {
- text-align: center;
- margin-left: auto;
- margin-right: auto;
-}
-.display {
- margin: 0 auto;
-}
-.c001 {
- border-spacing: 6px;
- border-collapse: separate;
-}
-span.c003{
- color:#564233;
- font-family: $font-mono;
- border-radius:6px
-}
-div.caml-example.toplevel code.caml-input::before,
-div.caml-example.toplevel div.caml-input::before{
- /* content:"#"; */ /* pre-4.11 */
- color:#888
-}
-span.number{
- padding-right: 1ex;
-}
-span.c004, span.c005, span.c007 {
- font-family: $font-mono;
-}
-span.c003, span.c005 {
- color: rgba(91, 33, 6, 0.87);
-}
-span.c002{
- color:#888
-}
-span.c006{
- font-weight:700;
- color:#564233;
- font-family: $font-mono;
-}
-.c008 {
- font-family: $font-sans;
-}
-span.c010 {
- font-style: italic;
-}
-span.authors{
- font-style:italic;
- background-color:inherit
-}
-span.c011 {
- font-style: italic;
-}
-.c012 {
- font-style: italic;
-}
-span.c013{
- font-style: italic;
-}
-.center table {
- margin-left: inherit;
- margin-right: inherit;
-}
-td .c014 {
- font-weight: bold;
-}
-.c016 {
- text-align: center;
-}
-.cellpadding1 tr td {
- padding: 1px 4px;
-}
-.caml-input{
- span.ocamlkeyword{
- font-weight:500;
- color:#444
- }
- span.ocamlhighlight{
- font-weight:500;
- text-decoration:underline
- }
- span.id{
- color:#523b74
- }
- span.ocamlstring,.caml-input span.string{
- color:#df5000
- }
- span.comment, .caml-input span.ocamlcomment{
- color:#969896
- }
-}
-.ocaml span.ocamlerror{
- font-weight:500
-}
-
-
-/* Mobile */
-@media only screen and (max-width:95ex){
- @include mobile;
- @include sidebar-button;
- .content #part-menu{
- display:inline-block;
- height:0;
- width:100%;
- }
- nav.toc{
- @include nav-toc-mobile;
- }
- header{
- @include header-mobile;
- }
-}
+++ /dev/null
-// SOURCE FILE
-
-/* If the above line does not say "SOURCE FILE", then do not edit. It */
-/* means this file is generated from [sass style.scss] */
-
-/* CSS file for the Ocaml API. San Vu Ngoc 2019 */
-
-// TODO: the ocamldoc output of Functors like in
-// compilerlibref/4.08/Arg_helper.Make.html
-// is not easy to style... without breaking other tables.
-
-@import "common";
-@charset "UTF-8";
-
-// tables are difficult to style, be careful.
-// These settings should apply to the main index tables
-// (like "index_values.html"), which do not have any particular class.
-// These tables have two columns.
-.api>table {
- word-break: break-word;
- // this is unfortunately due to some very long names in Internal modules
- td.module,
- td:first-child {
- width: 33%;
- }
- td:nth-child(2) {
- width: 65%;
- }
- td[align="left"] {
- // for the "Parameter" column of module signatures like
- // Arg_helper.Make.html, which unfortunately have no class
- // either.
- word-break: normal;
- }
- td[align="left"]:first-child {
- width: 1%;
- }
-}
-
-.api {
- // font-size: 16px;
- // font-family: $font-sans;
- // text-align: left;
- // color: #333;
- // background: #FFFFFF;
- table {
- // tables are difficult to style, be careful
- border-collapse: collapse;
- border-spacing: 0;
- thead {
- background: rgb(228, 217, 211);
- }
- /* must be same as <pre>: */
- background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
- width: 100%;
- td {
- padding-left: 1ex;
- padding-right: 1ex;
- /*float: left;*/
- }
- /* add some room at the end of the table */
- tr:last-child td {
- padding-bottom: 7px;
- }
- }
- // Tables are used for describing types, in particular union types:
- table.typetable {
- width: 100%;
- word-break: normal;
- box-shadow: none;
- td {
- float: left;
- }
- td:nth-child(2) {
- width: 37%;
- code {
- white-space: pre-line;
- }
- }
- td:last-child {
- width: calc(100% - 1.3em);
- // cf: CamlinternalFormatBasics.html
- // the 1.3em is related to the 1em below
- }
- td:first-child {
- width: 1em;
- }
- td:nth-child(4).typefieldcomment {
- /* this should be the column with the type */
- width: 60%;
- /* not optimal, see: Format.html#symbolic
- but leaving it automatic is not always good either: see: Arg.html */
- }
- }
-
- // for functor signature
- table.paramstable {
- word-break: normal;
- td {
- code {
- white-space: pre-wrap;
- }
- }
- td:first-child, td:nth-child(2) {
- width: 1em; // second column should contain only
- // ":". First one will adapt to size.
- }
- }
-
- .sig_block {
- border-left: 4px solid #e69c7f;
- padding-left: 1em;
- background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
- // PROBLEM the sig_block ends too soon, it should actually
- // include the "end)" line ==> REPORT THIS
- // (eg: compilerlibref/Arg_helper.html)
- pre {
- margin-top: 0;
- background: none;
- border-left: 0;
- }
- }
- pre .sig_block {
- margin-bottom: 0; // see above
- border-left: 0;
- }
-
- *, *:before, *:after {
- box-sizing: border-box;
- }
-
- @include content-frame;
-
- /* Basic markup elements */
-
- b, strong {
- font-weight: 600;
- }
- i, em {
- font-style: italic;
- }
- sup {
- vertical-align: super;
- }
- sub {
- vertical-align: sub;
- }
- sup, sub {
- font-size: 12px;
- line-height: 0;
- margin-left: 0.2ex;
- }
- pre {
- margin-top: 0.8em;
- margin-bottom: 0;
- }
- p, ul, ol {
- margin-top: 0.5em;
- margin-bottom: 1em;
- }
- ul, ol {
- list-style-position: outside
- }
- ul>li {
- margin-left: 22px;
- }
- ol>li {
- margin-left: 27.2px;
- }
- li>*:first-child {
- margin-top: 0
- }
-
- /* Text alignements, this should be forbidden. */
-
- .left {
- text-align: left;
- }
- .right {
- text-align: right;
- }
- .center {
- text-align: center;
- }
- /* Links and anchors */
- a {
- text-decoration: none;
- color: #92370A;
- /* box-shadow: 0 1px 0 0 #d8b68b; */
- }
- a:hover {
- box-shadow: 0 1px 0 0 #92370A;
- }
- td a:hover {
- background: white;
- }
- /* Linked highlight */
- *:target {
- /*box-shadow: 0 0px 0 1px rgba(255, 215, 181, 0.8) !important;*/
- border-radius: 1px;
- /*border-bottom: 4px solid rgb(255, 215, 181);*/
- box-shadow: 0 4px 0 0px rgb(255, 215, 181);
- z-index: 0;
- @if $ocamlorg {
- /* Because of fixed banner in the ocaml.org site, we have to offset the targets. See https://stackoverflow.com/questions/10732690/offsetting-an-html-anchor-to-adjust-for-fixed-header */
- padding-top: 85px;
- margin-top: -85px;
- }
- }
-
-
- h2:target {
- /* background: linear-gradient(to bottom, rgb(253, 252, 252) 0%, rgba(255, 215, 181, 0.3) 100%) !important; */
- /* transition: 300ms; this prevents margin-top:-80 to work... */
- }
-
- *:hover>a.section-anchor {
- visibility: visible;
- }
-
- a.section-anchor:before {
- content: "#"
- }
-
- a.section-anchor:hover {
- box-shadow: none;
- text-decoration: none;
- color: #555;
- }
-
- a.section-anchor {
- visibility: hidden;
- position: absolute;
- /* top: 0px; */
- /* margin-left: -3ex; */
- margin-left: -1.3em;
- font-weight: normal;
- font-style: normal;
- padding-right: 0.4em;
- padding-left: 0.4em;
- /* To remain selectable */
- color: #d5d5d5;
- }
-
- .spec > a.section-anchor {
- margin-left: -2.3em;
- padding-right: 0.9em;
- }
-
- .xref-unresolved {
- color: #92370A
- }
- .xref-unresolved:hover {
- box-shadow: 0 1px 0 0 #CC6666;
- }
-
- /* Section and document divisions.
- Until at least 4.03 many of the modules of the stdlib start at .h7,
- we restart the sequence there like h2 */
-
- h1, h2, h3, h4, h5, h6, .h7, .h8, .h9, .h10 {
- font-family: $font-sans;
- font-weight: 400;
- margin: 0.5em 0 0.5em 0;
- padding-top: 0.1em;
- line-height: 1.2;
- overflow-wrap: break-word;
- }
-
- h1 {
- margin-top: 1.214em;
- margin-bottom: 19px;
- font-weight: 500;
- font-size: 1.953em;
- box-shadow: 0 1px 0 0 #ddd;
- }
-
- h2 {
- font-size: 1.563em;
- margin: 1em 0 1em 0
- }
-
- h3 {
- font-size: 1.25em;
- }
-
- small, .font_small {
- font-size: 0.8em;
- }
-
- h1 code, h1 tt {
- font-size: inherit;
- font-weight: inherit;
- }
-
- h2 code, h2 tt {
- font-size: inherit;
- font-weight: inherit;
- }
-
- h3 code, h3 tt {
- font-size: inherit;
- font-weight: inherit;
- }
-
- h3 code, h3 tt {
- font-size: inherit;
- font-weight: inherit;
- }
-
- h4 {
- font-size: 1.12em;
- }
-
-
- /* Preformatted and code */
-
- tt, code, pre {
- font-family: $font-mono;
- font-weight: 400;
- }
-
- pre {
- border-left: 4px solid #e69c7f;
- white-space: pre-wrap;
- word-wrap: break-word;
- padding-left: 1ex;
- }
-
- p code, li code { /* useful ? */
- background-color: #ebf2f9; /*#f6f8fa;*/
- color: #0d2b3e;
- border-radius: 3px;
- padding: 0 0.3ex;
- white-space: pre-wrap; // utile seulement dans la table index_values? (attention à bootstrap.css)
- }
-
- pre code {
- background-color: inherit;
- }
-
- p a > code {
- color: #92370A;
- }
-
- /* Code blocks (e.g. Examples) */
-
- pre code.ocaml {
- font-size: 0.893rem;
- }
-
- /* Code lexemes */
-
- .keyword {
- font-weight: 500;
- color: inherit;
- }
-
- /* Module member specification */
-
- .spec:not(.include), .spec.include details summary {
- background: linear-gradient(to left, rgb(253, 252, 252) 0%, rgb(234, 246, 250) 100%);
- border-radius: 3px;
- border-left: 4px solid #5c9cf5;
- border-right: 5px solid transparent;
- padding: 0.35em 0.5em;
- }
-
- .spec.include details summary:hover {
- background-color: #ebeff2;
- }
-
- dl, div.spec, .doc, aside {
- margin-bottom: 20px;
- }
-
- dl > dd {
- padding: 0.5em;
- }
-
- dd> :first-child {
- margin-top: 0;
- }
-
- dd > p:first-child > code:first-child {
- color: teal;
- }
-
- dl:last-child, dd> :last-child, aside:last-child, article:last-child {
- margin-bottom: 0;
- }
-
- dt+dt {
- margin-top: 15px;
- }
-
- section+section, section > header + dl {
- margin-top: 25px;
- }
-
- .spec.type .variant {
- margin-left: 2ch;
- }
- .spec.type .variant p {
- margin: 0;
- font-style: italic;
- }
- .spec.type .record {
- margin-left: 2ch;
- }
- .spec.type .record p {
- margin: 0;
- font-style: italic;
- }
-
- div.def {
- margin-top: 0;
- text-indent: -2ex;
- padding-left: 2ex;
- }
-
- div.def+div.doc {
- margin-left: 1ex;
- margin-top: 2.5px
- }
-
- div.doc>*:first-child {
- margin-top: 0;
- }
-
- /* The elements other than heading should be wrapped in <aside> elements. */
- /* heading, body>p, body>ul, body>ol, h3, h4, body>pre { */
- /* margin-bottom: 30px; */
- /* } */
-
- /* Collapsible inlined include and module */
-
- .spec.include details {
- position: relative;
- }
-
- .spec.include details:after {
- z-index: -100;
- display: block;
- content: " ";
- position: absolute;
- border-radius: 0 1ex 1ex 0;
- right: -20px;
- top: 1px;
- bottom: 1px;
- width: 15px;
- background: rgba(0, 4, 15, 0.05);
- box-shadow: 0 0px 0 1px rgba(204, 204, 204, 0.53);
- }
-
- .spec.include details summary {
- position: relative;
- margin-bottom: 20px;
- cursor: pointer;
- outline: none;
- }
-
- /* FIXME: Does not work in Firefox. */
- details summary::-webkit-details-marker {
- color: #888;
- transform: scaleX(-1);
- position: absolute;
- top: calc(50% - 5px);
- height: 11px;
- right: -29px;
- }
-
- td.doc *:first-child {
- margin-top: 0em
- }
-
- /* @ tags */
-
- ul.at-tag {
- list-style-type: none;
- margin-left: 0;
- padding: 0;
- }
-
- ul.at-tag li {
- margin-left: 0;
- padding: 0;
- }
-
- ul.at-tag li p:first-child {
- margin-top: 0
- }
-
- /* FIXME remove */
-
- span.at-tag {
- font-weight: bold
- }
-
- span.warning,
- .at-tag.deprecated {
- font-weight: normal;
- color: #8eaf20;
- }
-
- span.warning {
- margin-right: 1ex;
- }
-
- .at-tag.raise {
- font-weight: bold;
- }
-
- /* FIXME random other things to review. */
-
- .heading {
- margin-top: 10px;
- border-bottom: solid;
- border-width: 1px;
- border-color: #DDD;
- text-align: right;
- font-weight: normal;
- font-style: italic;
- }
-
- .heading+.sig {
- margin-top: -20px;
- }
-
- .heading+.parameters {
- margin-top: -20px;
- }
-
- /* Odig package index */
-
- .by-name ol, .by-tag ol, .errors ol {
- list-style-type: none;
- margin-left: 0;
- }
-
- .by-name ol ol, .by-tag ol ol {
- margin-top: 0;
- margin-bottom: 0
- }
-
- .by-name li, .by-tag li, .errors li {
- margin-left: 0;
- }
-
- .by-name .version {
- font-size: 10px;
- color: #AAA
- }
-
- .by-name nav {
- margin-bottom: 10px
- }
-
- .by-name nav a {
- text-transform: uppercase;
- font-size: 18px;
- margin-right: 1ex;
- color: #222;
- display: inline-block;
- }
-
- .by-tag nav a {
- margin-right: 1ex;
- color: #222;
- display: inline-block;
- }
-
- .by-tag>ol>li {
- margin-top: 10px;
- }
-
- .by-tag>ol>li>span, .by-tag>ol>li>ol, .by-tag>ol>li>ol>li {
- display: inline-block;
- margin-right: 1ex;
- }
-
- /* Odig package page */
-
- .package nav {
- display: inline;
- font-size: 14px;
- font-weight: normal;
- }
-
- .package .version {
- font-size: 14px;
- }
-
- h1+.modules, h1+.sel {
- margin-top: 10px
- }
-
- .sel {
- font-weight: normal;
- font-style: italic;
- font-size: 14px;
- margin-top: 20px;
- }
-
- .sel+.modules {
- margin-top: 10px;
- margin-bottom: 20px;
- margin-left: 1ex;
- }
-
- .modules {
- margin: 0;
- }
-
- .modules .module {
- min-width: 8ex;
- padding-right: 2ex
- }
-
- .package.info {
- margin: 0;
- }
-
- .package.info td:first-child {
- font-style: italic;
- padding-right: 2ex;
- }
-
- .package.info ul {
- list-style-type: none;
- display: inline;
- margin: 0;
- }
-
- .package.info li {
- display: inline-block;
- margin: 0;
- margin-right: 1ex;
- }
-
- #info-authors li, #info-maintainers li {
- display: block;
- }
-
- /* lists in the main text */
- ul.itemize {
- list-style: none;
- }
-
- ul.itemize li::before {
- content: "▶";
- color: $logocolor;
- margin-right: 4px;
- margin-left: -1em;
- }
-
- /* Sidebar and TOC */
-
- /*.toc ul:before */
- .toc_title
- {
- display: block;
- /*content: "Contents";*/
- /* text-transform: uppercase; */
- margin: 1.414em 0 0.5em;
- }
-
- .toc_title a {
- color: #777;
- font-size: 1em;
- line-height: 1.2;
- font-weight: 500;
- }
-
- .toc {
- @include nav-toc;
- &.brand {
- @include brand;
- }
- }
-
- .toc input#api_search {
- width: 85%;
- font-family: inherit;
- }
-
- .toc #search_results {
- font-size: smaller;
- ul {
- li {
- margin-bottom: 0;
-
- }
- a {
- display: inline-block;
- padding-left: 0;
- }
- }
- }
-
- .ocaml {
- background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%);
- }
-
- span.arrow {
- font-size: 20px;
- line-height: 8pt;
- font-family: $font-mono;
- }
- header dl dd, header dl dt {
- display: inline-block;
- }
- pre {
- background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
- }
-
- #search_results li.match::before {
- content: "▶";
- font-size: smaller;
- color: $logocolor;
- float: left;
- margin-left: -3ex;
- }
-
- code.caml-example,
- div.caml-example, div.toplevel {
- /* background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%); */
- }
-
- div.caml-output.ok,
- code.caml-output.ok,
- span.c006 {
- color: #045804;
- }
-
- code.caml-output.error,
- div.caml-output.error {
- color: orangered;
- }
- .tutorial span {
- color: $logocolor;
- }
-
- ul.tutos_menu {
- font-family: $font-sans;
- text-align: right;
- list-style: none;
- }
-
- ul.tutos_menu li.active a {
- color: black;
- }
-
- nav.toc {
-
- }
-
- span.c003 {
- font-family: $font-mono;
- background-color: #f3ece6;
- border-radius: 6px;
- }
-
- div.caml-example.toplevel div.caml-input::before,
- div.caml-example.toplevel code.caml-input::before
- {
- content:"#";
- color:#888;
- }
-
- span.c004 {
- color: #888;
- }
-
- span.c009 {
- font-style: italic;
- }
-
- code span.keyword,
- .caml-input span.kw {
- font-weight: 500;
- color: #444;
- }
-
- code span.keywordsign {
- color:#92370a;
- }
-
- .caml-input span.kw1 {
- font-weight: 500;
- color: #777;
- }
-
- code span.constructor,
- .caml-input span.kw2 {
- color: #8d543c;
- }
-
- .caml-input span.numeric {
- color: #0086b3;
- }
-
- .caml-input span.id {
- color: #523b74;
- }
-
- code span.string,
- .caml-input span.string {
- color: #df5000;
- }
-
- .caml-input span.comment {
- color: #969896;
- }
-
- .copyright {
- margin-top: 1em;
- font-size: smaller;
- }
-
- .dt-thefootnotes {
- float: left;
- }
-
- ul.info-attributes {
- margin-top: 0ex;
- margin-bottom: 1.5em;
- list-style: none;
- }
-
- /* pour l'API */
- hr {
- margin-bottom: 2em;
- visibility: hidden;
- }
-
- code.type {
- color: #8d543c;
- }
-
- td div.info p {
- margin: 0;
- box-shadow: 0 1px 0 0 #ddd;
- }
- td div.info { /* index page */
- padding-left: 0;
- }
-
- > #search_results {
- margin-top: 2em;
- }
-
- input#api_search {
- font-family: inherit;
- }
-
- #search_results {
- ul {
- list-style: none;
- li {
- margin-bottom: 4px;
- }
- }
-
- li div.info { /* index page */
- display: block;
- max-width: 70%;
- padding-left: 4em;
- margin-bottom: 1ex;
- }
-
- li div.info p { /* index page */
- margin: 0;
- }
- }
-
- span.search_comment {
- vertical-align: bottom;
- }
-
- .search_comment .search_help {
- height: 0;
- opacity: 0;
- font-size: 10px;
- overflow: hidden;
- transition: all 0.5s;
- ul {
- margin-top: 0;
- }
- }
- .search_comment:hover .search_help {
- height: auto;
- margin-top:-1px;
- opacity: 0.8;
- background: linear-gradient(to bottom, white 0%, rgb(237, 232, 229) 100%);
- transition: all 0.5s;
- }
- .search_comment .search_help:hover {
- font-size: 14px;
- }
-
-
- td div.info div.info-desc {
- margin-bottom: 0;
- }
-
- div.info div.info-desc {
- margin-bottom: 2ex;
- padding-left: 2em;
- }
-
- div.info.top div.info-desc {
- padding-left: 0;
- padding-bottom: 1em;
- box-shadow: 0 1px 0 0 #ddd;
- }
-
- td div.info {
- margin: 0;
- }
-
- div.info-deprecated {
- padding-top: 0.5em;
- }
-
- .info-desc p {
- margin-bottom: 0;
- code {
- white-space: normal;
- }
- }
-
- td.typefieldcomment > code {
- display: none; /* this only applies to "(*" and "*)" */
- }
-
- td.typefieldcomment {
- padding: 0;
- }
-
- td.typefieldcomment p {
- color: #776558;
- }
-
- td.typefieldcomment:nth-child(3), /* should apply to "(*" */
- td.typefieldcomment:last-child /* should apply to "*)" */
- {
- display: none;
- }
-
- .api_search img {
- height: 1em;
- vertical-align: middle;
- margin-right: 1em;
- }
-
- nav .api_search img {
- margin-right: 0;
- }
-
-}
-
-
-#footer {
- margin-left: 26ex;
-}
-
-
-/* When the navigation bar is collapsed */
-// this should match with ocamlorg.css
-@media only screen and (max-width: 979px) {
- @include mobile;
- .container, .api {
- margin-left: auto;
- margin-right: auto;
- }
- @include sidebar-button;
- header {
- @include header-mobile;
- }
-
- .api>table {
- box-shadow: 0px 3px 9px 3px #ddd;
- margin-bottom: 1em;
- padding-bottom: 2px;
- td:nth-child(2) {
- width: 59%;
- }
- }
-
- .api {
- *:target {
- padding-top: 0px;
- margin-top: 0px;
- }
-
- .toc {
- @include nav-toc-mobile;
- }
-
- table td {
- padding-left: 2%;
- }
-
- table td:first-child {
- padding-right: 0;
- }
-
- table.typetable {
- box-shadow: none;
- td:nth-child(2) {
- white-space: normal;
- /*width: 41%;*/
- width: auto;
- max-width: calc(100% - 3ex);
- }
- tr td:nth-child(4).typefieldcomment {
- /*width: 50%;*/
- width: auto;
- margin-left: 3ex;
- word-break: break-word;
- float: right;
- }
- td:last-child {
- width: auto;
- }
- tr td:first-child {
- padding-right: 0;
- width: auto;
- }
- }
-
- .info-desc p code {
- word-break: break-word;
- }
-
- td div.info div.info-desc {
- padding-left: 0;
- }
- span.search_comment {
- display: block;
- }
- }
- .api>table td:first-child {
- width: 40%;
- }
-
- .api {
- code {
- word-break: break-word;
- white-space: pre-wrap;
- }
- }
-
- #footer {
- margin-left: auto;
- }
-}
-
-
-
-/* When the navigation bar has reduced size */
-@if $ocamlorg {
- @media (max-height: 600px) and (min-width: 980px) {
- .api *:target {
- padding-top: 60px;
- margin-top: -60px;
- }
- .api nav.toc {
- top: 46px;
- }
- }
-}
-
+++ /dev/null
-(* ------------ Ocaml Web-manual -------------- *)
-
-(* Copyright San Vu Ngoc, 2020
-
- file: common.ml
-
- This file contains functions that are used by process_api.ml and
- process_manual.ml *)
-
-open Soup
-open Printf
-
-let debug = not (Array.mem "quiet" Sys.argv)
-
-let dbg =
- let printf = Printf.(if debug then kfprintf else ikfprintf) in
- let flush =
- if debug then
- fun ch -> output_char ch '\n'; flush ch
- else
- ignore
- in
- fun fmt -> printf flush stdout fmt
-
-let ( // ) = Filename.concat
-
-let process_dir = Filename.current_dir_name
-
-(* Output directory *)
-let web_dir = Filename.parent_dir_name // "webman"
-
-(* Output for manual *)
-let docs_maindir = web_dir // "manual"
-let docs_file = ( // ) docs_maindir
-
-(* Ouput for API *)
-let api_dir = web_dir // "api"
-
-(* How to go from manual to api *)
-let api_page_url = "../api"
-
-(* How to go from api to manual *)
- let manual_page_url = "../manual"
-
-(* Set this to the directory where to find the html sources of all versions: *)
-let html_maindir = "../htmlman"
-
-(* Where to get the original html files *)
-let html_file = ( // ) html_maindir
-
-let releases_url = "https://ocaml.org/releases/"
-
-let favicon = "favicon.ico"
-
-(**** utilities ****)
-
-let flat_option f o = Option.bind o f
-
-let (<<) f g x = f (g x)
-
-let string_of_opt = Option.value ~default:""
-
-let starts_with substring s =
- let l = String.length substring in
- l <= String.length s &&
- String.sub s 0 l = substring
-
-(**** html processing ****)
-
-(* Return next html element. *)
-let rec next node =
- match next_element node with
- | Some n -> n
- | None -> match parent node with
- | Some p -> next p
- | None -> raise Not_found
-
-let logo_html url =
- "<nav class=\"toc brand\"><a class=\"brand\" href=\"" ^ url ^
- "\" ><img src=\"colour-logo.svg\" class=\"svg\" alt=\"OCaml\" /></a></nav>"
- |> parse
-
-let wrap_body ~classes soup =
- let body = soup $ "body" in
- set_name "div" body;
- List.iter (fun c -> add_class c body) classes;
- wrap body (create_element "body");
- body
-
-(* Add favicon *)
-let add_favicon head =
- parse ({|<link rel="shortcut icon" type="image/x-icon" href="|} ^
- favicon ^ {|">|})
- |> append_child head
-
-(* Update html <head> element with javascript and favicon *)
-let update_head ?(search = false) soup =
- let head = soup $ "head" in
- if search then begin
- create_element "script" ~attributes:["src","search.js"]
- |> append_child head
- end;
- create_element "script" ~attributes:["src","scroll.js"]
- |> append_child head;
- create_element "script" ~attributes:["src","navigation.js"]
- |> append_child head;
- add_favicon head
-
-(* Add version number *)
-let add_version_link nav text url =
- let vnum = create_element "div" ~class_:"toc_version" in
- let a = create_element "a" ~inner_text:text
- ~attributes:["href", url; "id", "version-select"] in
- append_child vnum a;
- prepend_child nav vnum
-
-let add_sidebar_button body =
- let btn = create_element "div" ~id:"sidebar-button" in
- create_element "span" ~inner_text:"☰"
- |> prepend_child btn;
- prepend_child body btn
-
-(* Detect OCaml version from VERSION file *)
-let find_version () =
- let pp = Filename.parent_dir_name in
- let version_file = pp // pp // pp // "VERSION" in
- let major, minor = Scanf.bscanf (Scanf.Scanning.from_file version_file) "%u.%u" (fun x y -> x,y) in
- sprintf "%u.%u" major minor
-
-(*
- Local Variables:
- compile-command:"dune build"
- End:
-*)
+++ /dev/null
-(library
- (name common)
- (modules common)
- (libraries lambdasoup))
-
-(executable
- (name process_api)
- (modules process_api)
- (libraries unix re lambdasoup common))
-
-(executable
- (name process_manual)
- (modules process_manual)
- (libraries re lambdasoup common))
+++ /dev/null
-(* ------------ Ocaml Web-manual -------------- *)
-
-(* Copyright San Vu Ngoc, 2020
-
- file: process_api.ml
-
- Post-processing the HTML of the OCaml API. *)
-
-open Soup
-open Printf
-open Common
-
-let compiler_libref = ref false
-(* set this to true to process compilerlibref instead of libref *)
-
-type config = {
- src_dir : string;
- dst_dir : string;
- title : string
-}
-
-(* HTML code for the search widget. We don't add the "onchange" event because it
- forces to click twice to an external link after entering text. *)
-let search_widget with_description =
- let search_decription = if with_description
- then {|<span class="search_comment">(search values, type signatures, and descriptions - case sensitive)<div class="search_help"><ul><li>You may search bare values, like <code>map</code>, or indicate the module, like <code>List.map</code>, or type signatures, like <code>int -> float</code>.</li><li>To combine several keywords, just separate them by a space. Quotes "like this" can be used to prevent from splitting words at spaces.</li><li>You may use the special chars <code>^</code> and <code>$</code> to indicate where the matched string should start or end, respectively.</li></ul></div></span>|}
- else "" in
- sprintf {|<div class="api_search"><input type="text" name="apisearch" id="api_search" class="api_search"
- oninput = "mySearch(%b);"
- onkeypress = "this.oninput();"
- onclick = "this.oninput();"
- onpaste = "this.oninput();">
-<img src="search_icon.svg" alt="Search" class="api_search svg" onclick="mySearch(%b)">%s</div>
-<div id="search_results"></div>|} with_description with_description search_decription
- |> parse
-
-(* We save parsed files in a table; this is just for speed optimization,
- especially for make_index (18sec instead of 50sec for the whole index); it
- can be removed. Although if we really wanted a fast make_index, we would use
- Scanf all over the place ==> 1sec. Warning: the parsed files will be mutated
- by processing, so one should never process the same file twice. *)
-
-let parsed_files = Hashtbl.create 50
-
-let parse_file ?(original=false) file =
- match Hashtbl.find_opt parsed_files file with
- | Some soup ->
- if original then failwith (sprintf "File %s was already processed" file)
- else soup
- | None ->
- let soup = read_file file |> parse in
- Hashtbl.add parsed_files file soup;
- soup
-
-(* Create TOC with H2 and H3 elements *)
-(* Cf Scanf for an example with H3 elements *)
-let make_toc ~version ~search file config title body =
- let header = create_element ~id:"sidebar" "header" in
- prepend_child body header;
- let nav = create_element "nav" ~class_:"toc" in
- append_child header nav;
- let ul = create_element "ul" in
- append_child nav ul;
- (* Create a "li" element inside "ul" from a header "h" (h2 or h3 typically) *)
- let li_of_h ul h =
- let li_current = create_element "li" in
- append_child ul li_current;
- let () = match attribute "id" h with
- | Some id ->
- let href = "#" ^ id in
- let a = create_element "a" ~inner_text:(texts h |> String.concat "")
- ~attributes:["href", href] in
- append_child li_current a
- | None -> () in
- li_current in
-
- descendants body
- |> elements
- |> fold (fun (li_current, h3_current) h -> match name h with
- | "h2" ->
- li_of_h ul h, None
- | "h3" -> begin match h3_current with
- | Some h3 ->
- li_of_h h3 h, h3_current
- | None ->
- let h3 = create_element "ul" in
- append_child ul li_current;
- append_child li_current h3;
- li_of_h h3 h, Some h3
- end
- | _ -> li_current, h3_current) (create_element "li", None);
- |> ignore;
-
- let href = let base = Filename.basename file in
- if String.sub base 0 5 = "type_"
- then String.sub base 5 (String.length base - 5) else "#top" in
- let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
- let div = create_element ~class_:"toc_title" "div" in
- append_child div a;
- prepend_child nav div;
-
- (* In case of indexlist, add it to TOC *)
- (* This only happens for "index.html" *)
- let () = match body $? "ul.indexlist" with
- | Some uli ->
- delete uli;
- append_child ul uli;
- unwrap uli;
- if search then search_widget true |> prepend_child body;
- create_element "h1" ~inner_text:
- (sprintf "The OCaml %sAPI" config.title)
- |> prepend_child body;
- | None ->
- if search then search_widget false |> prepend_child nav;
- (* Add "general index" link to all other files *)
- create_element "a" ~inner_text:"< General Index"
- ~attributes:["href", "index.html"]
- |> prepend_child nav in
-
- (* Add version number *)
- add_version_link nav (config.title ^ "API Version " ^ version) releases_url;
-
- (* Add sidebar button for mobile navigation *)
- add_sidebar_button body;
-
- (* Add logo *)
- prepend_child header (logo_html
- ((if config.title = "" then "" else "../") ^
- (manual_page_url ^ "/index.html")))
-
-
-let process ?(search=true) ~version config file out =
-
- dbg "Processing %s..." file;
- let soup = parse_file ~original:true file in
-
- (* Add javascript and favicon *)
- update_head ~search soup;
-
- (* Add api wrapper *)
- let body = wrap_body ~classes:["api"] soup in
-
- (* Delete previous/up/next links *)
- body $? "div.navbar"
- |> Option.iter delete;
-
- (* Add left sidebar with TOC *)
- let title = soup $ "title" |> R.leaf_text in
- make_toc ~version ~search file config title body;
-
- dbg "Saving %s..." out;
-
- (* Save new html file *)
- let new_html = to_string soup in
- write_file out new_html
-
-let process ?(overwrite=false) ~version config file out =
- if overwrite || not (Sys.file_exists out)
- then Ok (process ~version config file out)
- else Error (sprintf "File %s already exists." out)
-
-let all_html_files config =
- Sys.readdir config.src_dir |> Array.to_list
- |> List.filter (fun s -> Filename.extension s = ".html")
-
-
-module Index = struct
- (* Generate the index.js file for searching with the quick search widget *)
- (* The idea is to parse the file "index_values.html" to extract, for each
- entry of this index, the following information (list of 8 strings):
-
- [Module name; href URL of the Module (in principle an html file); Value
- name; href URL of the value; short description (html format); short
- description in txt format; type signature (html format); type signature in
- txt format]
-
- The "txt format" versions are used for searching, the "html version" for
- display. The signature is not in the "index_values.html" file, we have to
- look for it by following the value href. The index_values.html file has
- the following structure:
-
- (...)
-
- <table>
-
- (...)
-
- <tr><td><a href="List.html#VALappend">append</a> [<a
- href="List.html">List</a>]</td> <td><div class="info"> <p>Concatenate two
- lists.</p>
-
- </div> </td></tr>
-
- (...)
-
- </table>
-
- (...)
-
- So we need to visit "List.html#VALappend", which has the following
- structure:
-
- <pre><span id="VALappend"><span class="keyword">val</span> append</span> :
- <code class="type">'a list -> 'a list -> 'a list</code></pre>
-
- and we finally return
-
- ["List"; "List.html"; "rev_append"; "List.html#VALrev_append"; "<div
- class=\"info\"> <p><code class=\"code\"><span
- class=\"constructor\">List</span>.rev_append l1 l2</code>
- reverses <code class=\"code\">l1</code> and concatenates it to <code
- class=\"code\">l2</code>.</p> </div>"; "
- List.rev_append\194\160l1\194\160l2 reverses l1 and concatenates it to
- l2. "; "<code class=\"type\">'a list -> 'a list -> 'a list</code>";
- "'a list -> 'a list -> 'a list"]
-
- *)
-
- type item =
- { html : string; txt : string }
-
- type entry =
- { mdule : item;
- value : item;
- info : item;
- signature : item option }
-
- let anon_t_regexp = Re.Str.regexp "\\bt\\b"
- let space_regexp = Re.Str.regexp " +"
- let newline_regexp = Re.Str.regexp_string "\n"
-
- (* Remove "\n" and superfluous spaces in string *)
- let one_line s =
- Re.Str.global_replace newline_regexp " " s
- |> Re.Str.global_replace space_regexp " "
- |> String.trim
-
- (* Look for signature (with and without html formatting);
- [id] is the HTML id of the value. Example:
- # get_sig ~id_name:"VALfloat_of_int" "Stdlib.html";;
- Looking for signature for VALfloat_of_int in Stdlib.html
- Signature=[int -> float]
- - : (string * string) option =
- Some ("<code class=\\\"type\\\">int -> float</code>", "int -> float")
- *)
- let get_sig ?mod_name ~id_name config file =
- dbg "Looking for signature for %s in %s" id_name file;
- let soup = parse_file (config.src_dir // file) in
- (* Now we jump to the html element with id=id_name. Warning, we cannot use
- the CSS "#id" syntax for searching the id -- like in: soup $ ("#" ^ id)
- -- because it can have problematic chars like id="VAL( * )" *)
- let span = soup $$ "pre span"
- |> filter (fun s -> id s = Some id_name)
- |> first |> require in
- let pre = match parent span with
- | None -> failwith ("Cannot find signature for " ^ id_name)
- | Some pre -> pre in
- let code = pre $ ".type" in
- let sig_txt = texts code
- |> String.concat ""
- |> String.escaped in
- (* We now replace anonymous "t"'s by the qualified "Module.t" *)
- let sig_txt = match mod_name with
- | None -> sig_txt
- | Some mod_name ->
- Re.Str.global_replace anon_t_regexp (mod_name ^ ".t") sig_txt in
- dbg "Signature=[%s]" sig_txt;
- Some {html = to_string code |> String.escaped; txt = sig_txt}
-
- (* Example: "Buffer.html#VALadd_subbytes" ==> Some "VALadd_subbytes" *)
- let get_id ref =
- match String.split_on_char '#' ref with
- | [file; id] -> Some (file, id)
- | _ -> dbg "Could not find id for %s" ref; None
-
- let make ?(with_sig = true) config =
- let soup = parse_file (config.src_dir // "index_values.html") in
- soup $ "table"
- |> select "tr"
- |> fold (fun index_list tr ->
- let td_list = tr $$ "td" |> to_list in
- match td_list with
- (* We scan the row; it should contain 2 <td> entries, except for
- separators with initials A,B,C,D; etc. *)
- | [td_val; td_info] ->
- let mdule, value = match td_val $$ ">a" |> to_list with
- | [a_val; a_mod] ->
- { txt = R.leaf_text a_mod; html = R.attribute "href" a_mod },
- { txt = R.leaf_text a_val; html = R.attribute "href" a_val }
- | _ -> failwith "Cannot parse value" in
- let info = match td_info $? "div.info" with
- | Some info -> { html = to_string info
- |> one_line
- |> String.escaped;
- txt = texts info
- |> String.concat ""
- |> one_line
- |> String.escaped }
- | None -> { html = ""; txt = ""} in
- let signature =
- if with_sig then
- get_id value.html
- |> flat_option (fun (file,id_name) ->
- assert (file = mdule.html);
- get_sig config ~mod_name:mdule.txt ~id_name file)
- else None in
- { mdule; value; info; signature } :: index_list
- | _ ->
- dbg "Ignoring row:";
- dbg "%s" (List.map to_string td_list |> String.concat " ");
- index_list) []
-
- let save file index =
- let outch = open_out file in
- output_string outch "var GENERAL_INDEX = [\n";
- List.iter (fun item ->
- fprintf outch {|["%s", "%s", "%s", "%s", "%s", "%s", "%s", "%s"],|}
- item.mdule.txt item.mdule.html item.value.txt item.value.html
- item.info.html item.info.txt
- (Option.map (fun i -> i.html) item.signature |> string_of_opt)
- (Option.map (fun i -> i.txt) item.signature |> string_of_opt);
- output_string outch "\n") index;
- output_string outch "]\n";
- close_out outch
-
- let process config =
- print_endline "Creating index file, please wait...";
- let t = Unix.gettimeofday () in
- let index = make config in
- dbg "Index created. Time = %f\n" (Unix.gettimeofday () -. t);
- save (config.dst_dir // "index.js") index;
- dbg "Index saved. Time = %f\n" (Unix.gettimeofday () -. t)
-
-end (* of Index module *)
-
-let process_html config overwrite version =
- print_endline (sprintf "\nProcessing version %s into %s...\n" version config.dst_dir);
- let processed = ref 0 in
- all_html_files config
- |> List.iter (fun file ->
- match process config ~overwrite ~version
- (config.src_dir // file)
- (config.dst_dir // file) with
- | Ok () -> incr processed
- | Error s -> dbg "%s" s
- );
- sprintf "Version %s, HTML processing done: %u files have been processed."
- version !processed |> print_endline
-
-let copy_files config =
- let ind = config.dst_dir // "index.js" in
- if not (Sys.file_exists ind) then Index.process config
-
-(******************************************************************************)
-
-let () =
- let version = find_version () in
- let args = Sys.argv |> Array.to_list |> List.tl in
- let config = if List.mem "compiler" args
- then { src_dir = html_maindir // "compilerlibref";
- dst_dir = api_dir // "compilerlibref"; title = "Compiler "}
- else { src_dir = html_maindir // "libref";
- dst_dir = api_dir; title = ""} in
- let overwrite = List.mem "overwrite" args in
- let makeindex = List.mem "makeindex" args in
- let makehtml = List.mem "html" args || not makeindex in
- if makehtml then process_html config overwrite version;
- if makeindex then Index.process config;
- copy_files config;
- print_endline "DONE."
-
-(*
- Local Variables:
- compile-command:"dune build"
- End:
-*)
+++ /dev/null
-(* ------------ Ocaml Web-manual -------------- *)
-
-(* Copyright San Vu Ngoc, 2020
-
- file: process_api.ml
-
- Post-processing the HTML of the OCaml Manual.
-
- (The "API" side is treated by process_api.ml) *)
-
-open Soup
-open Printf
-open Common
-
-(* How the main index.html page will be called: *)
-let index_title = "Home"
-
-(* Alternative formats for the manual: *)
-let archives =
- ["refman-html.tar.gz"; "refman.txt"; "refman.pdf"; "refman.info.tar.gz"]
-
-let preg_anyspace =
- String.concat "\\|"
- ["\u{00a0}"; (* NO-BREAK SPACE *)
- "\u{2000}"; (* EN QUAD *)
- "\u{2001}"; (* EM QUAD *)
- "\u{2002}"; (* EN SPACE *)
- "\u{2003}"; (* EM SPACE *)
- "\u{2004}"; (* THREE-PER-EM SPACE *)
- "\u{2005}"; (* FOUR-PER-EM SPACE *)
- "\u{2006}"; (* SIX-PER-EM SPACE *)
- "\u{2007}"; (* FIGURE SPACE *)
- "\u{2008}"; (* PUNCTUATION SPACE *)
- "\u{2009}"; (* THIN SPACE *)
- "\u{200a}"; (* HAIR SPACE *)
- "\u{202f}"; (* NARROW NO-BREAK SPACE *)
- ]
- |> sprintf "\\(%s\\)+"
-
-(* WARNING these are sensitive to Hevea fluctuations: *)
-(* "long" space is either " " (hevea 2.32) or "\u{2003}" (hevea 2.35) *)
-let preg_emspace = "\\(\u{2003}\\| \\)"
-(* What hevea inserts between "Chapter" and the chapter number: *)
-let preg_chapter_space = "\\(\u{2004}\u{200d}\\|" ^ preg_anyspace ^ "\\)"
-let writtenby_css = "span.c010" (* "span.c009" for hevea 2.32 *)
-
-(* Remove number: "Chapter 1 The core language" ==> "The core language" *)
-let remove_number s =
- Re.Str.(global_replace (regexp (".+" ^ preg_emspace)) "" s)
-
-let toc_get_title li =
- let a = li $ "a[href]" in
- let title = trimmed_texts a |> String.concat " "
- |> remove_number in
- let file = R.attribute "href" a
- |> String.split_on_char '#'
- |> List.hd in
- file, title
-
-let register_toc_entry toc_table name li =
- let file, title = toc_get_title li in
- dbg "%s : %s" name title;
- if not (Hashtbl.mem toc_table file)
- then begin
- Hashtbl.add toc_table file title;
- dbg "Registering %s => %s" file title
- end;
- file, title
-
-(* Scan manual001.html and return two things:
- 1. [toc_table]: a table with (file ==> title)
- 2. [all_chapters]: the list of parts: (part_title, chapters), where
- chapters is a list of (title, file) *)
-let parse_toc () =
- let toc_table = Hashtbl.create 50 in
- Hashtbl.add toc_table "manual001.html" "Contents";
- Hashtbl.add toc_table "foreword.html" "Foreword";
- Hashtbl.add toc_table "manual071.html" "Keywords";
-
- let soup = read_file (html_file "manual001.html") |> parse in
- let toc = soup $ "ul.toc" in
- let all_chapters =
- toc $$ ">li.li-toc" (* Parts *)
- |> fold (fun all_chapters li ->
- let _file, title = toc_get_title li in
- dbg "Part: %s " title;
- let chapters =
- li $$ ">ul >li.li-toc" (* Chapters *)
- |> fold (fun chapters li ->
- let file, title = register_toc_entry toc_table " Chapters" li in
- li $$ ">ul >li.li-toc" (* Sections *)
- |> iter (ignore << (register_toc_entry toc_table " Section"));
- (file,title) :: chapters) []
- |> List.rev in
- if chapters = [] then all_chapters
- else (title, chapters) :: all_chapters) [] in
- toc_table, all_chapters
-
-(* This string is updated by [extract_date] *)
-let copyright_text = ref "Copyright © 2020 Institut National de Recherche en Informatique et en Automatique"
-
-let copyright () =
- "<div class=\"copyright\">" ^ !copyright_text ^ "</div>"
- |> parse
-
-
-(* New UTF8 space chars have been introduced in Hevea 2.35. In Hevea 2.32, only
- html nb_spaces " " were used. With 2.35 we have
- 'Chapter\u2004\u200d2\u2003The module system'. The \u200d is Zero Width
- Joiner and should probably not be used here, see
- https://github.com/maranget/hevea/pull/61 *)
-
-let reg_chapter = Re.Str.regexp
- ("Chapter" ^ preg_chapter_space ^ "\\([0-9]+\\)" ^ preg_anyspace)
-
-let load_html file =
- dbg "%s" file;
- (* First we perform some direct find/replace in the html string. *)
- let html =
- read_file (html_file file)
- (* Normalize non-break spaces to the utf8 \u00A0: *)
- |> Re.Str.(global_replace (regexp_string " ") " ")
- |> Re.Str.(global_replace reg_chapter)
- (if file = "index.html" then {|<span class="number">\3.</span>|}
- else {|<span class="number">Chapter \3</span>|})
-
- (* I think it would be good to replace "chapter" by "tutorial" for part
- I. The problem of course is how we number chapters in the other parts. *)
-
- (* |> Re.Str.global_replace (Re.Str.regexp_string "chapter") "tutorial"
- * |> Re.Str.global_replace (Re.Str.regexp_string "Chapter") "Tutorial" *)
-
- (* Remove the chapter number in local links, it makes the TOC unnecessarily
- unfriendly. *)
- |> Re.Str.(global_replace
- (regexp (">[0-9]+\\.\\([0-9]+\\)" ^ preg_anyspace)))
- {|><span class="number">\1</span>|}
- |> Re.Str.(global_replace
- (regexp ("[0-9]+\\.\\([0-9]+\\(\\.[0-9]+\\)+\\)" ^ preg_anyspace)))
- {|<span class="number">\1</span>|}
-
- (* The API (libref and compilerlibref directories) should be separate
- entities, to better distinguish them from the manual. *)
- |> Re.Str.(global_replace (regexp_string "\"libref/"))
- (sprintf "\"%s/" api_page_url)
- |> Re.Str.(global_replace (regexp_string "\"compilerlibref/")
- (sprintf "\"%s/compilerlibref/" api_page_url))
- in
-
- (* For the main index file, we do a few adjustments *)
- let html = if file = "index.html"
- then Re.Str.(global_replace
- (regexp ("Part" ^ preg_chapter_space ^ "\\([I|V]+\\)<br>\n"))
- {|<span class="number">\3.</span>|} html)
- else html in
-
- (* Set utf8 encoding directly in the html string *)
- let charset_regexp = Re.Str.regexp "charset=\\([-A-Za-z0-9]+\\)\\(\\b\\|;\\)" in
- match Re.Str.search_forward charset_regexp html 0 with
- | exception Not_found -> dbg "Warning, no charset found in html."; html
- | _ -> match (String.lowercase_ascii (Re.Str.matched_group 1 html)) with
- | "utf-8" -> dbg "Charset is UTF-8; good."; html
- | "us-ascii" -> dbg "Charset is US-ASCII. We change it to UTF-8";
- Re.Str.global_replace charset_regexp "charset=UTF-8\\2" html
- | _ -> dbg "Warning, charset not recognized."; html
-
-(* Save new html file *)
-let save_to_file soup file =
- let new_html = to_string soup in
- write_file (docs_file file) new_html
-
-(* Find title associated with file *)
-let file_title file toc =
- if file = "index.html" then Some index_title
- else Hashtbl.find_opt toc file
-
-(* Replace the images of one of the "previous, next, up" link by the title of
- the reference. *)
-let nav_replace_img_by_text toc alt a img =
- let file = R.attribute "href" a in
- let title = match file_title file toc with
- | Some f -> begin match alt with
- | "Previous" -> "« " ^ f
- | "Next" -> f ^ " »"
- | "Up" -> f
- | _ -> failwith "This should not happen"
- end
- | None -> dbg "Unknown title for file %s" file; file in
- let txt = create_text title in
- replace img txt;
- add_class (String.lowercase_ascii alt) a
-
-(* Replace three links "Previous, Up, Next" at the end of the file by more
- useful titles, and insert then in a div container, keeping only 2 of them:
- either (previous, next) or (previous, up) or (up, next). Remove them at the
- top of the file, where they are not needed because we have the TOC. *)
-let update_navigation soup toc =
- Option.iter delete (soup $? "hr");
- let links =
- ["Previous"; "Up"; "Next"]
- |> List.map (fun alt -> alt, to_list (soup $$ ("img[alt=\"" ^ alt ^ "\"]")))
- (* In principle [imgs] will contain either 0 or 2 elements. *)
- |> List.filter (fun (_alt, imgs) -> List.length imgs = 2)
- (* We delete the first link, and replace image by text *)
- |> List.map (fun (alt, imgs) ->
- delete (R.parent (List.hd imgs));
- let img = List.hd (List.rev imgs) in
- let a = R.parent img in
- nav_replace_img_by_text toc alt a img;
- a) in
- if links <> [] then begin
- (* We keep only 2 links: first and last *)
- let a1, a2 = match links with
- | [prev;up;next] -> delete up; (prev, next)
- | [a;b] -> (a,b)
- | _ -> failwith "Navigation link should have at least 2 elements" in
- add_class "previous" a1;
- add_class "next" a2;
- (* some elements can have both previous and up classes, for instance. This
- helps css styling. *)
- let container = create_element ~class_:"bottom-navigation" "div" in
- wrap a1 container;
- append_child container a2
- end
-
-
-(* extract the cut point (just after title) and the header of soup:
- "insert_xfile_content" needs them to insert external files after the cut point,
- and include the TOC. *)
-let make_template soup =
- let header = soup $ "header" in
- let title = match soup $? "div.maintitle" with
- | Some div -> div (* This is the case for "index.html" *)
- | None -> soup $ "h1" in
- title, header
-
-(* Create a new file by keeping only the head/headers parts of "soup", deleting
- everything after the title, and inserting the content of external file (hence
- preserving TOC and headers) (WARNING: this mutates soup) *)
-let insert_xfile_content soup (title, header) toc xfile =
- let xternal = parse (load_html xfile) in
- update_navigation xternal toc;
- Option.iter delete (xternal $? "hr");
- let xbody = xternal $ "body" in
- insert_after title xbody;
- create_element ~id:"start-section" "a"
- |> insert_after title;
- insert_after title header;
- next_siblings xbody
- |> iter delete;
- insert_after xbody (copyright ());
- set_name "section" xbody;
- set_attribute "id" "section" xbody;
- save_to_file soup xfile
-
-(* Extract the date (and copyright) from the maintitle block in "index.html" *)
-let extract_date maintitle =
- let months = ["January"; "February"; "March"; "April";
- "May"; "June"; "July"; "August"; "September";
- "October"; "November"; "December"] in
- let txts = texts maintitle
- |> List.map String.trim in
- copyright_text := List.hd (List.rev txts);
- txts
- |> List.filter (fun s -> List.exists (fun month -> starts_with month s) months)
- |> function | [s] -> Some s
- | _ -> dbg "Warning, date not found"; None
-
-(* Special treatment of the main index.html file *)
-let convert_index version soup =
- (* Remove "translated from LaTeX" *)
- soup $$ "blockquote" |> last |> Option.iter delete;
- let title_selector = if float_of_string version < 4.07
- then "div.center" else "div.maintitle" in
- let maintitle = soup $ title_selector in
- sprintf "<div class=\"maintitle\"><h1><span>The OCaml system</span> release %s </h1><h3>%s</h3></div>"
- version (extract_date maintitle |> string_of_opt)
- |> parse
- |> insert_after maintitle ;
- delete maintitle;
- let body = soup $ ".index" in
- {|<span class="authors">Xavier Leroy,<br> Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon</span>|}
- |> parse
- |> append_child body
-
-let change_title title soup =
- let title_tag = soup $ "title" in
- let new_title = create_element "title" ~inner_text:("OCaml - " ^ title) in
- replace title_tag new_title
-
-(* Create left sidebar for TOC. *)
-let make_toc_sidebar ~version ~title file body =
- let toc = match body $? "ul" with
- | None -> None (* can be None, eg chapters 15,19...*)
- | Some t -> if classes t <> [] (* as in libthreads.html or parsing.html *)
- then (dbg "We don't promote <UL> to TOC for file %s" file; None)
- else Some t in
-
- let () = match body $? "h2.section", toc with
- | None, Some toc ->
- (* If file has "no content" (sections), we clone the toc to leave it in
- the main content. This applies to "index.html" as well. *)
- let original_toc = parse (to_string toc) in
- original_toc $ "ul"
- |> add_class "ul-content";
- insert_after toc original_toc
- | _ -> () in
-
- let nav = create_element "nav" ~class_:"toc" in
- let () = match toc with
- | None -> prepend_child body nav
- | Some toc -> wrap toc nav in
- let nav = body $ "nav" in
- wrap nav (create_element ~id:"sidebar" "header");
- begin match toc with
- | None -> dbg "No TOC for %s" file
- | Some toc -> begin
- (* TOC - Create a title entry in the menu *)
- let a = create_element "a" ~inner_text:title
- ~attributes:["href", "#"] in
- let li = create_element "li" ~class_:"top" in
- append_child li a;
- prepend_child toc li;
-
- (* index of keywords *)
- if file = "index.html"
- then begin
- let keywords =
- body $$ "ul"
- |> fold (fun key ul ->
- match key with
- | None -> begin
- match ul $$ "li" |> last with
- | None -> None
- | Some l -> begin match l $ "a" |> leaf_text with
- | Some text -> dbg "[%s]" text;
- if text = "Index of keywords"
- then l $ "a" |> attribute "href" else None
- | None -> None
- end
- end
- | _ -> key) None in
- begin match keywords with
- | None -> dbg "Could not find Index of keywords"
- | Some keywords ->
- let a = create_element "a" ~inner_text:"Index of keywords"
- ~attributes:["href", keywords] in
- let li = create_element "li" in
- (append_child li a;
- append_child toc li)
- end;
- (* Link to APIs *)
- let a = create_element "a" ~inner_text:"OCaml API"
- ~attributes:["href", api_page_url ^ "/index.html"] in
- let li = create_element "li" in
- (append_child li a;
- append_child toc li);
- let a = create_element "a" ~inner_text:"OCaml Compiler API"
- ~attributes:["href", api_page_url ^ "/compilerlibref/index.html"] in
- let li = create_element "li" in
- (append_child li a;
- append_child toc li)
- end
- end
- end;
-
- (* Add back link to "OCaml Manual" *)
- if file <> "index.html" then begin
- let toc_title = create_element "div" ~class_:"toc_title" in
- let a = create_element "a" ~inner_text:"< The OCaml Manual"
- ~attributes:["href", "index.html"] in
- append_child toc_title a;
- prepend_child nav toc_title
- end;
-
- (* Add version number *)
- let version_text = if file = "index.html" then "Select another version"
- else "Version " ^ version in
- add_version_link nav version_text releases_url;
- toc
-
- (* Create menu for all chapters in the part *)
-let make_part_menu ~part_title chapters file body =
- let menu = create_element "ul" ~id:"part-menu" in
- List.iter (fun (href, title) ->
- let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
- let li = if href = file
- then create_element "li" ~class_:"active"
- else create_element "li" in
- append_child li a;
- append_child menu li) chapters;
- prepend_child body menu;
-
- (* Add part_title just before the part-menu *)
- if part_title <> "" then begin
- let nav = create_element ~id:"part-title" "nav" ~inner_text:part_title in
- create_element "span" ~inner_text:"☰"
- |> prepend_child nav;
- prepend_child body nav
- end
-
-(* Add logo *)
-let add_logo file soup =
- match soup $? "header" with
- | None -> dbg "Warning: no <header> for %s" file
- | Some header -> prepend_child header (logo_html "https://ocaml.org/")
-
-(* Move authors to the end *)
-let move_authors body =
- body $? writtenby_css
- |> Option.iter (fun authors ->
- match leaf_text authors with
- | None -> ()
- | Some s ->
- match Re.Str.(search_forward (regexp "(.+written by.+)") s 0) with
- | exception Not_found -> ()
- | _ ->
- dbg "Moving authors";
- delete authors;
- add_class "authors" authors;
- append_child body authors)
-
-(* Get the list of external files linked by the current file *)
-let get_xfiles = function
- | None -> []
- | Some toc ->
- toc $$ "li"
- |> fold (fun list li ->
- let rf = li $ "a" |> R.attribute "href" in
- dbg "TOC reference = %s" rf;
- if not (String.contains rf '#') &&
- not (starts_with ".." rf) &&
- not (starts_with "http" rf)
- then begin
- li $ "a" |> set_attribute "href" (rf ^ "#start-section");
- rf::list
- end else list) []
-
-(* This is the main script for processing a specified file. [convert] has to be
- run for each "entry" [file] of the manual, making a "Chapter". (The list of
- [chapters] corresponds to a "Part" of the manual.) *)
-let convert version (part_title, chapters) toc_table (file, title) =
- dbg "%s ==> %s" (html_file file) (docs_file file);
-
- (* Parse html *)
- let soup = parse (load_html file) in
-
- (* Change title, add javascript and favicon *)
- change_title title soup;
- update_head soup;
-
- (* Wrap body. *)
- let c = if file = "index.html" then ["manual"; "content"; "index"]
- else ["manual"; "content"] in
- let body = wrap_body ~classes:c soup in
-
- if file = "index.html" then convert_index version soup;
-
- (* Make sidebar *)
- let toc = make_toc_sidebar ~version ~title file body in
-
- (* Make top menu for chapters *)
- make_part_menu ~part_title chapters file body;
-
- (* Add side-bar button before part_title *)
- add_sidebar_button body;
-
- (* Add logo *)
- add_logo file soup;
-
- (* Move authors to the end *)
- move_authors body;
-
- (* Bottom navigation links *)
- update_navigation soup toc_table;
-
- (* Add copyright *)
- append_child body (copyright ());
-
- (* Save html *)
- save_to_file soup file;
-
- (* Finally, generate external files to be converted (this should be done at
- the end because it deeply mutates the original soup) *)
- let xfiles = get_xfiles toc in
- let template = make_template soup in
- List.iter (insert_xfile_content soup template toc_table) xfiles
-
-
-(* Completely process the given version of the manual. Returns the names of the
- main html files. *)
-let process version =
- print_endline (sprintf "\nProcessing version %s into %s...\n" version docs_maindir);
-
- dbg "Current directory is: %s" (Sys.getcwd ());
-
- dbg "* Scanning index";
- let toc_table, all_chapters = parse_toc () in
-
- (* special case of the "index.html" file: *)
- convert version ("", []) toc_table ("index.html", "The OCaml Manual");
-
- let main_files = List.fold_left (fun list (part_title, chapters) ->
- dbg "* Processing chapters for %s" part_title;
- List.iter (convert version (part_title, chapters) toc_table) chapters;
- (fst (List.hd chapters)) :: list) [] all_chapters in
-
- main_files
-
-(******************************************************************************)
-
-let () =
- let _list = process (find_version ()) in
- print_endline "DONE."
-
-(*
- Local Variables:
- compile-command:"dune build"
- End:
-*)
+++ /dev/null
-*.html
-*.haux
-*.hind
-compilerlibref
-libref
-manual.hmanual
-manual.hmanual.kwd
-manual.css
-*.htoc
-*.svg
+++ /dev/null
-<?xml version="1.0" standalone="no"?>
-<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
-<svg xmlns="http://www.w3.org/2000/svg">
-<defs >
-<font id="FiraSans" horiz-adv-x="558" ><font-face
- font-family="Fira Sans"
- units-per-em="1000"
- panose-1="2 11 5 3 5 0 0 2 0 4"
- ascent="935"
- descent="-265"
- alphabetic="0" />
-<glyph unicode=" " glyph-name="space" horiz-adv-x="265" />
-<glyph unicode="!" glyph-name="exclam" horiz-adv-x="241" d="M170 689L160 230H79L68 689H170ZM150 127T170 107T190 58Q190 29 170 9T120 -12Q91 -12 71 8T51 58Q51 87 71 107T120 127Q150 127 170 107Z" />
-<glyph unicode=""" glyph-name="quotedbl" horiz-adv-x="399" d="M75 427L60 689H159L144 427H75ZM255 427L240 689H339L324 427H255Z" />
-<glyph unicode="#" glyph-name="numbersign" horiz-adv-x="518" d="M503 447H427L399 232H466V163H389L368 0H290L311 163H157L136 0H58L79 163H15V232H89L117 447H52V517H126L146 669H224L204 517H358L378 669H456L436 517H503V447ZM321 232L349 447H195L167 232H321Z" />
-<glyph unicode="$" glyph-name="dollar" horiz-adv-x="531" d="M491 110T443 58T310 -8V-155H230V-11Q107 -5 25 75L79 134Q151 64 251 64Q314 64 354 95T395 183Q395 216 383 238T339 277T250 312Q147 344 100 387T52 505Q52 575 101 622T230 678V824H310V677Q358
-672 396 654T470 602L417 544Q383 576 347 590T267 604Q214 604 181 580T147 509Q147 480 159 461T202 425T293 389Q356 370 398 347T465 285T491 186Q491 110 443 58Z" />
-<glyph unicode="%" glyph-name="percent" horiz-adv-x="826" d="M613 711L677 669L214 -31L150 11L613 711ZM279 679T324 633T370 510Q370 433 325 387T207 341Q136 341 91 387T45 510Q45 587 90 633T207 679Q279 679 324 633ZM163 617T145 587T126 510Q126 464
-144 434T207 403Q288 403 288 510Q288 556 270 586T207 617Q163 617 145 587ZM691 326T736 280T781 157Q781 80 736 34T619 -12Q547 -12 502 34T456 157Q456 234 501 280T619 326Q691 326 736 280ZM575 263T557 234T538 157Q538 111 556 81T619 50Q700 50 700 157Q700
-203 682 233T619 263Q575 263 557 234Z" />
-<glyph unicode="&" glyph-name="ampersand" horiz-adv-x="729" d="M356 701T397 682T462 627T485 549Q485 490 448 448T344 366L520 200Q560 281 580 369L666 344Q631 228 577 147L689 42L623 -12L526 82Q483 35 429 12T305 -12Q239 -12 189 11T110 76T81
-175Q81 237 116 283T220 374Q170 422 147 460T123 546Q123 614 170 657T302 701Q356 701 397 682ZM261 633T237 609T213 547Q213 511 232 483T292 415Q343 446 369 476T395 544Q395 586 370 609T303 633Q261 633 237 609ZM223 291T199 257T175 178Q175 123 213
-92T315 61Q362 61 400 79T473 133L273 324Q223 291 199 257Z" />
-<glyph unicode="'" glyph-name="quotesingle" horiz-adv-x="219" d="M75 427L60 689H159L144 427H75Z" />
-<glyph unicode="(" glyph-name="parenleft" horiz-adv-x="324" d="M284 805Q232 728 202 668T154 530T136 350Q136 248 153 171T201 33T284 -105L226 -145Q160 -51 125 9T65 154T40 350Q40 461 64 545T124 690T226 845L284 805Z" />
-<glyph unicode=")" glyph-name="parenright" horiz-adv-x="324" d="M164 751T199 691T259 546T284 350Q284 239 260 155T200 10T98 -145L40 -105Q92 -29 122 32T170 171T188 350Q188 453 171 530T123 667T40 805L98 845Q164 751 199 691Z" />
-<glyph unicode="*" glyph-name="asterisk" horiz-adv-x="439" d="M419 561L266 528L370 412L298 359L219 493L141 359L69 411L172 528L20 561L47 643L189 582L174 739H264L249 581L391 644L419 561Z" />
-<glyph unicode="+" glyph-name="plus" horiz-adv-x="499" d="M291 519V369H437V293H291V144H207V293H62V369H207V519H291Z" />
-<glyph unicode="," glyph-name="comma" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 27 171 -13L104 -166H38L78 0Q65 10 58 25T50 58Q50 87 70 107T119 127Q149 127 169 107Z" />
-<glyph unicode="-" glyph-name="hyphen" horiz-adv-x="403" d="M60 274V352H343V274H60Z" />
-<glyph unicode="." glyph-name="period" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 29 169 9T119 -12Q90 -12 70 8T50 58Q50 87 70 107T119 127Q149 127 169 107Z" />
-<glyph unicode="/" glyph-name="slash" horiz-adv-x="520" d="M337 807L415 789L184 -104L105 -85L337 807Z" />
-<glyph unicode="0" glyph-name="zero" d="M390 679T446 591T503 334Q503 166 447 77T279 -12Q168 -12 112 77T55 334Q55 502 111 590T279 679Q390 679 446 591ZM214 606T183 542T151 334Q151 190 182 126T279 61Q343 61 375 125T407 334Q407 477 375 541T279 606Q214
-606 183 542Z" />
-<glyph unicode="1" glyph-name="one" horiz-adv-x="433" d="M323 669V0H231V571L75 476L35 541L242 669H323Z" />
-<glyph unicode="2" glyph-name="two" horiz-adv-x="495" d="M288 679T333 655T404 590T429 496Q429 435 402 379T317 258T144 77H445L434 0H39V73Q173 212 229 276T309 389T333 492Q333 544 303 573T223 603Q182 603 151 586T85 530L25 578Q66 629 116 654T228
-679Q288 679 333 655Z" />
-<glyph unicode="3" glyph-name="three" horiz-adv-x="499" d="M287 679T331 656T399 594T423 509Q423 448 388 409T293 355Q360 349 402 307T444 193Q444 135 416 88T336 15T216 -12Q155 -12 104 10T15 78L70 129Q103 95 137 79T213 63Q276 63 312 98T348 194Q348
-260 314 287T215 314H165L176 385H210Q262 385 296 416T331 503Q331 550 301 577T220 605Q181 605 149 591T82 545L34 600Q119 679 225 679Q287 679 331 656Z" />
-<glyph unicode="4" glyph-name="four" horiz-adv-x="532" d="M502 238V165H415V0H326V165H40V231L241 679L318 647L137 238H327L335 418H415V238H502Z" />
-<glyph unicode="5" glyph-name="five" horiz-adv-x="501" d="M420 597H159V400Q210 426 266 426Q352 426 404 370T456 214Q456 148 427 97T346 17T224 -12Q163 -12 115 9T26 73L80 126Q112 94 146 79T223 63Q287 63 323 103T360 216Q360 289 327 322T238 355Q212
-355 190 350T143 332H71V669H433L420 597Z" />
-<glyph unicode="6" glyph-name="six" horiz-adv-x="533" d="M359 440T401 416T468 344T493 227Q493 156 465 102T388 18T280 -12Q163 -12 109 74T55 314Q55 423 85 505T173 633T308 679Q384 679 446 638L410 577Q363 606 307 606Q235 606 193 537T147 352Q209
-440 308 440Q359 440 401 416ZM338 61T369 105T400 224Q400 367 292 367Q248 367 211 343T148 275Q151 165 182 113T280 61Q338 61 369 105Z" />
-<glyph unicode="7" glyph-name="seven" horiz-adv-x="444" d="M414 669V600L164 -10L80 18L321 594H25V669H414Z" />
-<glyph unicode="8" glyph-name="eight" horiz-adv-x="551" d="M506 302T506 179Q506 124 477 81T394 13T274 -12Q206 -12 154 12T74 79T45 177Q45 239 78 281T177 351Q124 378 99 416T73 507Q73 561 101 600T176 659T276 679Q328 679 374 660T450 603T479 510Q479
-460 451 424T365 359Q506 302 506 179ZM224 610T194 583T163 506Q163 458 192 433T287 387L304 381Q349 407 369 436T389 507Q389 554 360 582T276 610Q224 610 194 583ZM337 61T373 93T410 178Q410 214 396 238T351 281T264 319L239 328Q189 304 165 268T141 177Q141
-122 177 92T275 61Q337 61 373 93Z" />
-<glyph unicode="9" glyph-name="nine" horiz-adv-x="525" d="M365 679T420 610T475 419Q475 282 438 199T325 66T119 -22L98 47Q232 85 303 150T380 323Q357 287 318 265T230 243Q178 243 136 269T70 344T45 458Q45 526 74 576T151 652T259 679Q365 679 420 610ZM328
-315T382 398Q384 509 355 557T261 606Q202 606 170 567T138 456Q138 386 168 351T249 315Q328 315 382 398Z" />
-<glyph unicode=":" glyph-name="colon" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 29 169 9T119 -12Q90 -12 70 8T50 58Q50 87 70 107T119 127Q149 127 169 107ZM149 495T169 475T189 426Q189 397 169 377T119 356Q90 356 70 376T50 426Q50 455 70 475T119
-495Q149 495 169 475Z" />
-<glyph unicode=";" glyph-name="semicolon" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 27 171 -13L104 -166H38L78 0Q65 10 58 25T50 58Q50 87 70 107T119 127Q149 127 169 107ZM149 495T169 475T189 426Q189 397 169 377T119 356Q90 356 70 376T50 426Q50
-455 70 475T119 495Q149 495 169 475Z" />
-<glyph unicode="<" glyph-name="less" horiz-adv-x="500" d="M417 551L450 475L123 333L450 189L417 115L50 286V380L417 551Z" />
-<glyph unicode="=" glyph-name="equal" horiz-adv-x="500" d="M62 389V466H438V389H62ZM62 452V529H438V452H62Z" />
-<glyph unicode=">" glyph-name="greater" horiz-adv-x="500" d="M83 551L450 380V286L83 115L50 189L377 333L50 475L83 551Z" />
-<glyph unicode="?" glyph-name="question" horiz-adv-x="459" d="M298 701T341 680T407 622T429 545Q429 506 416 479T383 434T332 394Q290 365 269 341T248 275V230H157V280Q157 323 171 353T206 401T259 442Q297 467 315 487T333 539Q333 580 306 602T232 625Q152
-625 93 553L30 602Q114 701 238 701Q298 701 341 680ZM235 127T255 107T275 58Q275 29 255 9T205 -12Q176 -12 156 8T136 58Q136 87 156 107T205 127Q235 127 255 107Z" />
-<glyph unicode="@" glyph-name="at" horiz-adv-x="1020" d="M660 701T756 648T901 504T950 307Q950 177 900 93T753 9Q697 9 666 40T625 112Q606 68 571 40T481 11Q401 11 355 71T308 231Q308 357 368 424T526 492Q568 492 605 483T683 452V193Q683 131 700 106T751
-80Q857 80 857 305Q857 402 819 474T707 585T526 625Q416 625 334 576T207 439T163 240Q163 129 205 44T330 -89T526 -137Q621 -137 718 -103L743 -174Q687 -194 638 -203T525 -213Q391 -213 288 -158T128 1T70 240Q70 370 127 475T289 640T526 701Q660 701 756
-648ZM567 78T600 164V411Q567 426 529 426Q398 426 398 231Q398 156 422 117T492 78Q567 78 600 164Z" />
-<glyph unicode="A" glyph-name="A" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250Z" />
-<glyph unicode="B" glyph-name="B" horiz-adv-x="608" d="M475 352T519 314T563 196Q563 0 290 0H100V689H263Q394 689 463 646T533 515Q533 455 496 415T404 364Q475 352 519 314ZM195 614V397H299Q359 397 397 426T436 508Q436 568 396 591T273 614H195ZM374
-76T418 101T463 196Q463 264 420 294T308 324H195V76H290Q374 76 418 101Z" />
-<glyph unicode="C" glyph-name="C" horiz-adv-x="560" d="M403 701T445 685T532 633L480 572Q417 623 347 623Q261 623 209 557T156 345Q156 203 208 136T346 68Q390 68 423 83T493 125L540 65Q508 32 458 10T343 -12Q259 -12 194 29T92 151T55 345Q55 458 93
-538T196 660T341 701Q403 701 445 685Z" />
-<glyph unicode="D" glyph-name="D" horiz-adv-x="644" d="M400 689T494 617T589 348Q589 157 495 79T265 0H100V689H244Q400 689 494 617ZM195 613V75H272Q368 75 428 134T488 348Q488 457 457 515T378 593T265 613H195Z" />
-<glyph unicode="E" glyph-name="E" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473Z" />
-<glyph unicode="F" glyph-name="F" horiz-adv-x="491" d="M100 0V689H466L455 613H195V378H420V303H195V0H100Z" />
-<glyph unicode="G" glyph-name="G" horiz-adv-x="631" d="M419 701T466 683T561 625L505 567Q468 597 434 610T354 623Q301 623 257 595T184 504T156 345Q156 200 203 133T344 66Q420 66 475 97V305H353L342 382H569V49Q462 -12 344 -12Q208 -12 132 79T55 345Q55
-457 95 537T204 659T354 701Q419 701 466 683Z" />
-<glyph unicode="H" glyph-name="H" horiz-adv-x="680" d="M485 0V323H195V0H100V689H195V401H485V689H580V0H485Z" />
-<glyph unicode="I" glyph-name="I" horiz-adv-x="295" d="M195 689V0H100V689H195Z" />
-<glyph unicode="J" glyph-name="J" horiz-adv-x="305" d="M210 96Q210 -6 166 -57T30 -137L5 -68Q51 -50 74 -29T106 22T115 100V689H210V96Z" />
-<glyph unicode="K" glyph-name="K" horiz-adv-x="589" d="M195 689V0H100V689H195ZM570 689L309 374L589 0H472L200 368L462 689H570Z" />
-<glyph unicode="L" glyph-name="L" horiz-adv-x="498" d="M195 689V83H478L467 0H100V689H195Z" />
-<glyph unicode="M" glyph-name="M" horiz-adv-x="778" d="M716 0H624L600 311Q585 494 583 592L434 78H345L188 593Q188 468 175 304L152 0H62L119 689H247L392 188L530 689H659L716 0Z" />
-<glyph unicode="N" glyph-name="N" horiz-adv-x="683" d="M583 0H456L176 585Q182 516 185 458T189 316V0H100V689H224L507 103Q504 129 499 194T494 313V689H583V0Z" />
-<glyph unicode="O" glyph-name="O" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206 133T346 66Q536
-66 536 344Q536 623 346 623Q256 623 206 555Z" />
-<glyph unicode="P" glyph-name="P" horiz-adv-x="581" d="M409 689T479 636T549 476Q549 363 476 308T282 253H195V0H100V689H281Q409 689 479 636ZM361 328T404 360T448 475Q448 549 405 582T280 615H195V328H278Q361 328 404 360Z" />
-<glyph unicode="Q" glyph-name="Q" horiz-adv-x="691" d="M534 39T579 23T666 -23L604 -103Q544 -50 490 -30T344 -10Q258 -10 193 30T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660T600 538T637 344Q637 223 597 152T479 39Q534 39 579 23ZM156
-200T206 133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555T156 343Q156 200 206 133Z" />
-<glyph unicode="R" glyph-name="R" horiz-adv-x="605" d="M302 292H195V0H100V689H281Q410 689 476 640T543 494Q543 422 506 377T394 309L580 0H467L302 292ZM291 365Q366 365 404 395T442 494Q442 558 404 586T280 615H195V365H291Z" />
-<glyph unicode="S" glyph-name="S" horiz-adv-x="545" d="M339 701T388 682T483 621L431 563Q392 594 355 608T274 623Q220 623 185 598T150 525Q150 495 162 475T206 437T301 401Q366 381 409 358T478 295T505 192Q505 132 476 86T391 14T259 -12Q116 -12 25
-77L77 135Q119 101 162 84T258 66Q322 66 364 97T406 189Q406 223 393 245T349 286T257 322Q151 354 102 399T53 521Q53 573 80 614T157 678T270 701Q339 701 388 682Z" />
-<glyph unicode="T" glyph-name="T" horiz-adv-x="517" d="M507 689L497 608H306V0H211V608H15V689H507Z" />
-<glyph unicode="U" glyph-name="U" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221Z" />
-<glyph unicode="V" glyph-name="V" horiz-adv-x="556" d="M550 689L330 0H228L6 689H108L281 103L454 689H550Z" />
-<glyph unicode="W" glyph-name="W" horiz-adv-x="826" d="M801 689L661 0H539L412 577L284 0H165L25 689H118L229 83L362 689H463L599 83L714 689H801Z" />
-<glyph unicode="X" glyph-name="X" horiz-adv-x="540" d="M325 372L535 0H427L268 305L107 0H5L212 367L23 689H131L270 430L410 689H512L325 372Z" />
-<glyph unicode="Y" glyph-name="Y" horiz-adv-x="550" d="M545 689L323 265V0H227V264L5 689H110L278 348L446 689H545Z" />
-<glyph unicode="Z" glyph-name="Z" horiz-adv-x="522" d="M477 689V612L136 81H477L466 0H30V76L374 609H66V689H477Z" />
-<glyph unicode="[" glyph-name="bracketleft" horiz-adv-x="322" d="M272 816V739H152V-40H272V-116H65V816H272Z" />
-<glyph unicode="\" glyph-name="backslash" horiz-adv-x="520" d="M183 807L415 -85L336 -104L105 789L183 807Z" />
-<glyph unicode="]" glyph-name="bracketright" horiz-adv-x="322" d="M257 816V-116H50V-40H170V739H50V816H257Z" />
-<glyph unicode="^" glyph-name="asciicircum" horiz-adv-x="540" d="M311 840L500 527H402L269 760L137 527H40L229 840H311Z" />
-<glyph unicode="_" glyph-name="underscore" horiz-adv-x="520" d="M17 -142V-63H503V-142H17Z" />
-<glyph unicode="`" glyph-name="grave" horiz-adv-x="300" d="M71 801L270 687L242 638L30 724L71 801Z" />
-<glyph unicode="a" glyph-name="a" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265 539Q358
-539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139Z" />
-<glyph unicode="b" glyph-name="b" horiz-adv-x="594" d="M426 539T479 467T532 264Q532 182 507 120T435 23T325 -12Q242 -12 185 58L176 0H95V739L187 750V461Q244 539 336 539Q426 539 479 467ZM364 61T398 110T433 264Q433 371 401 418T310 466Q240 466 187
-384V132Q208 99 238 80T303 61Q364 61 398 110Z" />
-<glyph unicode="c" glyph-name="c" horiz-adv-x="478" d="M334 539T373 526T448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291 66Q322 66 348 75T406 106L448 46Q376 -12 287 -12Q180 -12 119 60T57 259Q57 343 85 406T164
-504T287 539Q334 539 373 526Z" />
-<glyph unicode="d" glyph-name="d" horiz-adv-x="598" d="M503 739V0H422L413 73Q387 33 348 11T261 -12Q167 -12 115 62T62 261Q62 342 87 405T159 503T269 539Q350 539 411 474V750L503 739ZM323 61T353 80T411 139V397Q385 431 356 448T289 466Q228 466 195
-415T161 263Q161 161 192 111T281 61Q323 61 353 80Z" />
-<glyph unicode="e" glyph-name="e" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491 232ZM402
-306Q402 384 371 425T278 466Q165 466 155 300H402V306Z" />
-<glyph unicode="f" glyph-name="f" horiz-adv-x="335" d="M232 676T214 658T196 600V527H324L314 456H196V0H104V456H10V527H104V599Q104 667 147 708T269 750Q305 750 333 744T395 723L366 656Q321 676 274 676Q232 676 214 658Z" />
-<glyph unicode="g" glyph-name="g" horiz-adv-x="520" d="M520 503Q490 493 454 490T366 487Q459 445 459 354Q459 275 405 225T258 175Q222 175 191 185Q179 177 172 164T165 136Q165 93 234 93H318Q371 93 412 74T475 22T498 -53Q498 -130 435 -171T251 -213Q166
--213 117 -196T46 -143T25 -53H108Q108 -85 120 -103T163 -131T251 -141Q334 -141 369 -121T405 -59Q405 -22 377 -3T299 16H216Q149 16 115 44T80 116Q80 142 95 166T138 209Q92 233 71 268T49 355Q49 408 75 450T148 515T252 539Q314 538 356 543T425 558T493
-586L520 503ZM200 473T172 441T143 355Q143 301 172 269T254 236Q308 236 336 267T365 356Q365 473 252 473Q200 473 172 441Z" />
-<glyph unicode="h" glyph-name="h" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T320 467Q279 467 247 443T187 375V0H95V738L187 748V454Q249 539 343 539Q415 539 455 496Z" />
-<glyph unicode="i" glyph-name="i" horiz-adv-x="282" d="M187 527V0H95V527H187ZM169 780T187 762T205 717Q205 690 187 673T140 655Q112 655 94 672T76 717Q76 744 94 762T140 780Q169 780 187 762Z" />
-<glyph unicode="j" glyph-name="j" horiz-adv-x="280" d="M185 32Q185 -41 167 -85T115 -156T18 -212L-9 -145Q30 -127 51 -110T82 -61T93 26V527H185V32ZM168 780T186 762T204 717Q204 690 186 673T139 655Q111 655 93 672T75 717Q75 744 93 762T139 780Q168
-780 186 762Z" />
-<glyph unicode="k" glyph-name="k" horiz-adv-x="512" d="M187 750V0H95V739L187 750ZM490 527L296 294L512 0H402L193 288L387 527H490Z" />
-<glyph unicode="l" glyph-name="l" horiz-adv-x="293" d="M149 -12T120 18T90 104V739L182 750V106Q182 84 189 74T215 64Q234 64 249 70L273 6Q240 -12 200 -12Q149 -12 120 18Z" />
-<glyph unicode="m" glyph-name="m" horiz-adv-x="857" d="M689 539T728 496T767 378V0H675V365Q675 467 601 467Q562 467 535 445T477 374V0H385V365Q385 467 311 467Q271 467 244 444T187 374V0H95V527H174L182 450Q241 539 334 539Q383 539 417 514T467 444Q498
-490 535 514T624 539Q689 539 728 496Z" />
-<glyph unicode="n" glyph-name="n" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T321 467Q279 467 247 443T187 374V0H95V527H174L182 449Q210 491 251 515T343 539Q415 539 455 496Z" />
-<glyph unicode="o" glyph-name="o" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465 293 465Q156
-465 156 263Z" />
-<glyph unicode="p" glyph-name="p" horiz-adv-x="594" d="M438 539T485 467T532 264Q532 140 478 64T325 -12Q237 -12 187 48V-202L95 -213V527H174L181 456Q210 496 251 517T337 539Q438 539 485 467ZM433 63T433 264Q433 466 314 466Q275 466 243 443T187 384V127Q207
-96 237 80T303 63Q433 63 433 264Z" />
-<glyph unicode="q" glyph-name="q" horiz-adv-x="598" d="M503 527V-213L411 -202V70Q385 31 347 10T261 -12Q167 -12 115 62T62 261Q62 342 87 405T159 503T269 539Q353 539 417 468L424 527H503ZM323 61T353 80T411 139V397Q385 431 356 448T289 466Q228 466
-195 415T161 263Q161 161 192 111T281 61Q323 61 353 80Z" />
-<glyph unicode="r" glyph-name="r" horiz-adv-x="386" d="M352 539T376 533L359 443Q335 449 313 449Q264 449 234 413T187 301V0H95V527H174L183 420Q204 479 240 509T324 539Q352 539 376 533Z" />
-<glyph unicode="s" glyph-name="s" horiz-adv-x="467" d="M292 539T335 524T417 479L378 421Q342 444 310 455T241 466Q196 466 170 448T144 397Q144 365 168 347T257 312Q345 290 388 252T432 148Q432 70 372 29T224 -12Q104 -12 25 57L74 113Q141 62 222 62Q274
-62 304 83T335 142Q335 169 324 185T286 214T207 241Q123 263 86 300T48 394Q48 435 72 468T140 520T238 539Q292 539 335 524Z" />
-<glyph unicode="t" glyph-name="t" horiz-adv-x="361" d="M361 24Q309 -12 243 -12Q176 -12 139 26T101 138V456H9V527H101V646L193 657V527H318L308 456H193V142Q193 101 207 83T256 64Q287 64 326 85L361 24Z" />
-<glyph unicode="u" glyph-name="u" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0Z" />
-<glyph unicode="v" glyph-name="v" horiz-adv-x="492" d="M482 527L303 0H192L10 527H110L248 82L385 527H482Z" />
-<glyph unicode="w" glyph-name="w" horiz-adv-x="717" d="M697 527L577 0H452L360 444L265 0H143L20 527H112L207 64L311 527H414L513 64L609 527H697Z" />
-<glyph unicode="x" glyph-name="x" horiz-adv-x="485" d="M297 282L480 0H369L240 223L109 0H5L189 278L26 527H134L244 334L355 527H459L297 282Z" />
-<glyph unicode="y" glyph-name="y" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3Z" />
-<glyph unicode="z" glyph-name="z" horiz-adv-x="437" d="M404 527V457L129 77H407L396 0H25V69L299 449H48V527H404Z" />
-<glyph unicode="{" glyph-name="braceleft" horiz-adv-x="322" d="M277 765Q226 765 204 750T182 697V458Q182 407 164 385T107 349Q147 335 164 314T182 242V3Q182 -34 204 -49T277 -65V-136Q177 -136 136 -102T95 13V235Q95 277 80 294T25 311V387Q64 387 79
-405T95 465V687Q95 767 136 801T277 836V765Z" />
-<glyph unicode="|" glyph-name="bar" horiz-adv-x="403" d="M243 807V-102H160V807H243Z" />
-<glyph unicode="}" glyph-name="braceright" horiz-adv-x="322" d="M145 836T186 802T227 687V465Q227 423 242 405T297 387V311Q258 311 243 294T227 235V13Q227 -67 186 -101T45 -136V-65Q96 -65 118 -50T140 3V242Q140 293 157 314T215 349Q176 362 158 384T140
-458V697Q140 734 118 749T45 765V836Q145 836 186 802Z" />
-<glyph unicode="~" glyph-name="asciitilde" horiz-adv-x="488" d="M290 250T269 259T217 288Q199 300 187 306T163 312Q124 312 91 258L35 287Q85 384 172 384Q200 384 221 375T270 348Q290 335 302 329T328 323Q349 323 367 336T398 371L453 341Q406 250 319
-250Q290 250 269 259Z" />
-<glyph unicode=" " glyph-name="uni00A0" horiz-adv-x="265" />
-<glyph unicode="¡" glyph-name="exclamdown" horiz-adv-x="241" d="M150 495T170 475T190 425Q190 396 170 376T121 356Q91 356 71 376T51 425Q51 454 71 474T121 495Q150 495 170 475ZM162 247L173 -202H71L81 247H162Z" />
-<glyph unicode="¢" glyph-name="cent" horiz-adv-x="478" d="M448 46Q392 1 329 -9V-154H249V-9Q159 3 108 73T57 259Q57 374 108 448T250 536V684H329V536Q394 527 448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291
-66Q322 66 348 75T406 106L448 46Z" />
-<glyph unicode="£" glyph-name="sterling" horiz-adv-x="520" d="M213 153T200 125T152 77H472L461 0H40V73Q75 86 92 100T115 138T122 205V322H56V382H122V493Q122 576 172 627T311 679Q366 679 410 659T490 596L430 550Q406 578 379 591T315 604Q266 604
-240 576T213 494V382H421V322H213V204Q213 153 200 125Z" />
-<glyph unicode="¤" glyph-name="currency" horiz-adv-x="560" d="M492 272T455 218L531 143L476 88L398 164Q345 132 278 132Q212 132 160 167L82 88L29 143L107 221Q71 274 71 341Q71 406 106 460L29 540L84 595L162 515Q211 549 278 549Q347 549 399 516L478
-595L531 540L455 463Q492 411 492 341Q492 272 455 218ZM341 205T372 241T404 342Q404 407 373 443T281 479Q222 479 191 443T159 342Q159 277 190 241T281 205Q341 205 372 241Z" />
-<glyph unicode="¥" glyph-name="yen" horiz-adv-x="536" d="M531 669L340 346H453V284H315V194H453V133H315V0H221V133H82V194H221V284H82V346H196L5 669H107L271 374L434 669H531Z" />
-<glyph unicode="¦" glyph-name="brokenbar" horiz-adv-x="403" d="M243 807V443H160V807H243ZM243 262V-102H160V262H243Z" />
-<glyph unicode="§" glyph-name="section" horiz-adv-x="533" d="M441 136T441 75Q441 8 387 -31T246 -71Q149 -71 78 -21L113 40Q143 20 175 11T249 1Q293 1 321 18T349 66Q349 90 339 105T304 133T225 163Q142 190 106 222T70 311Q70 347 90 378T147 432Q120
-450 107 474T94 533Q94 600 146 638T281 677Q378 677 452 623L417 565Q384 586 352 596T280 606Q235 606 210 589T185 540Q185 516 194 501T230 471T307 440Q390 412 426 379T463 293Q463 224 387 173Q441 136 441 75ZM159 287T178 269T254 233Q297 219 333 203Q353
-221 364 241T375 280Q375 304 366 319T335 347T267 376Q232 389 200 403Q181 384 170 363T159 323Q159 287 178 269Z" />
-<glyph unicode="¨" glyph-name="dieresis" horiz-adv-x="385" d="M112 768T128 752T145 711Q145 687 129 671T88 654Q63 654 47 670T30 711Q30 735 46 751T88 768Q112 768 128 752ZM322 768T338 752T355 711Q355 687 339 671T297 654Q273 654 257 670T240
-711Q240 735 256 751T297 768Q322 768 338 752Z" />
-<glyph unicode="©" glyph-name="copyright" horiz-adv-x="810" d="M492 748T563 708T676 596T718 434Q718 344 677 273T564 161T406 121Q320 121 248 161T134 272T92 434Q92 524 134 595T248 707T406 748Q492 748 563 708ZM334 696T277 663T186 570T153 434Q153
-358 186 299T276 207T406 174Q477 174 534 207T625 299T658 434Q658 510 625 570T535 663T406 696Q334 696 277 663ZM444 625T471 615T525 585L490 538Q452 565 412 565Q371 565 346 533T321 435Q321 372 345 340T412 308Q437 308 456 315T496 339L528 291Q476
-245 409 245Q335 245 290 295T245 435Q245 495 267 538T326 603T408 625Q444 625 471 615Z" />
-<glyph unicode="ª" glyph-name="ordfeminine" horiz-adv-x="500" d="M313 525V549Q313 588 293 604T230 620Q181 620 117 599L95 661Q173 689 245 689Q402 689 402 554V384Q402 361 410 350T435 333L416 272Q381 276 360 289T327 331Q306 301 274 286T201
-271Q138 271 102 304T65 393Q65 457 114 491T255 525H313ZM280 337T313 390V470H265Q159 470 159 398Q159 369 176 353T224 337Q280 337 313 390ZM71 77H447V0H71V77Z" />
-<glyph unicode="«" glyph-name="guillemotleft" horiz-adv-x="575" d="M230 535L285 497L150 287L285 77L230 39L55 255V318L230 535ZM465 535L520 497L385 287L520 77L465 39L290 255V318L465 535Z" />
-<glyph unicode="¬" glyph-name="logicalnot" horiz-adv-x="500" d="M438 361V141H355V284H62V361H438Z" />
-<glyph unicode="­" glyph-name="uni00AD" horiz-adv-x="403" d="M60 274V352H343V274H60Z" />
-<glyph unicode="®" glyph-name="registered" horiz-adv-x="641" d="M390 750T448 716T540 622T574 493Q574 423 541 365T449 272T319 238Q250 238 192 272T101 364T67 493Q67 563 100 622T192 715T319 750Q390 750 448 716ZM377 287T422 313T493 387T519
-493Q519 552 494 599T423 674T319 701Q263 701 218 674T148 600T122 493Q122 434 147 387T218 314T319 287Q377 287 422 313ZM428 522T410 503T363 474L437 359H370L309 465H285V359H228V635H306Q428 635 428 551Q428 522 410 503ZM285 509H315Q369 509 369 551Q369
-572 356 581T313 591H285V509Z" />
-<glyph unicode="¯" glyph-name="overscore" horiz-adv-x="333" d="M303 667H30V736H303V667Z" />
-<glyph unicode="°" glyph-name="degree" horiz-adv-x="523" d="M176 381T139 400T78 455T55 541Q55 590 78 626T138 682T219 701Q262 701 299 682T360 626T383 540Q383 491 360 455T300 400T219 381Q176 381 139 400ZM256 443T281 468T306 540Q306 587 281
-612T219 638Q182 638 157 613T132 541Q132 494 157 469T219 443Q256 443 281 468Z" />
-<glyph unicode="±" glyph-name="plusminus" horiz-adv-x="500" d="M62 0V77H438V0H62ZM292 542V392H438V316H292V167H208V316H63V392H208V542H292Z" />
-<glyph unicode="²" glyph-name="uni00B2" horiz-adv-x="400" d="M259 746T296 712T334 626Q334 592 318 561T264 489T155 384H344L336 322H67V380Q151 461 187 499T238 565T254 620Q254 650 236 667T189 684Q163 684 144 674T104 640L55 678Q110 746 195
-746Q259 746 296 712Z" />
-<glyph unicode="³" glyph-name="uni00B3" horiz-adv-x="400" d="M261 746T297 716T334 641Q334 603 311 578T248 543Q292 539 320 513T348 441Q348 386 306 350T191 313Q104 313 52 373L97 415Q135 374 187 374Q224 374 245 393T267 445Q267 481 247 496T187
-512H153L162 568H185Q217 568 237 584T257 631Q257 657 239 672T191 687Q166 687 145 678T103 650L63 694Q121 746 197 746Q261 746 297 716Z" />
-<glyph unicode="´" glyph-name="acute" horiz-adv-x="300" d="M229 801L270 724L58 638L30 687L229 801Z" />
-<glyph unicode="µ" glyph-name="uni00B5" horiz-adv-x="588" d="M487 80T513 0L427 -12Q416 14 412 33T403 85V86Q379 44 344 16T265 -12Q230 -12 208 -1T169 38Q178 10 182 -20T186 -96V-202L95 -213V527H187V156Q187 67 266 67Q346 67 395 163V527H487V180Q487
-80 513 0Z" />
-<glyph unicode="¶" glyph-name="paragraph" horiz-adv-x="734" d="M594 689V-202L511 -215V616H397V-202L314 -215V282Q201 288 146 343T90 486Q90 583 156 636T336 689H594Z" />
-<glyph unicode="·" glyph-name="middot" horiz-adv-x="240" d="M149 380T169 360T189 311Q189 282 169 262T119 241Q90 241 70 261T50 311Q50 340 70 360T119 380Q149 380 169 360Z" />
-<glyph unicode="¸" glyph-name="cedilla" horiz-adv-x="275" d="M152 -56Q200 -60 222 -83T245 -141Q245 -189 210 -215T121 -241Q93 -241 69 -235T30 -217L55 -165Q85 -181 118 -181Q141 -181 154 -172T168 -141Q168 -120 147 -110T79 -99L93 16H152V-56Z" />
-<glyph unicode="¹" glyph-name="uni00B9" horiz-adv-x="400" d="M274 739V322H197V660L99 603L65 656L205 739H274Z" />
-<glyph unicode="º" glyph-name="ordmasculine" horiz-adv-x="500" d="M343 689T393 634T444 480Q444 385 393 328T250 271Q158 271 107 327T56 480Q56 575 108 632T251 689Q343 689 393 634ZM151 620T151 480Q151 340 250 340Q349 340 349 480Q349 552 325
-586T251 620Q151 620 151 480ZM62 0V77H438V0H62Z" />
-<glyph unicode="»" glyph-name="guillemotright" horiz-adv-x="566" d="M110 535L285 318V255L110 39L55 77L190 287L55 497L110 535ZM336 535L511 318V255L336 39L281 77L416 287L281 497L336 535Z" />
-<glyph unicode="¼" glyph-name="onequarter" horiz-adv-x="932" d="M274 689V272H197V610L99 553L65 606L205 689H274ZM640 750L699 721L293 -78L233 -49L640 750ZM889 156V96H836V0H760V96H574V150L702 424L768 399L655 156H761L768 261H836V156H889Z" />
-<glyph unicode="½" glyph-name="onehalf" horiz-adv-x="932" d="M274 689V272H197V610L99 553L65 606L205 689H274ZM640 750L699 721L293 -78L233 -49L640 750ZM791 424T828 390T866 304Q866 270 850 239T796 167T687 62H876L868 0H599V58Q683 139 719 177T770
-243T786 298Q786 328 768 345T721 362Q695 362 676 352T636 318L587 356Q642 424 727 424Q791 424 828 390Z" />
-<glyph unicode="¾" glyph-name="threequarters" horiz-adv-x="932" d="M261 696T297 666T334 591Q334 553 311 528T248 493Q292 489 320 463T348 391Q348 336 306 300T191 263Q104 263 52 323L97 365Q135 324 187 324Q224 324 245 343T267 395Q267 431 247
-446T187 462H153L162 518H185Q217 518 237 534T257 581Q257 607 239 622T191 637Q166 637 145 628T103 600L63 644Q121 696 197 696Q261 696 297 666ZM640 750L699 721L293 -78L233 -49L640 750ZM889 156V96H836V0H760V96H574V150L702 424L768 399L655 156H761L768
-261H836V156H889Z" />
-<glyph unicode="¿" glyph-name="questiondown" horiz-adv-x="459" d="M224 356T204 376T184 425Q184 454 204 474T254 495Q283 495 303 475T323 425Q323 396 303 376T254 356Q224 356 204 376ZM161 -215T118 -194T52 -136T30 -59Q30 -19 43 8T77 53T129 92Q170
-120 190 143T211 206V247H302V201Q302 159 288 130T254 84T201 44Q163 20 145 0T126 -53Q126 -94 153 -116T227 -139Q307 -139 366 -67L429 -116Q345 -215 221 -215Q161 -215 118 -194Z" />
-<glyph unicode="À" glyph-name="Agrave" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM196 911L397 804L373 755L157 834L196 911Z" />
-<glyph unicode="Á" glyph-name="Aacute" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM367 911L407 834L191 755L167 804L367 911Z" />
-<glyph unicode="Â" glyph-name="Acircumflex" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM160 759L120 804L256 914H317L452 804L413 759L286 840L160 759Z" />
-<glyph unicode="Ã" glyph-name="Atilde" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM326 782T311 789T276 809Q261 820 251 825T229 830Q213 830 201 819T176 784L120 812Q139 852 166 876T229
-900Q250 900 265 893T299 872Q302 870 311 864T329 855T345 852Q360 852 372 862T398 896L454 868Q435 826 407 804T345 782Q326 782 311 789Z" />
-<glyph unicode="Ä" glyph-name="Adieresis" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM206 894T222 878T239 837Q239 813 223 797T182 780Q157 780 141 796T124 837Q124 861 140 877T182 894Q206
-894 222 878ZM416 894T432 878T449 837Q449 813 433 797T391 780Q367 780 351 796T334 837Q334 861 350 877T391 894Q416 894 432 878Z" />
-<glyph unicode="Å" glyph-name="Aring" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM337 962T369 932T401 856Q401 811 369 781T287 750Q237 750 205 780T173 856Q173 901 205 931T287 962Q337
-962 369 932ZM262 912T248 897T234 856Q234 830 248 815T287 800Q311 800 325 815T340 856Q340 882 326 897T287 912Q262 912 248 897Z" />
-<glyph unicode="Æ" glyph-name="AE" horiz-adv-x="816" d="M535 76H762V0H458L418 173H150L85 0H-12L262 689H721L710 613H401L457 387H712V311H476L535 76ZM179 250H400L316 613L179 250Z" />
-<glyph unicode="Ç" glyph-name="Ccedilla" horiz-adv-x="560" d="M512 36T471 16T376 -10V-56Q424 -60 446 -83T469 -141Q469 -189 434 -215T345 -241Q317 -241 293 -235T254 -217L279 -165Q309 -181 342 -181Q365 -181 378 -172T392 -141Q392 -120 371 -110T303
--99L314 -11Q237 -4 179 39T88 160T55 345Q55 458 93 538T196 660T341 701Q403 701 445 685T532 633L480 572Q417 623 347 623Q261 623 209 557T156 345Q156 203 208 136T346 68Q390 68 423 83T493 125L540 65Q512 36 471 16Z" />
-<glyph unicode="È" glyph-name="Egrave" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM199 911L400 804L376 755L160 834L199 911Z" />
-<glyph unicode="É" glyph-name="Eacute" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM370 911L410 834L194 755L170 804L370 911Z" />
-<glyph unicode="Ê" glyph-name="Ecircumflex" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM163 759L123 804L259 914H320L455 804L416 759L289 840L163 759Z" />
-<glyph unicode="Ë" glyph-name="Edieresis" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM209 894T225 878T242 837Q242 813 226 797T185 780Q160 780 144 796T127 837Q127 861 143 877T185 894Q209 894 225 878ZM419
-894T435 878T452 837Q452 813 436 797T394 780Q370 780 354 796T337 837Q337 861 353 877T394 894Q419 894 435 878Z" />
-<glyph unicode="Ì" glyph-name="Igrave" horiz-adv-x="295" d="M195 689V0H100V689H195ZM56 911L257 804L233 755L17 834L56 911Z" />
-<glyph unicode="Í" glyph-name="Iacute" horiz-adv-x="295" d="M195 689V0H100V689H195ZM227 911L267 834L51 755L27 804L227 911Z" />
-<glyph unicode="Î" glyph-name="Icircumflex" horiz-adv-x="295" d="M195 689V0H100V689H195ZM20 759L-20 804L116 914H177L312 804L273 759L146 840L20 759Z" />
-<glyph unicode="Ï" glyph-name="Idieresis" horiz-adv-x="295" d="M195 689V0H100V689H195ZM66 894T82 878T99 837Q99 813 83 797T42 780Q17 780 1 796T-16 837Q-16 861 0 877T42 894Q66 894 82 878ZM276 894T292 878T309 837Q309 813 293 797T251 780Q227
-780 211 796T194 837Q194 861 210 877T251 894Q276 894 292 878Z" />
-<glyph unicode="Ð" glyph-name="Eth" horiz-adv-x="656" d="M412 689T506 617T601 348Q601 157 507 79T277 0H112V318H20V388H112V689H256Q412 689 506 617ZM380 75T440 134T500 348Q500 457 469 515T390 593T277 613H207V388H364V318H207V75H284Q380 75 440 134Z" />
-<glyph unicode="Ñ" glyph-name="Ntilde" horiz-adv-x="683" d="M583 0H456L176 585Q182 516 185 458T189 316V0H100V689H224L507 103Q504 129 499 194T494 313V689H583V0ZM392 782T377 789T342 809Q327 820 317 825T295 830Q279 830 267 819T242 784L186
-812Q205 852 232 876T295 900Q316 900 331 893T365 872Q368 870 377 864T395 855T411 852Q426 852 438 862T464 896L520 868Q501 826 473 804T411 782Q392 782 377 789Z" />
-<glyph unicode="Ò" glyph-name="Ograve" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
-133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM255 911L456 804L432 755L216 834L255 911Z" />
-<glyph unicode="Ó" glyph-name="Oacute" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
-133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM426 911L466 834L250 755L226 804L426 911Z" />
-<glyph unicode="Ô" glyph-name="Ocircumflex" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200
-206 133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM219 759L179 804L315 914H376L511 804L472 759L345 840L219 759Z" />
-<glyph unicode="Õ" glyph-name="Otilde" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
-133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM385 782T370 789T335 809Q320 820 310 825T288 830Q272 830 260 819T235 784L179 812Q198 852 225 876T288 900Q309 900 324 893T358 872Q361 870 370 864T388 855T404 852Q419 852 431 862T457 896L513
-868Q494 826 466 804T404 782Q385 782 370 789Z" />
-<glyph unicode="Ö" glyph-name="Odieresis" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
-133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM265 894T281 878T298 837Q298 813 282 797T241 780Q216 780 200 796T183 837Q183 861 199 877T241 894Q265 894 281 878ZM475 894T491 878T508 837Q508 813 492 797T450 780Q426 780 410 796T393 837Q393
-861 409 877T450 894Q475 894 491 878Z" />
-<glyph unicode="×" glyph-name="multiply" horiz-adv-x="500" d="M372 486L428 429L308 309L428 185L372 129L252 253L128 129L72 185L192 305L72 429L128 486L248 361L372 486Z" />
-<glyph unicode="Ø" glyph-name="Oslash" horiz-adv-x="692" d="M558 628T597 546T637 344Q637 232 601 152T499 30T346 -12Q310 -12 279 -5L244 -127L165 -106L205 22Q134 62 95 143T55 343Q55 454 91 535T194 658T346 701Q383 701 412 694L449 819L528 798L486
-667Q558 628 597 546ZM256 623T206 555T156 343Q156 158 238 97L396 618Q369 623 346 623Q256 623 206 555ZM536 66T536 344Q536 443 515 504T452 594L296 71Q321 66 346 66Q536 66 536 344Z" />
-<glyph unicode="Ù" glyph-name="Ugrave" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM240 911L441 804L417 755L201 834L240 911Z" />
-<glyph unicode="Ú" glyph-name="Uacute" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM411 911L451 834L235 755L211 804L411 911Z" />
-<glyph unicode="Û" glyph-name="Ucircumflex" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM204 759L164 804L300 914H361L496 804L457
-759L330 840L204 759Z" />
-<glyph unicode="Ü" glyph-name="Udieresis" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM250 894T266 878T283 837Q283 813 267 797T226
-780Q201 780 185 796T168 837Q168 861 184 877T226 894Q250 894 266 878ZM460 894T476 878T493 837Q493 813 477 797T435 780Q411 780 395 796T378 837Q378 861 394 877T435 894Q460 894 476 878Z" />
-<glyph unicode="Ý" glyph-name="Yacute" horiz-adv-x="550" d="M545 689L323 265V0H227V264L5 689H110L278 348L446 689H545ZM355 911L395 834L179 755L155 804L355 911Z" />
-<glyph unicode="Þ" glyph-name="Thorn" horiz-adv-x="581" d="M409 571T479 517T549 354Q549 238 476 183T282 127H195V0H100V689H195V571H281Q409 571 479 517ZM362 202T405 235T448 353Q448 430 405 463T280 497H195V202H278Q362 202 405 235Z" />
-<glyph unicode="ß" glyph-name="germandbls" horiz-adv-x="593" d="M351 750T391 731T454 680T476 607Q476 566 459 542T410 492Q386 472 376 459T365 427Q365 404 382 387T434 346Q472 320 495 299T536 244T553 162Q553 110 529 71T463 10T375 -12Q316 -12
-273 11L300 75Q326 62 366 62Q408 62 433 88T459 163Q459 208 436 236T366 297Q323 328 301 354T278 420Q278 453 292 472T335 515Q362 537 375 555T388 602Q388 639 362 658T295 678Q187 678 187 539V0H95V539Q95 639 147 694T296 750Q351 750 391 731Z" />
-<glyph unicode="à" glyph-name="agrave" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
-539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM192 801L391 687L363 638L151 724L192 801Z" />
-<glyph unicode="á" glyph-name="aacute" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
-539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM340 801L381 724L169 638L141 687L340 801Z" />
-<glyph unicode="â" glyph-name="acircumflex" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539
-265 539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM134 634L95 679L230 792H291L427 679L387 634L261 718L134 634Z" />
-<glyph unicode="ã" glyph-name="atilde" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
-539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM300 656T285 663T250 683Q235 694 225 699T203 704Q187 704 175 693T150 658L94 686Q113 726 140 750T203 774Q224 774 239 767T273
-746Q276 744 285 738T303 729T319 726Q334 726 346 736T372 770L428 742Q409 700 381 678T319 656Q300 656 285 663Z" />
-<glyph unicode="ä" glyph-name="adieresis" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539
-265 539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM180 768T196 752T213 711Q213 687 197 671T156 654Q131 654 115 670T98 711Q98 735 114 751T156 768Q180 768 196 752ZM390
-768T406 752T423 711Q423 687 407 671T365 654Q341 654 325 670T308 711Q308 735 324 751T365 768Q390 768 406 752Z" />
-<glyph unicode="å" glyph-name="aring" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
-539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM311 836T343 806T375 730Q375 685 343 655T261 624Q211 624 179 654T147 730Q147 775 179 805T261 836Q311 836 343 806ZM236
-786T222 771T208 730Q208 704 222 689T261 674Q285 674 299 689T314 730Q314 756 300 771T261 786Q236 786 222 771Z" />
-<glyph unicode="æ" glyph-name="ae" horiz-adv-x="849" d="M797 256T795 232H459Q465 145 503 104T601 63Q639 63 671 74T738 109L778 54Q694 -12 594 -12Q531 -12 483 13T404 85Q368 33 323 11T216 -12Q137 -12 91 32T45 147Q45 231 107 276T280 321H361V360Q361
-416 334 440T251 464Q193 464 109 436L86 503Q184 539 268 539Q382 539 425 455Q482 539 584 539Q686 539 741 470T797 279Q797 256 795 232ZM706 306Q706 384 675 425T582 466Q469 466 459 300H706V306ZM279 57T312 79T376 149Q361 197 361 257V260H292Q146 260
-146 152Q146 105 169 81T237 57Q279 57 312 79Z" />
-<glyph unicode="ç" glyph-name="ccedilla" horiz-adv-x="478" d="M385 -5T308 -11V-56Q356 -60 378 -83T401 -141Q401 -189 366 -215T277 -241Q249 -241 225 -235T186 -217L211 -165Q241 -181 274 -181Q297 -181 310 -172T324 -141Q324 -120 303 -110T235
--99L246 -9Q157 5 107 75T57 259Q57 343 85 406T164 504T287 539Q334 539 373 526T448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291 66Q322 66 348 75T406 106L448 46Q385 -5 308 -11Z" />
-<glyph unicode="è" glyph-name="egrave" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491
-232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM210 801L409 687L381 638L169 724L210 801Z" />
-<glyph unicode="é" glyph-name="eacute" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491
-232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM358 801L399 724L187 638L159 687L358 801Z" />
-<glyph unicode="ê" glyph-name="ecircumflex" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256
-491 232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM152 634L113 679L248 792H309L445 679L405 634L279 718L152 634Z" />
-<glyph unicode="ë" glyph-name="edieresis" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256
-491 232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM198 768T214 752T231 711Q231 687 215 671T174 654Q149 654 133 670T116 711Q116 735 132 751T174 768Q198 768 214 752ZM408 768T424 752T441 711Q441 687 425 671T383 654Q359 654 343 670T326
-711Q326 735 342 751T383 768Q408 768 424 752Z" />
-<glyph unicode="ì" glyph-name="igrave" horiz-adv-x="282" d="M187 527V0H95V527H187ZM72 801L271 687L243 638L31 724L72 801Z" />
-<glyph unicode="í" glyph-name="iacute" horiz-adv-x="282" d="M187 527V0H95V527H187ZM220 801L261 724L49 638L21 687L220 801Z" />
-<glyph unicode="î" glyph-name="icircumflex" horiz-adv-x="282" d="M187 527V0H95V527H187ZM14 634L-25 679L110 792H171L307 679L267 634L141 718L14 634Z" />
-<glyph unicode="ï" glyph-name="idieresis" horiz-adv-x="282" d="M187 527V0H95V527H187ZM60 768T76 752T93 711Q93 687 77 671T36 654Q11 654 -5 670T-22 711Q-22 735 -6 751T36 768Q60 768 76 752ZM270 768T286 752T303 711Q303 687 287 671T245 654Q221
-654 205 670T188 711Q188 735 204 751T245 768Q270 768 286 752Z" />
-<glyph unicode="ð" glyph-name="eth" horiz-adv-x="570" d="M432 596T470 501T508 265Q508 182 479 120T398 23T278 -12Q216 -12 166 17T86 102T57 235Q57 297 79 352T147 441T258 475Q349 475 405 408Q393 471 365 519T286 607L214 537L151 569L225 644Q173
-668 112 680L132 750Q217 733 281 702L351 776L405 729L342 664Q432 596 470 501ZM340 61T377 114T415 266Q415 287 413 325Q387 364 353 383T272 403Q151 403 151 239Q151 153 185 107T277 61Q340 61 377 114Z" />
-<glyph unicode="ñ" glyph-name="ntilde" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T321 467Q279 467 247 443T187 374V0H95V527H174L182 449Q210 491 251 515T343 539Q415 539 455 496ZM337 656T322 663T287 683Q272 694
-262 699T240 704Q224 704 212 693T187 658L131 686Q150 726 177 750T240 774Q261 774 276 767T310 746Q313 744 322 738T340 729T356 726Q371 726 383 736T409 770L465 742Q446 700 418 678T356 656Q337 656 322 663Z" />
-<glyph unicode="ò" glyph-name="ograve" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
-293 465Q156 465 156 263ZM223 801L422 687L394 638L182 724L223 801Z" />
-<glyph unicode="ó" glyph-name="oacute" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
-293 465Q156 465 156 263ZM371 801L412 724L200 638L172 687L371 801Z" />
-<glyph unicode="ô" glyph-name="ocircumflex" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428
-465 293 465Q156 465 156 263ZM165 634L126 679L261 792H322L458 679L418 634L292 718L165 634Z" />
-<glyph unicode="õ" glyph-name="otilde" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
-293 465Q156 465 156 263ZM331 656T316 663T281 683Q266 694 256 699T234 704Q218 704 206 693T181 658L125 686Q144 726 171 750T234 774Q255 774 270 767T304 746Q307 744 316 738T334 729T350 726Q365 726 377 736T403 770L459 742Q440 700 412 678T350 656Q331
-656 316 663Z" />
-<glyph unicode="ö" glyph-name="odieresis" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428
-465 293 465Q156 465 156 263ZM211 768T227 752T244 711Q244 687 228 671T187 654Q162 654 146 670T129 711Q129 735 145 751T187 768Q211 768 227 752ZM421 768T437 752T454 711Q454 687 438 671T396 654Q372 654 356 670T339 711Q339 735 355 751T396 768Q421
-768 437 752Z" />
-<glyph unicode="÷" glyph-name="divide" horiz-adv-x="500" d="M280 174T300 154T320 105Q320 76 300 56T250 35Q221 35 201 55T181 105Q181 134 201 154T250 174Q280 174 300 154ZM280 631T300 611T320 562Q320 533 300 513T250 492Q221 492 201 512T181
-562Q181 591 201 611T250 631Q280 631 300 611ZM62 294V371H438V294H62Z" />
-<glyph unicode="ø" glyph-name="oslash" horiz-adv-x="584" d="M470 475T498 413T527 264Q527 182 499 120T418 23T292 -12Q268 -12 241 -7L202 -130L127 -108L169 19Q115 52 86 115T57 263Q57 345 85 407T166 504T293 539Q317 539 344 534L383 656L458 634L416
-508Q470 475 498 413ZM156 465T156 263Q156 134 204 89L328 462Q311 465 293 465Q156 465 156 263ZM428 62T428 264Q428 331 417 373T381 437L258 65Q273 62 292 62Q428 62 428 264Z" />
-<glyph unicode="ù" glyph-name="ugrave" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM220 801L419 687L391 638L179 724L220 801Z" />
-<glyph unicode="ú" glyph-name="uacute" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM368 801L409 724L197 638L169 687L368 801Z" />
-<glyph unicode="û" glyph-name="ucircumflex" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM162 634L123 679L258 792H319L455 679L415 634L289 718L162
-634Z" />
-<glyph unicode="ü" glyph-name="udieresis" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM208 768T224 752T241 711Q241 687 225 671T184 654Q159
-654 143 670T126 711Q126 735 142 751T184 768Q208 768 224 752ZM418 768T434 752T451 711Q451 687 435 671T393 654Q369 654 353 670T336 711Q336 735 352 751T393 768Q418 768 434 752Z" />
-<glyph unicode="ý" glyph-name="yacute" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3ZM325 801L366 724L154 638L126 687L325 801Z" />
-<glyph unicode="þ" glyph-name="thorn" horiz-adv-x="594" d="M438 539T485 467T532 264Q532 140 478 64T325 -12Q237 -12 187 48V-198L95 -213V739L187 750V463Q215 500 254 519T337 539Q438 539 485 467ZM433 63T433 264Q433 466 314 466Q275 466 243 443T187
-384V127Q207 96 237 80T303 63Q433 63 433 264Z" />
-<glyph unicode="ÿ" glyph-name="ydieresis" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3ZM165 768T181 752T198 711Q198 687 182 671T141 654Q116 654 100
-670T83 711Q83 735 99 751T141 768Q165 768 181 752ZM375 768T391 752T408 711Q408 687 392 671T350 654Q326 654 310 670T293 711Q293 735 309 751T350 768Q375 768 391 752Z" />
-<glyph unicode="–" glyph-name="endash" horiz-adv-x="520" d="M32 274V352H488V274H32Z" />
-<glyph unicode="—" glyph-name="emdash" horiz-adv-x="790" d="M32 274V352H758V274H32Z" />
-<glyph unicode="‘" glyph-name="quoteleft" horiz-adv-x="228" d="M82 490T63 508T44 553Q44 565 47 577T61 611L128 753H188L148 603Q174 583 174 553Q174 527 155 509T109 490Q82 490 63 508Z" />
-<glyph unicode="’" glyph-name="quoteright" horiz-adv-x="228" d="M146 753T165 735T184 690Q184 678 181 666T167 632L100 490H40L80 640Q54 660 54 690Q54 716 73 734T119 753Q146 753 165 735Z" />
-<glyph unicode="‚" glyph-name="quotesinglbase" horiz-adv-x="228" d="M146 107T165 89T184 44Q184 32 181 20T167 -14L100 -156H40L80 -6Q54 14 54 44Q54 70 73 88T119 107Q146 107 165 89Z" />
-<glyph unicode="“" glyph-name="quotedblleft" horiz-adv-x="406" d="M82 490T63 508T44 553Q44 565 47 577T61 611L128 753H188L148 603Q174 583 174 553Q174 527 155 509T109 490Q82 490 63 508ZM260 490T241 508T222 553Q222 565 225 577T239 611L306
-753H366L326 603Q352 583 352 553Q352 527 333 509T287 490Q260 490 241 508Z" />
-<glyph unicode="”" glyph-name="quotedblright" horiz-adv-x="406" d="M146 753T165 735T184 690Q184 678 181 666T167 632L100 490H40L80 640Q54 660 54 690Q54 716 73 734T119 753Q146 753 165 735ZM324 753T343 735T362 690Q362 678 359 666T345 632L278
-490H218L258 640Q232 660 232 690Q232 716 251 734T297 753Q324 753 343 735Z" />
-<glyph unicode="„" glyph-name="quotedblbase" horiz-adv-x="406" d="M146 107T165 89T184 44Q184 32 181 20T167 -14L100 -156H40L80 -6Q54 14 54 44Q54 70 73 88T119 107Q146 107 165 89ZM324 107T343 89T362 44Q362 32 359 20T345 -14L278 -156H218L258
--6Q232 14 232 44Q232 70 251 88T297 107Q324 107 343 89Z" />
-<glyph unicode="•" glyph-name="bullet" horiz-adv-x="324" d="M210 454T242 422T274 341Q274 293 242 261T162 229Q114 229 82 261T50 342Q50 390 82 422T162 454Q210 454 242 422Z" />
-<glyph unicode="‹" glyph-name="guilsinglleft" horiz-adv-x="340" d="M230 535L285 497L150 287L285 77L230 39L55 255V318L230 535Z" />
-<glyph unicode="›" glyph-name="guilsinglright" horiz-adv-x="340" d="M110 535L285 318V255L110 39L55 77L190 287L55 497L110 535Z" />
-</font>
-</defs>
-</svg>
+++ /dev/null
-\ifouthtml
-\begin{rawhtml}
-<ul>
-<li><a HREF=libref/index_modules.html>Index of modules</a></li>
-<li><a HREF=libref/index_module_types.html>Index of module types</a></li>
-<li><a HREF=libref/index_types.html>Index of types</a></li>
-<li><a HREF=libref/index_exceptions.html>Index of exceptions</a></li>
-<li><a HREF=libref/index_values.html>Index of values</a></li>
-</ul>
-\end{rawhtml}
-\else
-\chapter*{Index to the library}
-\markright{Index to the library}
-\addcontentsline{toc}{chapter}{Index to the library}
-\myprintindex{\jobname.ind}
-\fi
-\chapter*{Index of keywords}
-\markright{Index of keywords}
-\addcontentsline{toc}{chapter}{Index of keywords}
-\myprintindex{\jobname.kwd.ind}
+++ /dev/null
-*.haux
-*.hind
-*.info*.gz
-*.info.body*
-ocaml.hocaml.kwd
+++ /dev/null
-*.tex
-*.htex
-arithstatus.mli
-ocamldoc.out
-ocamldoc.sty
-compiler_libs.txt
-
+++ /dev/null
-SRC = ../../..
-
-CSLDIR = $(SRC)
-
-LD_PATH := "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
-SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_PATH)
-
-
-OCAMLDOC = $(if $(wildcard $(CSLDIR)/ocamldoc/ocamldoc.opt),\
- $(CSLDIR)/ocamldoc/ocamldoc.opt,\
- $(SET_LD_PATH) $(CSLDIR)/runtime/ocamlrun $(CSLDIR)/ocamldoc/ocamldoc) \
- -hide Stdlib -lib Stdlib -nostdlib \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk"
-
-
-#Import mli file lists
-include $(SRC)/ocamldoc/Makefile.docfiles
-
-
-TEXQUOTE = $(SRC)/runtime/ocamlrun ../../tools/texquote2
-
-CORE_INTF = Stdlib.tex
-
-STDLIB_INTF = $(STDLIB_MODs:%=%.tex)
-
-COMPILER_LIBS_PLUGIN_HOOKS = Pparse.tex Typemod.tex
-
-COMPILER_LIBS_INTF = Asthelper.tex Astmapper.tex Asttypes.tex \
- Lexer.tex Location.tex Longident.tex Parse.tex Pprintast.tex Printast.tex \
- $(COMPILER_LIBS_PLUGIN_HOOKS)
-
-OTHERLIB_INTF = Unix.tex UnixLabels.tex Str.tex \
- Thread.tex Mutex.tex Condition.tex Semaphore.tex Event.tex \
- Dynlink.tex Bigarray.tex
-
-INTF = $(CORE_INTF) $(STDLIB_INTF) $(COMPILER_LIBS_INTF) $(OTHERLIB_INTF)
-
-BLURB = core.tex builtin.tex stdlib-blurb.tex compilerlibs.tex \
- libunix.tex libstr.tex old.tex \
- libthreads.tex libdynlink.tex
-
-FILES = $(BLURB) $(INTF)
-
-
-etex-files: $(BLURB)
-all: libs
-
-libs: $(FILES)
-
-
-# ocamldoc.out is used as witness for the generation of the stdlib tex files to
-# avoid issues with parallel make invocations.
-$(INTF): ocamldoc.out
-ocamldoc.out: $(DOC_ALL)
- $(OCAMLDOC) -latex \
- $(DOC_ALL_INCLUDES) \
- $(DOC_ALL_MLIS) \
- $(DOC_ALL_TEXT:%=-text %) \
- -sepfiles \
- -latextitle "1,subsection*" \
- -latextitle "2,subsubsection*" \
- -latex-type-prefix "TYP" \
- -latex-module-prefix "" \
- -latex-module-type-prefix "" \
- -latex-value-prefix ""
- mv Ast_helper.tex Asthelper.tex
- mv Ast_mapper.tex Astmapper.tex
- mv Ocaml_operators.tex Ocamloperators.tex
-
-%.tex: %.etex
- $(TEXQUOTE) < $< > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-
-.PHONY: clean
-clean:
- rm -f *.tex ocamldoc.out ocamldoc.sty
- rm -f compiler_libs.txt
+++ /dev/null
-\section{s:core-builtins}{Built-in types and predefined exceptions}
-
-The following built-in types and predefined exceptions are always
-defined in the
-compilation environment, but are not part of any module. As a
-consequence, they can only be referred by their short names.
-
-%\vspace{0.1cm}
-\subsection*{ss:builtin-types}{Built-in types}
-%\vspace{0.1cm}
-
-\begin{ocamldoccode}
- type int
-\end{ocamldoccode}
-\index{int@\verb`int`}
-\begin{ocamldocdescription}
- The type of integer numbers.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type char
-\end{ocamldoccode}
-\index{char@\verb`char`}
-\begin{ocamldocdescription}
- The type of characters.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type bytes
-\end{ocamldoccode}
-\index{bytes@\verb`bytes`}
-\begin{ocamldocdescription}
- The type of (writable) byte sequences.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type string
-\end{ocamldoccode}
-\index{string@\verb`string`}
-\begin{ocamldocdescription}
- The type of (read-only) character strings.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type float
-\end{ocamldoccode}
-\index{float@\verb`float`}
-\begin{ocamldocdescription}
- The type of floating-point numbers.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type bool = false | true
-\end{ocamldoccode}
-\index{bool@\verb`bool`}
-\begin{ocamldocdescription}
- The type of booleans (truth values).
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type unit = ()
-\end{ocamldoccode}
-\index{unit@\verb`unit`}
-\begin{ocamldocdescription}
- The type of the unit value.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type exn
-\end{ocamldoccode}
-\index{exn@\verb`exn`}
-\begin{ocamldocdescription}
- The type of exception values.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type 'a array
-\end{ocamldoccode}
-\index{array@\verb`array`}
-\begin{ocamldocdescription}
- The type of arrays whose elements have type "'a".
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
- type 'a list = [] | :: of 'a * 'a list
-\end{ocamldoccode}
-\index{list@\verb`list`}
-\begin{ocamldocdescription}
- The type of lists whose elements have type "'a".
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type 'a option = None | Some of 'a
-\end{ocamldoccode}
-\index{option@\verb`option`}
-\begin{ocamldocdescription}
- The type of optional values of type "'a".
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type int32
-\end{ocamldoccode}
-\index{int32@\verb`int32`}
-\begin{ocamldocdescription}
- The type of signed 32-bit integers.
- Literals for 32-bit integers are suffixed by l.
- See the \stdmoduleref{Int32} module.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type int64
-\end{ocamldoccode}
-\index{int64@\verb`int64`}
-\begin{ocamldocdescription}
- The type of signed 64-bit integers.
- Literals for 64-bit integers are suffixed by L.
- See the \stdmoduleref{Int64} module.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type nativeint
-\end{ocamldoccode}
-\index{nativeint@\verb`nativeint`}
-\begin{ocamldocdescription}
- The type of signed, platform-native integers (32 bits on 32-bit
- processors, 64 bits on 64-bit processors).
- Literals for native integers are suffixed by n.
- See the \stdmoduleref{Nativeint} module.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type ('a, 'b, 'c, 'd, 'e, 'f) format6
-\end{ocamldoccode}
-\index{format4@\verb`format4`}
-\begin{ocamldocdescription}
- The type of format strings. "'a" is the type of the parameters of
- the format, "'f" is the result type for the "printf"-style
- functions, "'b" is the type of the first argument given to "%a" and
- "%t" printing functions (see module \stdmoduleref{Printf}),
- "'c" is the result type of these functions, and also the type of the
- argument transmitted to the first argument of "kprintf"-style
- functions, "'d" is the result type for the "scanf"-style functions
- (see module \stdmoduleref{Scanf}), and "'e" is the type of the receiver function
- for the "scanf"-style functions.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-type 'a lazy_t
-\end{ocamldoccode}
-\index{lazyt@\verb`lazy_t`}
-\begin{ocamldocdescription}
- This type is used to implement the \stdmoduleref{Lazy} module.
- It should not be used directly.
-\end{ocamldocdescription}
-
-%\vspace{0.1cm}
-\subsection*{ss:predef-exn}{Predefined exceptions}
-%\vspace{0.1cm}
-
-\begin{ocamldoccode}
-exception Match_failure of (string * int * int)
-\end{ocamldoccode}
-\index{Matchfailure@\verb`Match_failure`}
-\begin{ocamldocdescription}
- Exception raised when none of the cases of a pattern-matching
- apply. The arguments are the location of the "match" keyword
- in the source code (file name, line number, column number).
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Assert_failure of (string * int * int)
-\end{ocamldoccode}
-\index{Assertfailure@\verb`Assert_failure`}
-\begin{ocamldocdescription}
- Exception raised when an assertion fails. The arguments are
- the location of the "assert" keyword in the source code
- (file name, line number, column number).
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Invalid_argument of string
-\end{ocamldoccode}
-\index{Invalidargument@\verb`Invalid_argument`}
-\begin{ocamldocdescription}
- Exception raised by library functions to signal that the given
- arguments do not make sense. The string gives some information
- to the programmer. As a general rule, this exception should not
- be caught, it denotes a programming error and the code should be
- modified not to trigger it.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Failure of string
-\end{ocamldoccode}
-\index{Failure@\verb`Failure`}
-\begin{ocamldocdescription}
- Exception raised by library functions to signal that they are
- undefined on the given arguments. The string is meant to give some
- information to the programmer; you must \emph{not} pattern match on
- the string literal because it may change in future versions (use
- \verb`Failure _` instead).
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Not_found
-\end{ocamldoccode}
-\index{Notfound@\verb`Not_found`}
-\begin{ocamldocdescription}
- Exception raised by search functions when the desired object
- could not be found.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Out_of_memory
-\end{ocamldoccode}
-\index{Outofmemory@\verb`Out_of_memory`}
-\begin{ocamldocdescription}
- Exception raised by the garbage collector when there is
- insufficient memory to complete the computation. (Not reliable for
- allocations on the minor heap.)
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Stack_overflow
-\end{ocamldoccode}
-\index{Stackoverflow@\verb`Stack_overflow`}
-\begin{ocamldocdescription}
- Exception raised by the bytecode interpreter when the evaluation
- stack reaches its maximal size. This often indicates infinite or
- excessively deep recursion in the user's program. Before 4.10, it
- was not fully implemented by the native-code compiler.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Sys_error of string
-\end{ocamldoccode}
-\index{Syserror@\verb`Sys_error`}
-\begin{ocamldocdescription}
- Exception raised by the input/output functions to report an
- operating system error. The string is meant to give some
- information to the programmer; you must \emph{not} pattern match on
- the string literal because it may change in future versions (use
- \verb`Sys_error _` instead).
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception End_of_file
-\end{ocamldoccode}
-\index{Endoffile@\verb`End_of_file`}
-\begin{ocamldocdescription}
- Exception raised by input functions to signal that the
- end of file has been reached.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Division_by_zero
-\end{ocamldoccode}
-\index{Divisionbyzero@\verb`Division_by_zero`}
-\begin{ocamldocdescription}
- Exception raised by integer division and remainder operations
- when their second argument is zero.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Sys_blocked_io
-\end{ocamldoccode}
-\index{Sysblockedio@\verb`Sys_blocked_io`}
-\begin{ocamldocdescription}
- A special case of "Sys_error" raised when no I/O is possible
- on a non-blocking I/O channel.
-\end{ocamldocdescription}
-
-\begin{ocamldoccode}
-exception Undefined_recursive_module of (string * int * int)
-\end{ocamldoccode}
-\index{Undefinedrecursivemodule@\verb`Undefined_recursive_module`}
-\begin{ocamldocdescription}
- Exception raised when an ill-founded recursive module definition
- is evaluated. (See section~\ref{s:recursive-modules}.)
- The arguments are the location of the definition in the source code
- (file name, line number, column number).
-\end{ocamldocdescription}
-
+++ /dev/null
-{!indexlist}
-
-{1 Warning}
- This library is part of the internal OCaml compiler API, and is
-not the language standard library.
- There are no compatibility guarantees between releases, so code written
-against these modules must be willing to depend on specific OCaml compiler
-versions.
-
+++ /dev/null
-\chapter{The compiler front-end} \label{c:parsinglib}\cutname{parsing.html}
-\label{Compiler-underscorelibs} % redirect references to compiler_libs.mld here
-
-This chapter describes the OCaml front-end, which declares the abstract
-syntax tree used by the compiler, provides a way to parse, print
-and pretty-print OCaml code, and ultimately allows one to write abstract
-syntax tree preprocessors invoked via the {\tt -ppx} flag (see chapters~\ref{c:camlc}
-and~\ref{c:nativecomp}).
-
-It is important to note that the exported front-end interface follows the evolution of the OCaml language and implementation, and thus does not provide {\bf any} backwards compatibility guarantees.
-
-The front-end is a part of "compiler-libs" library.
-Programs that use the "compiler-libs" library should be built as follows:
-\begin{alltt}
- ocamlfind ocamlc \var{other options} -package compiler-libs.common \var{other files}
- ocamlfind ocamlopt \var{other options} -package compiler-libs.common \var{other files}
-\end{alltt}
-Use of the {\tt ocamlfind} utility is recommended. However, if this is not possible, an alternative method may be used:
-\begin{alltt}
- ocamlc \var{other options} -I +compiler-libs ocamlcommon.cma \var{other files}
- ocamlopt \var{other options} -I +compiler-libs ocamlcommon.cmxa \var{other files}
-\end{alltt}
-For interactive use of the "compiler-libs" library, start "ocaml" and
-type\\*"#load \"compiler-libs/ocamlcommon.cma\";;".
-
-% Some of the files below are commented out as the documentation is too poor
-% or they are thought to be nonessential.
-
-\ifouthtml
-\begin{links}
-\item \ahref{compilerlibref/Ast\_helper.html}{Module \texttt{Ast_helper}: helper functions for AST construction}
-\item \ahref{compilerlibref/Ast\_mapper.html}{Module \texttt{Ast_mapper}: -ppx rewriter interface}
-\item \ahref{compilerlibref/Asttypes.html}{Module \texttt{Asttypes}: auxiliary types used by Parsetree}
-% \item \ahref{compilerlibref/Lexer.html}{Module \texttt{Lexer}: OCaml syntax lexing}
-\item \ahref{compilerlibref/Location.html}{Module \texttt{Location}: source code locations}
-\item \ahref{compilerlibref/Longident.html}{Module \texttt{Longident}: long identifiers}
-\item \ahref{compilerlibref/Parse.html}{Module \texttt{Parse}: OCaml syntax parsing}
-\item \ahref{compilerlibref/Parsetree.html}{Module \texttt{Parsetree}: OCaml syntax tree}
-\item \ahref{compilerlibref/Pprintast.html}{Module \texttt{Pprintast}: OCaml syntax printing}
-% \item \ahref{compilerlibref/Printast.html}{Module \texttt{Printast}: AST printing}
-\end{links}
-
-\else
-{\ocamldocinputstart
-% Ast_helper is excluded from the PDF and text manuals.
-% It is over 20 pages long and does not have doc-comments. It is expected
-% that Ast_helper will be only useful in the HTML manual (to look up signatures).
-% \input{Asthelper.tex}
-\input{Astmapper.tex}
-\input{Asttypes.tex}
-% \input{Lexer.tex}
-\input{Location.tex}
-\input{Longident.tex}
-\input{Parse.tex}
-\input{Parsetree.tex}
-\input{Pprintast.tex}
-}
-% \input{Printast.tex}
-\fi
+++ /dev/null
-\chapter{The core library} \label{c:corelib}\cutname{core.html}
-
-This chapter describes the OCaml core library, which is
- composed of declarations for built-in types and exceptions, plus
-the module "Stdlib" that provides basic operations on these
- built-in types. The "Stdlib" module is special in two
-ways:
-\begin{itemize}
-\item It is automatically linked with the user's object code files by
-the "ocamlc" command (chapter~\ref{c:camlc}).
-
-\item It is automatically ``opened'' when a compilation starts, or
-when the toplevel system is launched. Hence, it is possible to use
-unqualified identifiers to refer to the functions provided by the
-"Stdlib" module, without adding a "open Stdlib" directive.
-\end{itemize}
-
-\begin{latexonly}
-\section*{s:core-conventions}{Conventions}
-
-The declarations of the built-in types and the components of module
-"Stdlib" are printed one by one in typewriter font, followed by a
-short comment. All library modules and the components they provide are
-indexed at the end of this report.
-\end{latexonly}
-
-\input{builtin.tex}
-\ifouthtml
-\section{s:stdlib-module}{Module {\tt Stdlib}: the initially opened module}
-\begin{links}
-\item \ahref{libref/Stdlib.html}{Module \texttt{Stdlib}: the initially opened module}
-\item Module \texttt{Pervasives}: deprecated alias for Stdlib
-\end{links}
-\else
-{
-\ocamldocinputstart
-\input{Stdlib.tex}
-}
-\fi
-
+++ /dev/null
-\chapter{The dynlink library: dynamic loading and linking of object files}
-%HEVEA\cutname{libdynlink.html}
-
-The "dynlink" library supports type-safe dynamic loading and linking
-of bytecode object files (".cmo" and ".cma" files) in a running
-bytecode program, or of native plugins (usually ".cmxs" files) in a
-running native program. Type safety is ensured by limiting the set of
-modules from the running program that the loaded object file can
-access, and checking that the running program and the loaded object
-file have been compiled against the same interfaces for these modules.
-In native code, there are also some compatibility checks on the
-implementations (to avoid errors with cross-module optimizations); it
-might be useful to hide ".cmx" files when building native plugins so
-that they remain independent of the implementation of modules in the
-main program.
-
-Programs that use the "dynlink" library simply need to link
-"dynlink.cma" or "dynlink.cmxa" with their object files and other libraries.
-
-\textbf{Note:} in order to insure that the dynamically-loaded modules have
-access to all the libraries that are visible to the main program (and not just
-to the parts of those libraries that are actually used in the main program),
-programs using the "dynlink" library should be linked with "-linkall".
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/Dynlink.html}{Module \texttt{Dynlink}: dynamic loading of bytecode object files}
-\end{links}
-
-\else
-\input{Dynlink.tex}
-\fi
+++ /dev/null
-\chapter{The str library: regular expressions and string processing}
-%HEVEA\cutname{libstr.html}
-
-The "str" library provides high-level string processing functions,
-some based on regular expressions. It is intended to support the kind
-of file processing that is usually performed with scripting languages
-such as "awk", "perl" or "sed".
-
-Programs that use the "str" library must be linked as follows:
-\begin{alltt}
- ocamlc \var{other options} str.cma \var{other files}
- ocamlopt \var{other options} str.cmxa \var{other files}
-\end{alltt}
-For interactive use of the "str" library, do:
-\begin{alltt}
- ocamlmktop -o mytop str.cma
- ./mytop
-\end{alltt}
-or (if dynamic linking of C libraries is supported on your platform),
-start "ocaml" and type "#load \"str.cma\";;".
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/Str.html}{Module \texttt{Str}: regular expressions and string processing}
-\end{links}
-
-\else
-\ocamldocinputstart
-\input{Str.tex}
-\fi
-
-
+++ /dev/null
-\chapter{The threads library}
-\label{c:threads}\cutname{threads.html}
-%HEVEA\cutname{libthreads.html}
-
-The "threads" library allows concurrent programming in OCaml.
-It provides multiple threads of control (also called lightweight
-processes) that execute concurrently in the same memory space. Threads
-communicate by in-place modification of shared data structures, or by
-sending and receiving data on communication channels.
-
-The "threads" library is implemented on top of the threading
-facilities provided by the operating system: POSIX 1003.1c threads for
-Linux, MacOS, and other Unix-like systems; Win32 threads for Windows.
-Only one thread at a time is allowed to run OCaml code, hence
-opportunities for parallelism are limited to the parts of the program
-that run system or C library code. However, threads provide
-concurrency and can be used to structure programs as several
-communicating processes. Threads also efficiently support concurrent,
-overlapping I/O operations.
-
-Programs that use threads must be linked as follows:
-\begin{alltt}
- ocamlc -I +threads \var{other options} unix.cma threads.cma \var{other files}
- ocamlopt -I +threads \var{other options} unix.cmxa threads.cmxa \var{other files}
-\end{alltt}
-Compilation units that use the "threads" library must also be compiled with
-the "-I +threads" option (see chapter~\ref{c:camlc}).
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/Thread.html}{Module \texttt{Thread}: lightweight threads}
-\item \ahref{libref/Mutex.html}{Module \texttt{Mutex}: locks for mutual exclusion}
-\item \ahref{libref/Condition.html}{Module \texttt{Condition}: condition variables to synchronize between threads}
-\item \ahref{libref/Semaphore.html}{Module \texttt{Semaphore}: semaphores, another thread synchronization mechanism}
-\item \ahref{libref/Event.html}{Module \texttt{Event}: first-class synchronous communication}
-\end{links}
-\else
-\input{Thread.tex}
-\input{Mutex.tex}
-\input{Condition.tex}
-\input{Semaphore.tex}
-\input{Event.tex}
-\fi
+++ /dev/null
-\chapter{The unix library: Unix system calls}
-%HEVEA\cutname{libunix.html}
-\label{c:unix}
-
-The "unix" library makes many Unix
-system calls and system-related library functions available to
-OCaml programs. This chapter describes briefly the functions
-provided. Refer to sections 2~and~3 of the Unix manual for more
-details on the behavior of these functions.
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/Unix.html}{Module \texttt{Unix}: Unix system calls}
-\item \ahref{libref/UnixLabels.html}{Module \texttt{UnixLabels}: Labeled
- Unix system calls}
-\end{links}
-\fi
-
-Not all functions are provided by all Unix variants. If some functions
-are not available, they will raise "Invalid_arg" when called.
-
-Programs that use the "unix" library must be linked as follows:
-\begin{alltt}
- ocamlc \var{other options} unix.cma \var{other files}
- ocamlopt \var{other options} unix.cmxa \var{other files}
-\end{alltt}
-For interactive use of the "unix" library, do:
-\begin{alltt}
- ocamlmktop -o mytop unix.cma
- ./mytop
-\end{alltt}
-or (if dynamic linking of C libraries is supported on your platform),
-start "ocaml" and type "#load \"unix.cma\";;".
-
-\begin{latexonly}
-\begin{windows}
-A fairly complete emulation of the Unix system calls is provided in
-the Windows version of OCaml. The end of this chapter gives
-more information on the functions that are not supported under Windows.
-\end{windows}
-
-{
-\ocamldocinputstart
-\input{Unix.tex}
-
-\section{s:Module \texttt{UnixLabels}: labelized version of the interface}
-\label{UnixLabels}
-\index{UnixLabels (module)@\verb~UnixLabels~ (module)}%
-
-This module is identical to "Unix"~(\ref{Unix}), and only differs by
-the addition of labels. You may see these labels directly by looking
-at "unixLabels.mli", or by using the "ocamlbrowser" tool.
-
-\newpage
-}
-\end{latexonly}
-
-\begin{windows}
-The Cygwin port of OCaml fully implements all functions from
-the Unix module. The native Win32 ports implement a subset of them.
-Below is a list of the functions that are not implemented, or only
-partially implemented, by the Win32 ports. Functions not mentioned are
-fully implemented and behave as described previously in this chapter.
-\end{windows}
-
-\begin{tableau}{|l|p{8cm}|}{Functions}{Comment}
-\entree{"fork"}{not implemented, use "create_process" or threads}
-\entree{"wait"}{not implemented, use "waitpid"}
-\entree{"waitpid"}{can only wait for a given PID, not any child process}
-\entree{"getppid"}{not implemented (meaningless under Windows)}
-\entree{"nice"}{not implemented}
-\entree{"truncate", "ftruncate"}{implemented (since 4.10.0)}
-\entree{"link"}{implemented (since 3.02)}
-\entree{"fchmod"}{not implemented}
-\entree{"chown", "fchown"}{not implemented (make no sense on a DOS
-file system)}
-\entree{"umask"}{not implemented}
-\entree{"access"}{execute permission "X_OK" cannot be tested,
- it just tests for read permission instead}
-\entree{"chroot"}{not implemented}
-\entree{"mkfifo"}{not implemented}
-\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
-\entree{"kill"}{partially implemented (since 4.00.0): only the "sigkill" signal
-is implemented}
-\entree{"sigprocmask", "sigpending", "sigsuspend"}{not implemented (no inter-process signals on Windows}
-\entree{"pause"}{not implemented (no inter-process signals in Windows)}
-\entree{"alarm"}{not implemented}
-\entree{"times"}{partially implemented, will not report timings for child
-processes}
-\entree{"getitimer", "setitimer"}{not implemented}
-\entree{"getuid", "geteuid", "getgid", "getegid"}{always return 1}
-\entree{"setuid", "setgid", "setgroups", "initgroups"}{not implemented}
-\entree{"getgroups"}{always returns "[|1|]" (since 2.00)}
-\entree{"getpwnam", "getpwuid"}{always raise "Not_found"}
-\entree{"getgrnam", "getgrgid"}{always raise "Not_found"}
-\entree{type "socket_domain"}{"PF_INET" is fully supported;
-"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is not supported }
-\entree{"establish_server"}{not implemented; use threads}
-\entree{terminal functions ("tc*")}{not implemented}
-\entree{"setsid"}{not implemented}
-\end{tableau}
+++ /dev/null
-\chapter{Recently removed or moved libraries (Graphics, Bigarray, Num, LablTk)}
-%HEVEA\cutname{old.html}
-
-This chapter describes three libraries which were formerly part of the OCaml
-distribution (Graphics, Num, and LablTk), and a library which has now become
-part of OCaml's standard library, and is documented there (Bigarray).
-
-
-\section{s:graphics-removed}{The Graphics Library}
-
-Since OCaml 4.09, the "graphics" library is distributed as an external
-package. Its new home is:
-
-\url{https://github.com/ocaml/graphics}
-
-If you are using the opam package manager, you should install the
-corresponding "graphics" package:
-
-\begin{alltt}
- opam install graphics
-\end{alltt}
-
-Before OCaml 4.09, this package simply ensures that the "graphics"
-library was installed by the compiler, and starting from OCaml 4.09
-this package effectively provides the "graphics" library.
-
-\section{s:bigarray-moved}{The Bigarray Library}
-
-As of OCaml 4.07, the "bigarray" library has been integrated into OCaml's
-standard library.
-
-The "bigarray" functionality may now be found in the standard library
-\ifouthtml
- \ahref{libref/Bigarray.html}{\texttt{Bigarray} module},
-\else
- \texttt{Bigarray} module,
-\fi
-except for the "map_file" function which is now
-part of the \hyperref[c:unix]{Unix library}. The documentation has
-been integrated into the documentation for the standard library.
-
-The legacy "bigarray" library bundled with the compiler is a
-compatibility library with exactly the same interface as before,
-i.e. with "map_file" included.
-
-We strongly recommend that you port your code to use the standard
-library version instead, as the changes required are minimal.
-
-If you choose to use the compatibility library, you must link your
-programs as follows:
-\begin{alltt}
- ocamlc \var{other options} bigarray.cma \var{other files}
- ocamlopt \var{other options} bigarray.cmxa \var{other files}
-\end{alltt}
-For interactive use of the "bigarray" compatibility library, do:
-\begin{alltt}
- ocamlmktop -o mytop bigarray.cma
- ./mytop
-\end{alltt}
-or (if dynamic linking of C libraries is supported on your platform),
-start "ocaml" and type "#load \"bigarray.cma\";;".
-
-\section{s:graphics-removed}{The Num Library}
-
-The "num" library implements integer arithmetic and rational
-arithmetic in arbitrary precision. It was split off the core
-OCaml distribution starting with the 4.06.0 release, and can now be found
-at \url{https://github.com/ocaml/num}.
-
-New applications that need arbitrary-precision arithmetic should use the
-"Zarith" library (\url{https://github.com/ocaml/Zarith}) instead of the "Num"
-library, and older applications that already use "Num" are encouraged to
-switch to "Zarith". "Zarith" delivers much better performance than "Num"
-and has a nicer API.
-
-\section{s:labltk-removed}{The Labltk Library and OCamlBrowser}
-
-Since OCaml version 4.02, the OCamlBrowser tool and the Labltk library
-are distributed separately from the OCaml compiler. The project is now
-hosted at \url{https://github.com/garrigue/labltk}.
+++ /dev/null
-\chapter{The standard library} \label{c:stdlib}\cutname{stdlib.html}
-
-This chapter describes the functions provided by the OCaml
-standard library. The modules from the standard library are
-automatically linked with the user's object code files by the "ocamlc"
-command. Hence, these modules can be used in standalone programs without
-having to add any ".cmo" file on the command line for the linking
-phase. Similarly, in interactive use, these globals can be used in
-toplevel phrases without having to load any ".cmo" file in memory.
-
-Unlike the core "Stdlib" module, submodules are not automatically
-``opened'' when compilation starts, or when the toplevel system is launched.
-Hence it is necessary to use qualified identifiers to refer to the functions
-provided by these modules, or to add "open" directives.
-
-\label{stdlib:top}
-
-\begin{latexonly}
-
-\section*{s:stdlib-conv}{Conventions}
-
-For easy reference, the modules are listed below in alphabetical order
-of module names.
-For each module, the declarations from its signature are printed
-one by one in typewriter font, followed by a short comment.
-All modules and the identifiers they export are indexed at the end of
-this report.
-
-\section*{s:stdlib-overview}{Overview}
-
-Here is a short listing, by theme, of the standard library modules.
-
-\subsubsection*{sss:stdlib-data-structures}{Data structures:}
-\begin{tabular}{lll}
-% Beware: these entries must be written in a very rigidly-defined
-% format, or the check-stdlib-modules script will complain.
-"String" & p.~\pageref{String} & string operations \\
-"Bytes" & p.~\pageref{Bytes} & operations on byte sequences\\
-"Array" & p.~\pageref{Array} & array operations \\
-"List" & p.~\pageref{List} & list operations \\
-"StdLabels" & p.~\pageref{StdLabels} & labelized versions of
-the above 4 modules \\
-"Unit" & p.~\pageref{Unit} & unit values \\
-"Bool" & p.~\pageref{Bool} & boolean values \\
-"Char" & p.~\pageref{Char} & character operations \\
-"Uchar" & p.~\pageref{Uchar} & Unicode characters \\
-"Int" & p.~\pageref{Int} & integer values \\
-"Option" & p.~\pageref{Option} & option values \\
-"Result" & p.~\pageref{Result} & result values \\
-"Either" & p.~\pageref{Either} & either values \\
-"Hashtbl" & p.~\pageref{Hashtbl} & hash tables and hash functions \\
-"Random" & p.~\pageref{Random} & pseudo-random number generator \\
-"Set" & p.~\pageref{Set} & sets over ordered types \\
-"Map" & p.~\pageref{Map} & association tables over ordered types \\
-"MoreLabels" & p.~\pageref{MoreLabels} & labelized versions of
-"Hashtbl", "Set", and "Map" \\
-"Oo" & p.~\pageref{Oo} & useful functions on objects \\
-"Stack" & p.~\pageref{Stack} & last-in first-out stacks \\
-"Queue" & p.~\pageref{Queue} & first-in first-out queues \\
-"Buffer" & p.~\pageref{Buffer} & buffers that grow on demand \\
-"Seq" & p.~\pageref{Seq} & functional iterators \\
-"Lazy" & p.~\pageref{Lazy} & delayed evaluation \\
-"Weak" & p.~\pageref{Weak} & references that don't prevent objects
-from being garbage-collected \\
-"Atomic" & p.~\pageref{Atomic} & atomic references (for compatibility with concurrent runtimes) \\
-"Ephemeron" & p.~\pageref{Ephemeron} & ephemerons and weak hash tables \\
-"Bigarray" & p.~\pageref{Bigarray} & large, multi-dimensional, numerical arrays
-\end{tabular}
-\subsubsection*{sss:stdlib-arith}{Arithmetic:}
-\begin{tabular}{lll}
-"Complex" & p.~\pageref{Complex} & complex numbers \\
-"Float" & p.~\pageref{Float} & floating-point numbers \\
-"Int32" & p.~\pageref{Int32} & operations on 32-bit integers \\
-"Int64" & p.~\pageref{Int64} & operations on 64-bit integers \\
-"Nativeint" & p.~\pageref{Nativeint} & operations on platform-native
-integers
-\end{tabular}
-\subsubsection*{sss:stdlib-io}{input/output:}
-\begin{tabular}{lll}
-"Format" & p.~\pageref{Format} & pretty printing with automatic
-indentation and line breaking \\
-"Marshal" & p.~\pageref{Marshal} & marshaling of data structures \\
-"Printf" & p.~\pageref{Printf} & formatting printing functions \\
-"Scanf" & p.~\pageref{Scanf} & formatted input functions \\
-"Digest" & p.~\pageref{Digest} & MD5 message digest \\
-\end{tabular}
-\subsubsection*{sss:stdlib-parsing}{Parsing:}
-\begin{tabular}{lll}
-"Genlex" & p.~\pageref{Genlex} & a generic lexer over streams \\
-"Lexing" & p.~\pageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\
-"Parsing" & p.~\pageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\
-"Stream" & p.~\pageref{Stream} & basic functions over streams \\
-\end{tabular}
-\subsubsection*{sss:stdlib-system}{System interface:}
-\begin{tabular}{lll}
-"Arg" & p.~\pageref{Arg} & parsing of command line arguments \\
-"Callback" & p.~\pageref{Callback} & registering OCaml functions to
-be called from C \\
-"Filename" & p.~\pageref{Filename} & operations on file names \\
-"Gc" & p.~\pageref{Gc} & memory management control and statistics \\
-"Printexc" & p.~\pageref{Printexc} & a catch-all exception handler \\
-"Sys" & p.~\pageref{Sys} & system interface \\
-\end{tabular}
-\subsubsection*{sss:stdlib-misc}{Misc:}
-\begin{tabular}{lll}
-"Fun" & p.~\pageref{Fun} & function values \\
-\end{tabular}
-\end{latexonly}
-
-\ifouthtml
-\begin{links}
-\item \ahref{libref/Arg.html}{Module \texttt{Arg}: parsing of command line arguments}
-\item \ahref{libref/Array.html}{Module \texttt{Array}: array operations}
-\item \ahref{libref/ArrayLabels.html}{Module \texttt{ArrayLabels}: array operations (with labels)}
-\item \ahref{libref/Atomic.html}{Module \texttt{Atomic}: atomic references}
-\item \ahref{libref/Bigarray.html}{Module \texttt{Bigarray}: large, multi-dimensional, numerical arrays}
-\item \ahref{libref/Bool.html}{Module \texttt{Bool}: boolean values}
-\item \ahref{libref/Buffer.html}{Module \texttt{Buffer}: extensible buffers}
-\item \ahref{libref/Bytes.html}{Module \texttt{Bytes}: byte sequences}
-\item \ahref{libref/BytesLabels.html}{Module \texttt{BytesLabels}: byte sequences (with labels)}
-\item \ahref{libref/Callback.html}{Module \texttt{Callback}: registering OCaml values with the C runtime}
-\item \ahref{libref/Char.html}{Module \texttt{Char}: character operations}
-\item \ahref{libref/Complex.html}{Module \texttt{Complex}: complex numbers}
-\item \ahref{libref/Digest.html}{Module \texttt{Digest}: MD5 message digest}
-\item \ahref{libref/Either.html}{Module \texttt{Either}: either values}
-\item \ahref{libref/Ephemeron.html}{Module \texttt{Ephemeron}: Ephemerons and weak hash table}
-\item \ahref{libref/Filename.html}{Module \texttt{Filename}: operations on file names}
-\item \ahref{libref/Float.html}{Module \texttt{Float}: floating-point numbers}
-\item \ahref{libref/Format.html}{Module \texttt{Format}: pretty printing}
-\item \ahref{libref/Fun.html}{Module \texttt{Fun}: function values}
-\item \ahref{libref/Gc.html}{Module \texttt{Gc}: memory management control and statistics; finalized values}
-\item \ahref{libref/Genlex.html}{Module \texttt{Genlex}: a generic lexical analyzer}
-\item \ahref{libref/Hashtbl.html}{Module \texttt{Hashtbl}: hash tables and hash functions}
-\item \ahref{libref/Int.html}{Module \texttt{Int}: integers}
-\item \ahref{libref/Int32.html}{Module \texttt{Int32}: 32-bit integers}
-\item \ahref{libref/Int64.html}{Module \texttt{Int64}: 64-bit integers}
-\item \ahref{libref/Lazy.html}{Module \texttt{Lazy}: deferred computations}
-\item \ahref{libref/Lexing.html}{Module \texttt{Lexing}: the run-time library for lexers generated by \texttt{ocamllex}}
-\item \ahref{libref/List.html}{Module \texttt{List}: list operations}
-\item \ahref{libref/ListLabels.html}{Module \texttt{ListLabels}: list operations (with labels)}
-\item \ahref{libref/Map.html}{Module \texttt{Map}: association tables over ordered types}
-\item \ahref{libref/Marshal.html}{Module \texttt{Marshal}: marshaling of data structures}
-\item \ahref{libref/MoreLabels.html}{Module \texttt{MoreLabels}: include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
-\item \ahref{libref/Nativeint.html}{Module \texttt{Nativeint}: processor-native integers}
-\item \ahref{libref/Oo.html}{Module \texttt{Oo}: object-oriented extension}
-\item \ahref{libref/Option.html}{Module \texttt{Option}: option values}
-\item \ahref{libref/Parsing.html}{Module \texttt{Parsing}: the run-time library for parsers generated by \texttt{ocamlyacc}}
-\item \ahref{libref/Printexc.html}{Module \texttt{Printexc}: facilities for printing exceptions}
-\item \ahref{libref/Printf.html}{Module \texttt{Printf}: formatting printing functions}
-\item \ahref{libref/Queue.html}{Module \texttt{Queue}: first-in first-out queues}
-\item \ahref{libref/Random.html}{Module \texttt{Random}: pseudo-random number generator (PRNG)}
-\item \ahref{libref/Result.html}{Module \texttt{Result}: result values}
-\item \ahref{libref/Scanf.html}{Module \texttt{Scanf}: formatted input functions}
-\item \ahref{libref/Seq.html}{Module \texttt{Seq}: functional iterators}
-\item \ahref{libref/Set.html}{Module \texttt{Set}: sets over ordered types}
-\item \ahref{libref/Stack.html}{Module \texttt{Stack}: last-in first-out stacks}
-\item \ahref{libref/StdLabels.html}{Module \texttt{StdLabels}: include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels}
-\item \ahref{libref/Stream.html}{Module \texttt{Stream}: streams and parsers}
-\item \ahref{libref/String.html}{Module \texttt{String}: string operations}
-\item \ahref{libref/StringLabels.html}{Module \texttt{StringLabels}: string operations (with labels)}
-\item \ahref{libref/Sys.html}{Module \texttt{Sys}: system interface}
-\item \ahref{libref/Uchar.html}{Module \texttt{Uchar}: Unicode characters}
-\item \ahref{libref/Unit.html}{Module \texttt{Unit}: unit values}
-\item \ahref{libref/Weak.html}{Module \texttt{Weak}: arrays of weak pointers}
-\end{links}
-\else
-{\ocamldocinputstart
-\input{Arg.tex}
-\input{Array.tex}
-\input{ArrayLabels.tex}
-\input{Atomic.tex}
-\input{Bigarray.tex}
-\input{Bool.tex}
-\input{Buffer.tex}
-\input{Bytes.tex}
-\input{BytesLabels.tex}
-\input{Callback.tex}
-\input{Char.tex}
-\input{Complex.tex}
-\input{Digest.tex}
-\input{Either.tex}
-\input{Ephemeron.tex}
-\input{Filename.tex}
-\input{Float.tex}
-\input{Format.tex}
-\input{Fun.tex}
-\input{Gc.tex}
-\input{Genlex.tex}
-\input{Hashtbl.tex}
-\input{Int.tex}
-\input{Int32.tex}
-\input{Int64.tex}
-\input{Lazy.tex}
-\input{Lexing.tex}
-\input{List.tex}
-\input{ListLabels.tex}
-\input{Map.tex}
-\input{Marshal.tex}
-\input{MoreLabels.tex}
-\input{Nativeint.tex}
-\input{Oo.tex}
-\input{Option.tex}
-\input{Parsing.tex}
-\input{Printexc.tex}
-\input{Printf.tex}
-\input{Queue.tex}
-\input{Random.tex}
-\input{Result.tex}
-\input{Scanf.tex}
-\input{Seq.tex}
-\input{Set.tex}
-\input{Stack.tex}
-\input{StdLabels.tex}
-\input{Stream.tex}
-\input{String.tex}
-\input{StringLabels.tex}
-\input{Sys.tex}
-\input{Uchar.tex}
-\input{Unit.tex}
-\input{Weak.tex}
-\input{Ocamloperators.tex}
-}
-\fi
+++ /dev/null
-% Section macros with mandatory labels
-% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
-
-% First, we save the normal macros
-\let\@oldsection=\section
-\let\@oldsubsection=\subsection
-\let\@oldsubsubsection=\subsubsection
-% The *-version are distincts macros in hevea
-\let\@oldsection*=\section*
-\let\@oldsubsection*=\subsection*
-\let\@oldsubsubsection*=\subsubsection*
-
-%We go back to standard macros for ocamldoc generated files
-\newcommand{\ocamldocinputstart}{%
-\let\section=\@oldsection
-\let\subsection=\@oldsubsection
-\let\subsubsection=\@oldsubsubsection
-% The *-version are distincts macros in hevea
-\let\section*=\@oldsection*
-\let\subsection*=\@oldsubsection*
-\let\subsubsection*=\@oldsubsubsection*
-}
-
-\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
-\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
-\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
-\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
-\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
-\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
-
-% For paragraph, we do not make labels compulsory
-\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
-
-% Colors for links
-
-\newstyle{a.section-anchor::after}{
- content:"\@print@u{128279}";
- font-size:smaller;
- margin-left:-1.5em;
- padding-right:0.5em;
-}
-
-
-\newstyle{a.section-anchor}{
- visibility:hidden;
- color:grey !important;
- text-decoration:none !important;
-}
-
-\newstyle{*:hover>a.section-anchor}{
- visibility:visible;
-}
-
-\def\visited@color{\#0d46a3}
-\def\link@color{\#4286f4}
-\newstyle{a:link}{color:\link@color;text-decoration:underline;}
-\newstyle{a:visited}{color:\visited@color;text-decoration:underline;}
-\newstyle{a:hover}{color:black;text-decoration:underline;}
-
-
-\newstyle{@media all}{@font-face \{
-/* fira-sans-regular - latin */
- font-family: 'Fira Sans';
- font-style: normal;
- font-weight: 400;
- src: url('fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
- src: local('Fira Sans Regular'), local('FiraSans-Regular'),
- url('fonts/fira-sans-v8-latin-regular.eot?\#iefix') format('embedded-opentype'), /* IE6-IE8 */
- url('fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
- url('fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
- url('fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
- url('fonts/fira-sans-v8-latin-regular.svg\#FiraSans') format('svg'); /* Legacy iOS */
-\}}
-
-% Compact layout
-\newstyle{body}{
- max-width:750px;
- width: 85\%;
- margin: auto;
- background: \#f7f7f7;
- margin-top: 80px;
- font-size: 1rem;
-}
-
-% selects the index's title
-\newstyle{.maintitle}{
- font-family: "Fira Sans", sans-serif;
- text-align: center;
-}
-
-\newstyle{h1, h2, h3}{
- font-family: "Fira Sans", sans-serif;
- font-weight: normal;
- border-bottom: 1px solid black;
-}
-
-
-\newstyle{div.ocaml}{
- margin:2ex 0px;
- font-size: 1rem;
- background: beige;
- border: 1px solid grey;
- padding: 10px;
- overflow-y:auto;
- display:flex;
- flex-direction: column;
- flex-wrap: nowrap;
-}
-
-\newstyle{div.ocaml .pre}{
- white-space: pre;
- font-family: monospace;
-}
-
-
-
-\newstyle{.ocamlkeyword}{
- font-weight:bold;
-}
-
-
-\newstyle{.ocamlhighlight}{
- font-weight:bold;
- text-decoration:underline;
-}
-
-\newstyle{.ocamlerror}{
- font-weight:bold;
- color:red;
-}
-
-\newstyle{.ocamlwarning}{
- font-weight:bold;
- color:purple;
-}
-
-\newstyle{.ocamlcomment}{
- color:grey;
-}
-
-\newstyle{.ocamlstring}{
- opacity:0.75;
-}
-
-% Creative commons license logo
-\newstyle{\#cc_license_logo}{
- float:left;
- margin-right: 1em;
-}
-
-% More spacing between lines and inside tables
-\newstyle{p,ul}{line-height:1.3em}
-\newstyle{.cellpadding1 tr td}{padding:1px 4px}
-
-%Styles for caml-example and friends
-\newstyle{div.caml-output}{color:maroon;}
-% Styles for toplevel mode only
-\newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;}
-
-%%% Code examples
-\newcommand{\input@color}{\htmlcolor{006000}}
-\newcommand{\output@color}{\maroon}
-\newcommand{\machine}{\tt}
-\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
-\newcommand{\var}[1]{\textit{#1}}
-
-%% Caml-example environment
-\newcommand{\camlexample}[1]{
- \@open{div}{class="caml-example #1"}
-}
-\newcommand{\endcamlexample}{
- \@close{div}
-}
-
-\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}}
-\newcommand{\ocamlkeyword}{\@span{class="ocamlkeyword"}}
-\newcommand{\ocamlhighlight}{\@span{class="ocamlhighlight"}}
-\newcommand{\ocamlerror}{\@span{class="ocamlerror"}}
-\newcommand{\ocamlwarning}{\@span{class="ocamlwarning"}}
-\newcommand{\ocamlcomment}{\@span{class="ocamlcomment"}}
-\newcommand{\ocamlstring}{\@span{class="ocamlstring"}}
-
-
-%%% End of code example
-
-\newenvironment{library}{}{}
-\newcounter{page}
-\newenvironment{comment}{\begin{quote}}{\end{quote}}
-\newcommand{\nth}[2]{\({#1}_{#2}\)}
-\newenvironment{options}{\begin{description}}{\end{description}}
-
-
-%%venant de macros.tex
-
-\def\versionspecific#1{\begin{quote}\textsf{#1:}\quad}
-\def\unix{\versionspecific{Unix}}
-\def\endunix{\end{quote}}
-\def\windows{\versionspecific{Windows}}
-\def\endwindows{\end{quote}}
-
-\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
-\def\endrequirements{\endtrivlist}
-\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
-\def\endinstallation{\endtrivlist}
-\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
-\def\endtroubleshooting{\endtrivlist}
-
-\newtheorem{gcrule}{Rule}
-
-% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
-
-\def\entree#1#2{#1 & #2 \\}
-\def\tableau#1#2#3{%
-\par
-\@open{div}{class="tableau"}
-\begin{center}%
-\begin{tabular*}{.8\linewidth}{#1}%
-\multicolumn{1}{c}{\textbf{#2}} &
-\multicolumn{1}{c}{\textbf{#3}} \\
-%%#2 & #3 \\%
-}%
-\def\endtableau{\end{tabular*}\end{center}\@close{div}\par}
-
-\newstyle{.tableau, .syntax, .syntaxleft}{
- /* same width as body */
- max-width: 750px;
- overflow-y: auto;
-}
-
-% L'environnement library (pour composer les descriptions des modules
-% de bibliotheque).
-
-
-\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
-\def\endrestoreindent{\endgroup}
-
-
-% PDF stuff
-
-\def\pdfchapterfold#1#2{}
-\def\pdfsection#1{}
-\def\pdfchapter{\pdfchapterfold{0}}
-
-%%% Pour camlidl
-
-\def\transl#1{$[\![\mbox{#1}]\!]$}
-
-% Pour l'index
-\usepackage{multind}
-\let\indexentry=\index
-\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
-\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
-% nth
-
-\def\th{^{\mbox{\scriptsize th}}}
-\renewcommand{\hbox}[1]{\mbox{#1}}
-
-% Notations pour les metavariables
-\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
-\def\optvar#1{[\var{#1}\/]}
-\def\event{$\bowtie$}
-\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
-
-\newcommand{\vfill}{}
-\def\number{}
-\def\year{\arabic{year}}
-
-% Pour alltt
-\def\rminalltt#1{{\rm #1}}
-\def\goodbreak{\ \\}
-\def\@savedlistI{}
-
-%List of links with no space around items
-\newstyle{.li-links}{margin:0ex 0ex;}
-\newenvironment{links}
-{\setenvclass{itemize}{ftoc2}\setenvclass{li-itemize}{li-links}\itemize}
-{\enditemize}
-
-\newenvironment{maintitle}{\@open{div}{class="maintitle"}}{\@close{div}}
-
-%%% References to modules in the standard library
-\newcommand{\stdmoduleref}[1]{\ahref{libref/#1.html}{\texttt{#1}}}
-
-%%% Missing macro
-\newcommand{\DeclareUnicodeCharacter}[2]{}
+++ /dev/null
-\makeatletter
-
-% Pour hevea
-\newif\ifouthtml\outhtmlfalse
-\newcommand{\cutname}[1]{}
-% Notations pour les metavariables
-\def\var#1{{\it#1}}
-\def\nth#1#2{${\it#1}_{#2}$}
-\def\nmth#1#2#3{${\it#1}_{#2}^{#3}$}
-\def\optvar#1{\textrm{[}\var{#1}\/\textrm{]}}
-\def\event{$\bowtie$}
-\def\fromoneto#1#2{$#1 = 1, \ldots, #2$}
-
-
-% Redefining sections macros to make label mandatory
-\let\@oldsection=\section
-\let\@oldsubsection=\subsection
-\let\@oldsubsubsection=\subsection
-
-\newcommand{\ocamldocinputstart}{
-\let\section=\@oldsection
-\let\subsection=\@oldsubsection
-\let\subsubsection=\@oldsubsubsection
-}
-
-\renewcommand{\section}{\@ifstar{\@lsectionstar}{\@lsection}}
-\renewcommand{\subsection}{\@ifstar{\@lsubsectionstar}{\@lsubsection}}
-\renewcommand{\subsubsection}{\@ifstar{\@lsubsubsectionstar}{\@lsubsubsection}}
-
-\newcommand{\@lsection}[2]{\@oldsection{\label{#1}#2}}
-\newcommand{\@lsectionstar}[2]{\@oldsection*{\label{#1}#2}}
-\newcommand{\@lsubsection}[2]{\@oldsubsection{\label{#1}#2}}
-\newcommand{\@lsubsectionstar}[2]{\@oldsubsection*{\label{#1}#2}}
-\newcommand{\@lsubsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
-\newcommand{\@lsubsubsectionstar}[2]{\@oldsubsubsection*{\label{#1}#2}}
-
-\newcommand{\lparagraph}[1]{\paragraph{\label{#1}#1}}
-
-% Numerotation
-\setcounter{secnumdepth}{2} % Pour numeroter les \subsection
-\setcounter{tocdepth}{1} % Pour ne pas mettre les \subsection
- % dans la table des matieres
-
-% Pour avoir "_" qui marche en mode math et en mode normal
-\catcode`\_=13
-\catcode`\\ 2=8
-\def\_{\hbox{\tt\char95}}
-\def_{\ifmmode\ 2\else\_\fi}
-
-\def\ttstretch{\tt\spaceskip=5.77pt plus 1.83pt minus 1.22pt}
-% La fonte cmr10 a normalement des espaces de 5.25pt non extensibles.
-% En 11 pt ca fait 5.77 pt. On lui ajoute la meme flexibilite que
-% cmr10 agrandie a 11 pt.
-
-% Pour la traduction "xxxx" -> {\machine{xxxx}} faite par texquote2
-\def\machine#1{\mbox{\ttstretch{#1}}}
-
-% Pour la traduction "\begin{verbatim}...\end{verbatim}"
-% -> "\begin{machineenv}...\end{machineenv}"
-% faite aussi par texquote2.
-\newenvironment{machineenv}{\alltt}{\endalltt}
-
-% Environnements
-
-\newlength{\versionwidth}
-\setbox0=\hbox{\bf Windows:} \setlength{\versionwidth}{\wd0}
-
-\def\versionspecific#1{
- \begin{description}\item[#1:]~\\}
-
-\def\unix{\versionspecific{Unix}}
-\def\endunix{\end{description}}
-\def\windows{\versionspecific{Windows}}
-\def\endwindows{\end{description}}
-
-\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
-\def\endrequirements{\endtrivlist}
-\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
-\def\endinstallation{\endtrivlist}
-\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
-\def\endtroubleshooting{\endtrivlist}
-
-\newtheorem{gcrule}{Rule}
-
-% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
-
-\def\tableau#1#2#3{%
-\begin{center}
-\begin{tabular}{#1}
-\hline
-#2 & #3 \\
-\hline
-}
-\def\endtableau{\hline\end{tabular}\end{center}}
-\def\entree#1#2{#1 & #2 \\}
-
-% L'environnement option
-
-\def\optionitem[#1]{\if@noparitem \@donoparitem
- \else \if@inlabel \indent \par \fi
- \ifhmode \unskip\unskip \par \fi
- \if@newlist \if@nobreak \@nbitem \else
- \addpenalty\@beginparpenalty
- \addvspace\@topsep \addvspace{-\parskip}\fi
- \else \addpenalty\@itempenalty \addvspace\itemsep
- \fi
- \global\@inlabeltrue
-\fi
-\everypar{\global\@minipagefalse\global\@newlistfalse
- \if@inlabel\global\@inlabelfalse \hskip -\parindent \box\@labels
- \penalty\z@ \fi
- \everypar{}}\global\@nobreakfalse
-\if@noitemarg \@noitemargfalse \if@nmbrlist \refstepcounter{\@listctr}\fi \fi
-\setbox\@tempboxa\hbox{\makelabel{#1}}%
-\global\setbox\@labels
-\ifdim \wd\@tempboxa >\labelwidth
- \hbox{\unhbox\@labels
- \hskip -\leftmargin
- \box\@tempboxa}\hfil\break
- \else
- \hbox{\unhbox\@labels
- \hskip -\leftmargin
- \hbox to\leftmargin {\makelabel{#1}\hfil}}
- \fi
- \ignorespaces}
-
-\def\optionlabel#1{\bf #1}
-\def\options{\list{}{\let\makelabel\optionlabel\let\@item\optionitem}}
-\def\endoptions{\endlist}
-
-% L'environnement library (pour composer les descriptions des modules
-% de bibliotheque).
-
-\def\comment{\penalty200\list{}{}\item[]}
-\def\endcomment{\endlist\penalty-100}
-
-\def\library{
-\begingroup
-\raggedright
-\let\@savedlistI=\@listI%
-\def\@listI{\leftmargin\leftmargini\parsep 0pt plus 1pt\topsep 0pt plus 2pt}%
-\itemsep 0pt
-\topsep 0pt plus 2pt
-\partopsep 0pt
-}
-
-\def\endlibrary{
-\endgroup
-}
-
-\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
-\def\endrestoreindent{\endgroup}
-
-% ^^A...^^A: compose l'interieur en \tt, comme \verb
-
-\catcode`\^^A=\active
-\def\ 1{%
-\begingroup\catcode``=13\@noligs\ttstretch\let\do\@makeother\dospecials%
-\def\@xobeysp{\leavevmode\penalty100\ }%
-\@vobeyspaces\frenchspacing\catcode`\^^A=\active\def\ 1{\endgroup}}
-
-% Pour l'index
-
-\let\indexentry=\index
-\def\index{\indexentry{\jobname}}
-\def\ikwd{\indexentry{\jobname.kwd}}
-
-% Les en-tetes personnalises
-
-\pagestyle{myheadings}
-\def\partmark#1{\markboth{Part \thepart. \ #1}{}}
-\def\chaptermark#1{\markright{Chapter \thechapter. \ #1}}
-
-% nth
-
-\def\th{^{\hbox{\scriptsize th}}}
-
-% Pour annuler l'espacement vertical qui suit un "verbatim"
-\def\cancelverbatim{\vspace{-\topsep}\vspace{-\parskip}}% exact.
-
-% Pour annuler l'espacement vertical entre deux \item consecutifs dans \options
-\def\cancelitemspace{\vspace{-8mm}}% determine empiriquement
-
-% Pour faire la cesure apres _ dans les identificateurs
-\def\={\discretionary{}{}{}}
-\def\cuthere{\discretionary{}{}{}}
-
-% Pour la coupure en petits documents
-
-\let\mysection=\section
-
-%%% Augmenter l'espace entre numero de section
-% et nom de section dans la table des matieres.
-
-\def\l@section{\@dottedtocline{1}{1.5em}{2.8em}} % D'origine: 2.3
-
-% Pour alltt
-
-\def\rminalltt#1{{\rm #1}}
-
-% redefinition de l'environnement alltt pour que les {} \ et % soient
-% dans la bonne fonte
-
-\let\@oldalltt=\alltt
-\let\@oldendalltt=\endalltt
-\renewenvironment{alltt}{%
-\begingroup%
-\renewcommand{\{}{\char`\{}%
-\renewcommand{\}}{\char`\}}%
-\renewcommand{\\}{\char`\\}%
-\renewcommand{\%}{\char`\%}%
-\@oldalltt%
-}{%
-\@oldendalltt%
-\endgroup%
-}
-
-% Index stuff -- cf multind.sty
-
-\def\printindex#1#2{\@restonecoltrue\if@twocolumn\@restonecolfalse\fi
- \columnseprule \z@ \columnsep 35pt
- \newpage \phantomsection \twocolumn[{\Large\bf #2 \vskip4ex}]
- \markright{\uppercase{#2}}
- \addcontentsline{toc}{chapter}{#2}
- \@input{#1.ind}}
-
-%%% References to modules in the standard library
-\newcommand{\stdmoduleref}[1]{\hyperref[#1]{\texttt{#1}}[\ref{#1}]}
-
-\newenvironment{maintitle}{\begin{center}}{\end{center}}
-
-
-
-% Caml-example related command
-\newenvironment{camlexample}[1]{}{}
-\newenvironment{caml}{}{}
-\newcommand{\ocamlkeyword}{\bfseries}
-\newcommand{\ocamlhighlight}{\bfseries\uline}
-\newcommand{\ocamlerror}{\bfseries}
-\newcommand{\ocamlwarning}{\bfseries}
-
-\definecolor{gray}{gray}{0.5}
-\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
-\newcommand{\ocamlstring}{\color{gray}\bfseries}
-
-\makeatother
+++ /dev/null
-\input{anchored_book.hva}
-\input{macros.hva}
-\newif\ifouthtml\outhtmltrue
+++ /dev/null
-\input{book.hva}
-\renewcommand{\@indexsection}[1]{\chapter{#1}}
-\newcommand{\black}{\htmlcolor{#000000}}
-\newcommand{\machine}{\tt}
-\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
-\newenvironment{camlunder}{\@style{U}}{}
-\newcommand{\?}{\black\#\blue }
-
-\newcommand{\ocamlkeyword}{\bfseries}
-\newcommand{\ocamlhighlight}{\bfseries\underline}
-\newcommand{\ocamlerror}{\bfseries}
-\newcommand{\ocamlwarning}{\bfseries}
-\newcommand{\ocamlcomment}{\normalfont\small}
-\newcommand{\ocamlstring}{\bfseries}
-
-\newenvironment{caml}{\begin{alltt}}{\\\end{alltt}}
-\newenvironment{camlexample}[1]{}{}
-
-\newcommand{\var}[1]{\textit{#1}}
-
-\newenvironment{library}{}{}
-\newcounter{page}
-\newenvironment{comment}{\begin{quote}}{\end{quote}}
-\newcommand{\nth}[2]{\({#1}_{#2}\)}
-\newenvironment{options}{\begin{description}}{\end{description}}
-
-% Section macros with mandatory labels
-% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
-
-% First, we save the normal macros
-\let\@oldsection=\section
-\let\@oldsubsection=\subsection
-\let\@oldsubsubsection=\subsubsection
-% The *-version are distincts macros in hevea
-\let\@oldsection*=\section*
-\let\@oldsubsection*=\subsection*
-\let\@oldsubsubsection*=\subsubsection*
-
-%We go back to standard macros for ocamldoc generated files
-\newcommand{\ocamldocinputstart}{%
-\let\section=\@oldsection
-\let\subsection=\@oldsubsection
-\let\subsubsection=\@oldsubsubsection
-% The *-version are distincts macros in hevea
-\let\section*=\@oldsection*
-\let\subsection*=\@oldsubsection*
-\let\subsubsection*=\@oldsubsubsection*
-}
-
-\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
-\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
-\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
-\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
-\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
-\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
-
-% For paragraph, we do not make labels compulsory
-\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
-
-%%venant de macros.tex
-\newif\ifouthtml\outhtmlfalse
-\def\versionspecific#1{
-\quad\textsf{#1:}
-\begin{quote}}
-
-\def\unix{\versionspecific{Unix}}
-\def\endunix{\end{quote}}
-\def\windows{\versionspecific{Windows}}
-\def\endwindows{\end{quote}}
-
-\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
-\def\endrequirements{\endtrivlist}
-\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
-\def\endinstallation{\endtrivlist}
-\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
-\def\endtroubleshooting{\endtrivlist}
-
-\newtheorem{gcrule}{Rule}
-
-% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
-
-%\def\entree#1#2{#1 & #2 \\}
-%\def\tableau#1#2#3{%
-%\par\begin{center}%
-%\begin{tabular}{#1}%
-%\multicolumn{1}{c}{\textbf{#2}} &
-%\multicolumn{1}{c}{\textbf{#3}} \\
-%%#2 & #3 \\%
-%}%
-%\def\endtableau{\end{tabular}\end{center}\par}
-
-% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
-
-\def\tableau#1#2#3{%
-\begin{center}
-\begin{tabular}{#1}
-\hline
-\multicolumn{1}{|c|}{\textbf{#2}} & \multicolumn{1}{c|}{\textbf{#3}} \\
-\hline
-}
-\def\endtableau{\hline\end{tabular}\end{center}}
-\def\entree#1#2{#1 & #2 \\}
-
-
-
-% L'environnement library (pour composer les descriptions des modules
-% de bibliotheque).
-
-
-\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
-\def\endrestoreindent{\endgroup}
-
-
-% PDF stuff
-
-\def\pdfchapterfold#1#2{}
-\def\pdfsection#1{}
-\def\pdfchapter{\pdfchapterfold{0}}
-
-%%% Pour camlidl
-
-\def\transl#1{$[\![\mbox{#1}]\!]$}
-
-% Pour l'index
-\usepackage{multind}
-\let\indexentry=\index
-\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
-\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
-
-
-% nth
-\def\th{^{\mbox{\scriptsize th}}}
-\renewcommand{\hbox}[1]{\mbox{#1}}
-
-% Notations pour les metavariables
-\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
-\def\optvar#1{[\var{#1}\/]}
-\def\event{§§}
-\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
-
-\newcommand{\vfill}{}
-\def\number{}
-\def\year{2013}
-
-% Pour alltt
-
-\def\rminalltt#1{{\rm #1}}
-
-\def\goodbreak{\ \\}
-
-\def\@savedlistI{}
+++ /dev/null
-INFO-DIR-SECTION OCaml Programming Language
-START-INFO-DIR-ENTRY
-* ocaml: (ocaml). OCaml Reference Manual
-END-INFO-DIR-ENTRY
+++ /dev/null
-\documentclass[11pt]{book}
-\usepackage{ae}
-\usepackage[utf8]{inputenc}
-\usepackage[T1]{fontenc}
-% HEVEA\@def@charset{UTF-8}%
-\usepackage{fullpage}
-\usepackage{syntaxdef}
-\usepackage{multind}
-\usepackage{html}
-\usepackage{textcomp}
-\usepackage{ocamldoc}
-\usepackage{xspace}
-\usepackage{color}
-
-% Package for code examples:
-\usepackage{listings}
-\usepackage{alltt}
-\usepackage{lmodern}% for supporting bold ttfamily in code examples
-\usepackage[normalem]{ulem}% for underlining errors in code examples
-
-\input{macros.tex}
-\lstnewenvironment{camloutput}{
- \lstset{
- basicstyle=\small\ttfamily\slshape,
- showstringspaces=false,
- language=caml,
- escapeinside={$}{$},
- columns=fullflexible,
- stringstyle=\ocamlstring,
- keepspaces=true,
- keywordstyle=\ocamlkeyword,
- keywords={[2]{val}}, keywordstyle={[2]\ocamlkeyword},
- aboveskip=0\baselineskip,
- }
-\ifouthtml
- \setenvclass{lstlisting}{pre caml-output ok}
- \lstset {basicstyle=\ttfamily}
-\else
- \lstset{
- upquote=true,
- literate={'"'}{\textquotesingle "\textquotesingle}3
- {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
-}
-\fi
-}{}
-
-\lstnewenvironment{camlinput}{
- \lstset{
- basicstyle=\ttfamily,
- showstringspaces=false,
- language=caml,
- escapeinside={$}{$},
- columns=fullflexible,
- stringstyle=\ocamlstring,
- commentstyle=\ocamlcomment,
- keepspaces=true,
- keywordstyle=\ocamlkeyword,
- moredelim=[is][\ocamlhighlight]{<<}{>>},
- moredelim=[s][\ocamlstring]{\{|}{|\}},
- moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
- keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
- belowskip=0\baselineskip
- }
-\ifouthtml
- \setenvclass{lstlisting}{pre caml-input}
-\else
-%not implemented in hevea: upquote and literate
- \lstset{
- upquote=true,
- literate={'"'}{\textquotesingle "\textquotesingle}3
- {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
-}
-\fi
-}{}
-
-\lstnewenvironment{camlerror}{
- \lstset{
- escapeinside={$}{$},
- showstringspaces=false,
- basicstyle=\small\ttfamily\slshape,
- emph={Error}, emphstyle={\ocamlerror},
- }
-\ifouthtml
- \setenvclass{lstlisting}{pre caml-output error}
- \lstset { basicstyle=\ttfamily }
-\else
-\lstset{upquote=true}
-\fi
-}
-{}
-
-\lstnewenvironment{camlwarn}{
- \lstset{
- escapeinside={$}{$},
- showstringspaces=false,
- basicstyle=\small\ttfamily\slshape,
- emph={Warning}, emphstyle={\ocamlwarning},
- }
-\ifouthtml
-\setenvclass{lstlisting}{pre caml-output warn}
-\lstset { basicstyle=\ttfamily }
-\else
-\lstset{upquote=true}
-\fi
-}{}
-
-\newcommand{\?}{\color{black}\normalsize\tt\#{}}
-
-% Add meta tag to the generated head tag
-\ifouthtml
-\let\oldmeta=\@meta
-\renewcommand{\@meta}{
-\oldmeta
-\begin{rawhtml}
- <meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1">
-\end{rawhtml}
-}
-\fi
-
-\usepackage[colorlinks,linkcolor=blue]{hyperref}
-%\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother
-\def\th{^{\hbox{\scriptsize th}}}
-
-
-\raggedbottom
-\input{version.tex}
-%HEVEA\tocnumber
-%HEVEA\setcounter{cuttingdepth}{1}
-%HEVEA\title{The OCaml system, release \ocamlversion}
-\input{allfiles.tex}
+++ /dev/null
-*.tex
-*.htex
+++ /dev/null
-TOPDIR = ../../..
-include $(TOPDIR)/Makefile.tools
-
-LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
-
-TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
- -repo-root $(TOPDIR) -n 80 -v false
-TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
-
-
-FILES = refman.tex lex.tex names.tex values.tex const.tex types.tex \
- patterns.tex expr.tex typedecl.tex modtypes.tex modules.tex compunit.tex \
- exten.tex classes.tex
-
-
-etex-files: $(FILES)
-all: $(FILES)
-
-
-%.gen.tex: %.etex
- $(CAMLLATEX) $< -o $*_camltex.tex
- $(TRANSF) < $*_camltex.tex > $*.transf_error.tex
- mv $*.transf_error.tex $@
-
-%.tex: %.gen.tex
- $(TEXQUOTE) < $< > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-
-.PHONY: clean
-clean:
- rm -f *.tex
+++ /dev/null
-\section{s:classes}{Classes}
-%HEVEA\cutname{classes.html}
-Classes are defined using a small language, similar to the module
-language.
-
-\subsection{ss:classes:class-types}{Class types}
-
-Class types are the class-level equivalent of type expressions: they
-specify the general shape and type properties of classes.
-
-\ikwd{object\@\texttt{object}}
-\ikwd{end\@\texttt{end}}
-\ikwd{inherit\@\texttt{inherit}}
-\ikwd{val\@\texttt{val}}
-\ikwd{mutable\@\texttt{mutable}}
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-\ikwd{virtual\@\texttt{virtual}|see{\texttt{val}, \texttt{method}, \texttt{class}}}
-\ikwd{constraint\@\texttt{constraint}}
-
-\begin{syntax}
-class-type:
- [['?']label-name':'] typexpr '->' class-type
- | class-body-type
-;
-class-body-type:
- 'object' ['(' typexpr ')'] {class-field-spec} 'end'
- | ['[' typexpr {',' typexpr} ']'] classtype-path
- | 'let' 'open' module-path 'in' class-body-type
-;
-%\end{syntax} \begin{syntax}
-class-field-spec:
- 'inherit' class-body-type
- | 'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr
- | 'val' 'virtual' 'mutable' inst-var-name ':' typexpr
- | 'method' ['private'] ['virtual'] method-name ':' poly-typexpr
- | 'method' 'virtual' 'private' method-name ':' poly-typexpr
- | 'constraint' typexpr '=' typexpr
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:attributes]{attributes} and
-\hyperref[s:extension-nodes]{extension nodes}.
-
-\subsubsection*{sss:clty:simple}{Simple class expressions}
-
-The expression @classtype-path@ is equivalent to the class type bound to
-the name @classtype-path@. Similarly, the expression
-@'[' typexpr_1 ',' \ldots typexpr_n ']' classtype-path@ is equivalent to
-the parametric class type bound to the name @classtype-path@, in which
-type parameters have been instantiated to respectively @typexpr_1@,
-\ldots @typexpr_n@.
-
-\subsubsection*{sss:clty-fun}{Class function type}
-
-The class type expression @typexpr '->' class-type@ is the type of
-class functions (functions from values to classes) that take as
-argument a value of type @typexpr@ and return as result a class of
-type @class-type@.
-
-\subsubsection*{sss:clty:body}{Class body type}
-
-The class type expression
-@'object' ['(' typexpr ')'] {class-field-spec} 'end'@
-is the type of a class body. It specifies its instance variables and
-methods. In this type, @typexpr@ is matched against the self type, therefore
-providing a name for the self type.
-
-A class body will match a class body type if it provides definitions
-for all the components specified in the class body type, and these
-definitions meet the type requirements given in the class body type.
-Furthermore, all methods either virtual or public present in the class
-body must also be present in the class body type (on the other hand, some
-instance variables and concrete private methods may be omitted). A
-virtual method will match a concrete method, which makes it possible
-to forget its implementation. An immutable instance variable will match a
-mutable instance variable.
-
-\subsubsection*{sss:clty-open}{Local opens}
-
-Local opens are supported in class types since OCaml 4.06.
-
-\subsubsection*{sss:clty-inheritance}{Inheritance}
-
-\ikwd{inherit\@\texttt{inherit}}
-
-The inheritance construct @'inherit' class-body-type@ provides for inclusion of
-methods and instance variables from other class types.
-The instance variable and method types from @class-body-type@ are added
-into the current class type.
-
-\subsubsection*{sss:clty-variable}{Instance variable specification}
-
-\ikwd{val\@\texttt{val}}
-\ikwd{mutable\@\texttt{mutable}}
-
-A specification of an instance variable is written
-@'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr@, where
-@inst-var-name@
-is the name of the instance variable and @typexpr@ its expected type.
-%
-The flag @'mutable'@ indicates whether this instance variable can be
-physically modified.
-%
-The flag @'virtual'@ indicates that this instance variable is not
-initialized. It can be initialized later through inheritance.
-
-An instance variable specification will hide any previous
-specification of an instance variable of the same name.
-
-\subsubsection*{sss:clty-meth}{Method specification}
-
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-
-The specification of a method is written
-@'method' ['private'] method-name ':' poly-typexpr@, where
-@method-name@ is the name of the method and @poly-typexpr@ its
-expected type, possibly polymorphic. The flag @'private'@ indicates
-that the method cannot be accessed from outside the object.
-
-The polymorphism may be left implicit in public method specifications:
-any type variable which is not bound to a class parameter and does not
-appear elsewhere inside the class specification will be assumed to be
-universal, and made polymorphic in the resulting method type.
-Writing an explicit polymorphic type will disable this behaviour.
-
-If several specifications are present for the same method, they
-must have compatible types.
-Any non-private specification of a method forces it to be public.
-
-\subsubsection*{sss:class-virtual-meth-spec}{Virtual method specification}
-
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-
-A virtual method specification is written @'method' ['private']
-'virtual' method-name ':' poly-typexpr@, where @method-name@ is the
-name of the method and @poly-typexpr@ its expected type.
-
-\subsubsection*{sss:class-constraints}{Constraints on type parameters}
-
-\ikwd{constraint\@\texttt{constraint}}
-
-The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
-type expressions to be equal. This is typically used to specify type
-parameters: in this way, they can be bound to specific type
-expressions.
-
-\subsection{ss:class-expr}{Class expressions}
-
-Class expressions are the class-level equivalent of value expressions:
-they evaluate to classes, thus providing implementations for the
-specifications expressed in class types.
-
-\ikwd{object\@\texttt{object}}
-\ikwd{end\@\texttt{end}}
-\ikwd{fun\@\texttt{fun}}
-\ikwd{let\@\texttt{let}}
-\ikwd{and\@\texttt{and}}
-\ikwd{inherit\@\texttt{inherit}}
-\ikwd{as\@\texttt{as}}
-\ikwd{val\@\texttt{val}}
-\ikwd{mutable\@\texttt{mutable}}
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-\ikwd{constraint\@\texttt{constraint}}
-\ikwd{initializer\@\texttt{initializer}}
-
-\begin{syntax}
-class-expr:
- class-path
- | '[' typexpr {',' typexpr} ']' class-path
- | '(' class-expr ')'
- | '(' class-expr ':' class-type ')'
- | class-expr {{argument}}
- | 'fun' {{parameter}} '->' class-expr
- | 'let' ['rec'] let-binding {'and' let-binding} 'in' class-expr
- | 'object' class-body 'end'
- | 'let' 'open' module-path 'in' class-expr
-;
-%BEGIN LATEX
-\end{syntax} \begin{syntax}
-%END LATEX
-class-field:
- 'inherit' class-expr ['as' lowercase-ident]
- | 'inherit!' class-expr ['as' lowercase-ident]
- | 'val' ['mutable'] inst-var-name [':' typexpr] '=' expr
- | 'val!' ['mutable'] inst-var-name [':' typexpr] '=' expr
- | 'val' ['mutable'] 'virtual' inst-var-name ':' typexpr
- | 'val' 'virtual' 'mutable' inst-var-name ':' typexpr
- | 'method' ['private'] method-name {parameter} [':' typexpr] '=' expr
- | 'method!' ['private'] method-name {parameter} [':' typexpr] '=' expr
- | 'method' ['private'] method-name ':' poly-typexpr '=' expr
- | 'method!' ['private'] method-name ':' poly-typexpr '=' expr
- | 'method' ['private'] 'virtual' method-name ':' poly-typexpr
- | 'method' 'virtual' 'private' method-name ':' poly-typexpr
- | 'constraint' typexpr '=' typexpr
- | 'initializer' expr
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:locally-abstract]{locally abstract types},
-\hyperref[s:attributes]{attributes} and
-\hyperref[s:extension-nodes]{extension nodes}.
-
-\subsubsection*{sss:class-simple}{Simple class expressions}
-
-The expression @class-path@ evaluates to the class bound to the name
-@class-path@. Similarly, the expression
-@'[' typexpr_1 ',' \ldots typexpr_n ']' class-path@
-evaluates to the parametric class bound to the name @class-path@,
-in which type parameters have been instantiated respectively to
-@typexpr_1@, \ldots @typexpr_n@.
-
-The expression @'(' class-expr ')'@ evaluates to the same module as
-@class-expr@.
-
-The expression @'(' class-expr ':' class-type ')'@ checks that
-@class-type@ matches the type of @class-expr@ (that is, that the
-implementation @class-expr@ meets the type specification
-@class-type@). The whole expression evaluates to the same class as
-@class-expr@, except that all components not specified in
-@class-type@ are hidden and can no longer be accessed.
-
-\subsubsection*{sss:class-app}{Class application}
-
-Class application is denoted by juxtaposition of (possibly labeled)
-expressions. It denotes the class whose constructor is the first
-expression applied to the given arguments. The arguments are
-evaluated as for expression application, but the constructor itself will
-only be evaluated when objects are created. In particular, side-effects
-caused by the application of the constructor will only occur at object
-creation time.
-
-\subsubsection*{sss:class-fun}{Class function}
-
-The expression @'fun' [['?']label-name':']pattern '->' class-expr@ evaluates
-to a function from values to classes.
-When this function is applied to a value \var{v}, this value is
-matched against the pattern @pattern@ and the result is the result of
-the evaluation of @class-expr@ in the extended environment.
-
-Conversion from functions with default values to functions with
-patterns only works identically for class functions as for normal
-functions.
-
-The expression
-\begin{center}
-@"fun" parameter_1 \ldots parameter_n "->" class-expr@
-\end{center}
-is a short form for
-\begin{center}
-@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
-\end{center}
-
-\subsubsection*{sss:class-localdefs}{Local definitions}
-
-The {\tt let} and {\tt let rec} constructs bind value names locally,
-as for the core language expressions.
-
-If a local definition occurs at the very beginning of a class
-definition, it will be evaluated when the class is created (just as if
-the definition was outside of the class).
-Otherwise, it will be evaluated when the object constructor is called.
-
-\subsubsection*{sss:class-opens}{Local opens}
-
-Local opens are supported in class expressions since OCaml 4.06.
-
-\subsubsection*{sss:class-body}{Class body}
-\begin{syntax}
-class-body: ['(' pattern [':' typexpr] ')'] { class-field }
-\end{syntax}
-The expression
-@'object' class-body 'end'@ denotes
-a class body. This is the prototype for an object : it lists the
-instance variables and methods of an object of this class.
-
-A class body is a class value: it is not evaluated at once. Rather,
-its components are evaluated each time an object is created.
-
-In a class body, the pattern @'(' pattern [':' typexpr] ')'@ is
-matched against self, therefore providing a binding for self and self
-type. Self can only be used in method and initializers.
-
-Self type cannot be a closed object type, so that the class remains
-extensible.
-
-Since OCaml 4.01, it is an error if the same method or instance
-variable name is defined several times in the same class body.
-
-\subsubsection*{sss:class-inheritance}{Inheritance}
-
-\ikwd{inherit\@\texttt{inherit}}
-
-The inheritance construct @'inherit' class-expr@ allows reusing
-methods and instance variables from other classes. The class
-expression @class-expr@ must evaluate to a class body. The instance
-variables, methods and initializers from this class body are added
-into the current class. The addition of a method will override any
-previously defined method of the same name.
-
-\ikwd{as\@\texttt{as}}
-An ancestor can be bound by appending @'as' lowercase-ident@
-to the inheritance construct. @lowercase-ident@ is not a true
-variable and can only be used to select a method, i.e. in an expression
-@lowercase-ident '#' method-name@. This gives access to the
-method @method-name@ as it was defined in the parent class even if it is
-redefined in the current class.
-The scope of this ancestor binding is limited to the current class.
-The ancestor method may be called from a subclass but only indirectly.
-
-\subsubsection*{sss:class-variables}{Instance variable definition}
-
-\ikwd{val\@\texttt{val}}
-\ikwd{mutable\@\texttt{mutable}}
-
-The definition @'val' ['mutable'] inst-var-name '=' expr@ adds an
-instance variable @inst-var-name@ whose initial value is the value of
-expression @expr@.
-%
-The flag @'mutable'@ allows physical modification of this variable by
-methods.
-
-An instance variable can only be used in the methods and
-initializers that follow its definition.
-
-Since version 3.10, redefinitions of a visible instance variable with
-the same name do not create a new variable, but are merged, using the
-last value for initialization. They must have identical types and
-mutability.
-However, if an instance variable is hidden by
-omitting it from an interface, it will be kept distinct from
-other instance variables with the same name.
-
-\subsubsection*{sss:class-virtual-variable}{Virtual instance variable definition}
-
-\ikwd{val\@\texttt{val}}
-\ikwd{mutable\@\texttt{mutable}}
-
-A variable specification is written @'val' ['mutable'] 'virtual'
-inst-var-name ':' typexpr@. It specifies whether the variable is
-modifiable, and gives its type.
-
-Virtual instance variables were added in version 3.10.
-
-\subsubsection*{sss:class-method}{Method definition}
-
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-
-A method definition is written @'method' method-name '=' expr@. The
-definition of a method overrides any previous definition of this
-method. The method will be public (that is, not private) if any of
-the definition states so.
-
-A private method, @'method' 'private' method-name '=' expr@, is a
-method that can only be invoked on self (from other methods of the
-same object, defined in this class or one of its subclasses). This
-invocation is performed using the expression
-@value-name '#' method-name@, where @value-name@ is directly bound to
-self at the beginning of the class definition. Private methods do
-not appear in object types. A method may have both public and private
-definitions, but as soon as there is a public one, all subsequent
-definitions will be made public.
-
-Methods may have an explicitly polymorphic type, allowing them to be
-used polymorphically in programs (even for the same object). The
-explicit declaration may be done in one of three ways: (1) by giving an
-explicit polymorphic type in the method definition, immediately after
-the method name, {\em i.e.}
-@'method' ['private'] method-name ':' {{"'" ident}} '.' typexpr '='
-expr@; (2) by a forward declaration of the explicit polymorphic type
-through a virtual method definition; (3) by importing such a
-declaration through inheritance and/or constraining the type of {\em
-self}.
-
-Some special expressions are available in method bodies for
-manipulating instance variables and duplicating self:
-\begin{syntax}
-expr:
- \ldots
- | inst-var-name '<-' expr
- | '{<' [ inst-var-name '=' expr { ';' inst-var-name '=' expr } [';'] ] '>}'
-\end{syntax}
-
-The expression @inst-var-name '<-' expr@ modifies in-place the current
-object by replacing the value associated to @inst-var-name@ by the
-value of @expr@. Of course, this instance variable must have been
-declared mutable.
-
-The expression
-@'{<' inst-var-name_1 '=' expr_1 ';' \ldots ';' inst-var-name_n '=' expr_n '>}'@
-evaluates to a copy of the current object in which the values of
-instance variables @inst-var-name_1, \ldots, inst-var-name_n@ have
-been replaced by the values of the corresponding expressions @expr_1,
-\ldots, expr_n@.
-
-\subsubsection*{sss:class-virtual-meth}{Virtual method definition}
-
-\ikwd{method\@\texttt{method}}
-\ikwd{private\@\texttt{private}}
-
-A method specification is written @'method' ['private'] 'virtual'
-method-name ':' poly-typexpr@. It specifies whether the method is
-public or private, and gives its type. If the method is intended to be
-polymorphic, the type must be explicitly polymorphic.
-
-\subsubsection*{sss:class-explicit-overriding}{Explicit overriding}
-
-Since Ocaml 3.12, the keywords @"inherit!"@, @"val!"@ and @"method!"@
-have the same semantics as @"inherit"@, @"val"@ and @"method"@, but
-they additionally require the definition they introduce to be
-overriding. Namely, @"method!"@ requires @method-name@ to be already
-defined in this class, @"val!"@ requires @inst-var-name@ to be already
-defined in this class, and @"inherit!"@ requires @class-expr@ to
-override some definitions. If no such overriding occurs, an error is
-signaled.
-
-As a side-effect, these 3 keywords avoid the warnings~7
-(method override) and~13 (instance variable override).
-Note that warning~7 is disabled by default.
-
-\subsubsection*{sss:class-type-constraints}{Constraints on type parameters}
-
-\ikwd{constraint\@\texttt{constraint}}
-The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
-type expressions to be equals. This is typically used to specify type
-parameters: in that way they can be bound to specific type
-expressions.
-
-\subsubsection*{sss:class-initializers}{Initializers}
-
-\ikwd{initializer\@\texttt{initializer}}
-
-A class initializer @'initializer' expr@ specifies an expression that
-will be evaluated whenever an object is created from the class, once
-all its instance variables have been initialized.
-
-\subsection{ss:class-def}{Class definitions}
-\label{s:classdef}
-
-\ikwd{class\@\texttt{class}}
-\ikwd{and\@\texttt{and}}
-
-\begin{syntax}
-class-definition:
- 'class' class-binding { 'and' class-binding }
-;
-class-binding:
- ['virtual'] ['[' type-parameters ']'] class-name
- {parameter} [':' class-type] \\ '=' class-expr
-;
-type-parameters:
- "'" ident { "," "'" ident }
-\end{syntax}
-
-A class definition @'class' class-binding { 'and' class-binding }@ is
-recursive. Each @class-binding@ defines a @class-name@ that can be
-used in the whole expression except for inheritance. It can also be
-used for inheritance, but only in the definitions that follow its own.
-
-A class binding binds the class name @class-name@ to the value of
-expression @class-expr@. It also binds the class type @class-name@ to
-the type of the class, and defines two type abbreviations :
-@class-name@ and @'#' class-name@. The first one is the type of
-objects of this class, while the second is more general as it unifies
-with the type of any object belonging to a subclass (see
-section~\ref{sss:typexpr-sharp-types}).
-
-\subsubsection*{sss:class-virtual}{Virtual class}
-
-A class must be flagged virtual if one of its methods is virtual (that
-is, appears in the class type, but is not actually defined).
-Objects cannot be created from a virtual class.
-
-\subsubsection*{sss:class-type-params}{Type parameters}
-
-The class type parameters correspond to the ones of the class type and
-of the two type abbreviations defined by the class binding. They must
-be bound to actual types in the class definition using type
-constraints. So that the abbreviations are well-formed, type
-variables of the inferred type of the class must either be type
-parameters or be bound in the constraint clause.
-
-\subsection{ss:class-spec}{Class specifications}
-
-\ikwd{class\@\texttt{class}}
-\ikwd{and\@\texttt{and}}
-
-\begin{syntax}
-class-specification:
- 'class' class-spec { 'and' class-spec }
-;
-class-spec:
- ['virtual'] ['[' type-parameters ']'] class-name ':'
- class-type
-\end{syntax}
-
-This is the counterpart in signatures of class definitions.
-A class specification matches a class definition if they have the same
-type parameters and their types match.
-
-\subsection{ss:classtype}{Class type definitions}
-
-\ikwd{class\@\texttt{class}}
-\ikwd{type\@\texttt{type}}
-\ikwd{and\@\texttt{and}}
-
-\begin{syntax}
-classtype-definition:
- 'class' 'type' classtype-def
- { 'and' classtype-def }
-;
-classtype-def:
- ['virtual'] ['[' type-parameters ']'] class-name '=' class-body-type
-\end{syntax}
-
-A class type definition @'class' class-name '=' class-body-type@
-defines an abbreviation @class-name@ for the class body type
-@class-body-type@. As for class definitions, two type abbreviations
-@class-name@ and @'#' class-name@ are also defined. The definition can
-be parameterized by some type parameters. If any method in the class
-type body is virtual, the definition must be flagged @'virtual'@.
-
-Two class type definitions match if they have the same type parameters
-and they expand to matching types.
+++ /dev/null
-\section{s:compilation-units}{Compilation units}
-%HEVEA\cutname{compunit.html}
-
-\begin{syntax}
-unit-interface: { specification [';;'] }
-;
-unit-implementation: [ module-items ]
-\end{syntax}
-
-Compilation units bridge the module system and the separate
-compilation system. A compilation unit is composed of two parts: an
-interface and an implementation. The interface contains a sequence of
-specifications, just as the inside of a @'sig' \ldots 'end'@
-signature expression. The implementation contains a sequence of
-definitions and expressions, just as the inside of a
-@'struct' \ldots 'end'@ module
-expression. A compilation unit also has a name @unit-name@, derived
-from the names of the files containing the interface and the
-implementation (see chapter~\ref{c:camlc} for more details). A
-compilation unit behaves roughly as the module definition
-\begin{center}
-@'module' unit-name ':' 'sig' unit-interface 'end' '='
- 'struct' unit-implementation 'end'@
-\end{center}
-
-A compilation unit can refer to other compilation units by their
-names, as if they were regular modules. For instance, if "U" is a
-compilation unit that defines a type "t", other compilation units can
-refer to that type under the name "U.t"; they can also refer to "U" as
-a whole structure. Except for names of other compilation units, a unit
-interface or unit implementation must not have any other free variables.
-In other terms, the type-checking and compilation of an interface or
-implementation proceeds in the initial environment
-\begin{center}
-@name_1 ':' 'sig' specification_1 'end' \ldots
- name_n ':' 'sig' specification_n 'end'@
-\end{center}
-where @name_1 \ldots name_n@ are the names of the other
-compilation units available in the search path (see
-chapter~\ref{c:camlc} for more details) and @specification_1 \ldots
-specification_n@ are their respective interfaces.
+++ /dev/null
-\section{s:const}{Constants}
-%HEVEA\cutname{const.html}
-
-\ikwd{false\@\texttt{false}}
-\ikwd{true\@\texttt{true}}
-\ikwd{begin\@\texttt{begin}}
-\ikwd{end\@\texttt{end}}
-
-\begin{syntax}
-constant:
- integer-literal
- | int32-literal
- | int64-literal
- | nativeint-literal
- | float-literal
- | char-literal
- | string-literal
- | constr
- | "false"
- | "true"
- | "("")"
- | "begin" "end"
- | "[""]"
- | "[|""|]"
- | "`"tag-name
-\end{syntax}
-See also the following language extension:
-\hyperref[ss:extension-literals]{extension literals}.
-
-The syntactic class of constants comprises literals from the four
-base types (integers, floating-point numbers, characters, character
-strings), the integer variants, and constant constructors
-from both normal and polymorphic variants, as well as the special
-constants @"false"@, @"true"@, @"("")"@,
-@"[""]"@, and @"[|""|]"@, which behave like constant constructors, and
-@"begin" "end"@, which is equivalent to @'('')'@.
+++ /dev/null
-\section{s:value-expr}{Expressions}
-%HEVEA\cutname{expr.html}
-\ikwd{in\@\texttt{in}|see{\texttt{let}}}
-\ikwd{and\@\texttt{and}}
-\ikwd{rec\@\texttt{rec}|see{\texttt{let}, \texttt{module}}}
-\ikwd{let\@\texttt{let}}
-\ikwd{try\@\texttt{try}}
-\ikwd{function\@\texttt{function}}
-\ikwd{fun\@\texttt{fun}}
-\ikwd{with\@\texttt{with}}
-\ikwd{done\@\texttt{done}|see{\texttt{while}, \texttt{for}}}
-\ikwd{do\@\texttt{do}|see{\texttt{while}, \texttt{for}}}
-\ikwd{downto\@\texttt{downto}|see{\texttt{for}}}
-\ikwd{to\@\texttt{to}|see{\texttt{for}}}
-\ikwd{for\@\texttt{for}}
-\ikwd{else\@\texttt{else}|see{\texttt{if}}}
-\ikwd{then\@\texttt{then}|see{\texttt{if}}}
-\ikwd{if\@\texttt{if}}
-\ikwd{or\@\texttt{or}}
-\ikwd{match\@\texttt{match}}
-\ikwd{begin\@\texttt{begin}}
-\ikwd{end\@\texttt{end}}
-\ikwd{when\@\texttt{when}}
-\ikwd{new\@\texttt{new}}
-\ikwd{object\@\texttt{object}}
-\ikwd{lazy\@\texttt{lazy}}
-
-\begin{syntax}
-expr:
- value-path
- | constant
- | '(' expr ')'
- | 'begin' expr 'end'
- | '(' expr ':' typexpr ')'
- | expr {{',' expr}}
- | constr expr
- | "`"tag-name expr
- | expr '::' expr
- | '[' expr { ';' expr } [';'] ']'
- | '[|' expr { ';' expr } [';'] '|]'
- | '{' field [':' typexpr] ['=' expr]%
- { ';' field [':' typexpr] ['=' expr] } [';'] '}'
- | '{' expr 'with' field [':' typexpr] ['=' expr]%
- { ';' field [':' typexpr] ['=' expr] } [';'] '}'
- | expr {{ argument }}
- | prefix-symbol expr
- | '-' expr
- | '-.' expr
- | expr infix-op expr
- | expr '.' field
- | expr '.' field '<-' expr
- | expr '.(' expr ')'
- | expr '.(' expr ')' '<-' expr
- | expr '.[' expr ']'
- | expr '.[' expr ']' '<-' expr
- | 'if' expr 'then' expr [ 'else' expr ]
- | 'while' expr 'do' expr 'done'
- | 'for' value-name '=' expr ( 'to' || 'downto' ) expr 'do' expr 'done'
- | expr ';' expr
- | 'match' expr 'with' pattern-matching
- | 'function' pattern-matching
- | 'fun' {{ parameter }} [ ':' typexpr ] '->' expr
- | 'try' expr 'with' pattern-matching
- | 'let' ['rec'] let-binding { 'and' let-binding } 'in' expr
- | "let" "exception" constr-decl "in" expr
- | 'let' 'module' module-name { '(' module-name ':' module-type ')' }
- [ ':' module-type ] \\ '=' module-expr 'in' expr
- | '(' expr ':>' typexpr ')'
- | '(' expr ':' typexpr ':>' typexpr ')'
- | 'assert' expr
- | 'lazy' expr
- | local-open
- | object-expr
-;
-%BEGIN LATEX
-\end{syntax} \begin{syntax}
-%END LATEX
-argument:
- expr
- | '~' label-name
- | '~' label-name ':' expr
- | '?' label-name
- | '?' label-name ':' expr
-;
-%\end{syntax} \begin{syntax}
-pattern-matching:
- [ '|' ] pattern ['when' expr] '->' expr
- { '|' pattern ['when' expr] '->' expr }
-;
-let-binding:
- pattern '=' expr
- | value-name { parameter } [':' typexpr] [':>' typexpr] '=' expr
- | value-name ':' poly-typexpr '=' expr %since 3.12
-;
-parameter:
- pattern
- | '~' label-name
- | '~' '(' label-name [':' typexpr] ')'
- | '~' label-name ':' pattern
- | '?' label-name
- | '?' '(' label-name [':' typexpr] ['=' expr] ')'
- | '?' label-name ':' pattern
- | '?' label-name ':' '(' pattern [':' typexpr] ['=' expr] ')'
-;
-local-open:
- | "let" "open" module-path "in" expr
- | module-path '.(' expr ')'
- | module-path '.[' expr ']'
- | module-path '.[|' expr '|]'
- | module-path '.{' expr '}'
- | module-path '.{<' expr '>}'
-;
-object-expr:
- | 'new' class-path
- | 'object' class-body 'end'
- | expr '#' method-name
- | inst-var-name
- | inst-var-name '<-' expr
- | '{<' [ inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] } [';'] ] '>}'
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:first-class-modules]{first-class modules},
-\hyperref[s:explicit-overriding-open]{overriding in open statements},
-\hyperref[s:bigarray-access]{syntax for Bigarray access},
-\hyperref[s:attributes]{attributes},
-\hyperref[s:extension-nodes]{extension nodes} and
-\hyperref[s:index-operators]{extended indexing operators}.
-
-\subsection{ss:precedence-and-associativity}{Precedence and associativity}
-The table below shows the relative precedences and associativity of
-operators and non-closed constructions. The constructions with higher
-precedence come first. For infix and prefix symbols, we write
-``"*"\ldots'' to mean ``any symbol starting with "*"''.
-% Note that this table is duplicated in stdlib/ocaml_operators.mld,
-% these tables should be kept in sync with the one below.
-\ikwd{or\@\texttt{or}}%
-\ikwd{if\@\texttt{if}}%
-\ikwd{fun\@\texttt{fun}}%
-\ikwd{function\@\texttt{function}}%
-\ikwd{match\@\texttt{match}}%
-\ikwd{try\@\texttt{try}}%
-\ikwd{let\@\texttt{let}}%
-\ikwd{mod\@\texttt{mod}}
-\ikwd{land\@\texttt{land}}
-\ikwd{lor\@\texttt{lor}}
-\ikwd{lxor\@\texttt{lxor}}
-\ikwd{lsl\@\texttt{lsl}}
-\ikwd{lsr\@\texttt{lsr}}
-\ikwd{asr\@\texttt{asr}}
-\begin{tableau}{|l|l|}{Construction or operator}{Associativity}
-\entree{prefix-symbol}{--}
-\entree{". .( .[ .{" (see section~\ref{s:bigarray-access})}{--}
-\entree{"#"\ldots}{left}
-\entree{function application, constructor application, tag
- application, "assert",
- "lazy"}{left}
-\entree{"- -." (prefix)}{--}
-\entree{"**"\ldots" lsl lsr asr"}{right}
-\entree{"*"\ldots" /"\ldots" %"\ldots" mod land lor lxor"}{left}
- %% "`"@ident@"`"
-\entree{"+"\ldots" -"\ldots}{left}
-\entree{"::"}{right}
-\entree{{\tt \char64}\ldots " ^"\ldots}{right}
-\entree{"="\ldots" <"\ldots" >"\ldots" |"\ldots" &"\ldots" $"\ldots" !="}{left}
-\entree{"& &&"}{right}
-\entree{"or ||"}{right}
-\entree{","}{--}
-\entree{"<- :="}{right}
-\entree{"if"}{--}
-\entree{";"}{right}
-\entree{"let match fun function try"}{--}
-\end{tableau}
-
-\subsection{ss:expr-basic}{Basic expressions}
-
-\subsubsection*{sss:expr-constants}{Constants}
-
-An expression consisting in a constant evaluates to this constant.
-
-\subsubsection*{sss:expr-var}{Value paths}
-
-An expression consisting in an access path evaluates to the value bound to
-this path in the current evaluation environment. The path can
-be either a value name or an access path to a value component of a module.
-
-\subsubsection*{sss:expr-parenthesized}{Parenthesized expressions}
-\ikwd{begin\@\texttt{begin}}
-\ikwd{end\@\texttt{end}}
-
-The expressions @'(' expr ')'@ and @'begin' expr 'end'@ have the same
-value as @expr@. The two constructs are semantically equivalent, but it
-is good style to use @'begin' \ldots 'end'@ inside control structures:
-\begin{alltt}
- if \ldots then begin \ldots ; \ldots end else begin \ldots ; \ldots end
-\end{alltt}
-and @'(' \ldots ')'@ for the other grouping situations.
-
-Parenthesized expressions can contain a type constraint, as in @'('
-expr ':' typexpr ')'@. This constraint forces the type of @expr@ to be
-compatible with @typexpr@.
-
-Parenthesized expressions can also contain coercions
-@'(' expr [':' typexpr] ':>' typexpr')'@ (see
-subsection~\ref{ss:expr-coercions} below).
-
-
-\subsubsection*{sss:expr-functions-application}{Function application}
-
-Function application is denoted by juxtaposition of (possibly labeled)
-expressions. The expression @expr argument_1 \ldots argument_n@
-evaluates the expression @expr@ and those appearing in @argument_1@
-to @argument_n@. The expression @expr@ must evaluate to a
-functional value $f$, which is then applied to the values of
-@argument_1, \ldots, argument_n@.
-
-The order in which the expressions @expr, argument_1, \ldots,
-argument_n@ are evaluated is not specified.
-
-Arguments and parameters are matched according to their respective
-labels. Argument order is irrelevant, except among arguments with the
-same label, or no label.
-
-If a parameter is specified as optional (label prefixed by @"?"@) in the
-type of @expr@, the corresponding argument will be automatically
-wrapped with the constructor "Some", except if the argument itself is
-also prefixed by @"?"@, in which case it is passed as is.
-%
-If a non-labeled argument is passed, and its corresponding parameter
-is preceded by one or several optional parameters, then these
-parameters are {\em defaulted}, {\em i.e.} the value "None" will be
-passed for them.
-%
-All other missing parameters (without corresponding argument), both
-optional and non-optional, will be kept, and the result of the
-function will still be a function of these missing parameters to the
-body of $f$.
-
-As a special case, if the function has a known arity, all the
-arguments are unlabeled, and their number matches the number of
-non-optional parameters, then labels are ignored and non-optional
-parameters are matched in their definition order. Optional arguments
-are defaulted.
-
-In all cases but exact match of order and labels, without optional
-parameters, the function type should be known at the application
-point. This can be ensured by adding a type constraint. Principality
-of the derivation can be checked in the "-principal" mode.
-
-\subsubsection*{sss:expr-function-definition}{Function definition}
-
-Two syntactic forms are provided to define functions. The first form
-is introduced by the keyword "function":
-\ikwd{function\@\texttt{function}}
-
-$$\begin{array}{rlll}
-\token{function} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
-\token{|} & \ldots \\
-\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
-\end{array}$$
-This expression evaluates to a functional value with one argument.
-When this function is applied to a value \var{v}, this value is
-matched against each pattern @pattern_1@ to @pattern_n@.
-If one of these matchings succeeds, that is, if the value \var{v}
-matches the pattern @pattern_i@ for some \var{i},
-then the expression @expr_i@ associated to the selected pattern
-is evaluated, and its value becomes the value of the function
-application. The evaluation of @expr_i@ takes place in an
-environment enriched by the bindings performed during the matching.
-
-If several patterns match the argument \var{v}, the one that occurs
-first in the function definition is selected. If none of the patterns
-matches the argument, the exception "Match_failure" is raised.
-%
-\index{Matchfailure\@\verb`Match_failure`}
-
-\medskip
-
-The other form of function definition is introduced by the keyword "fun":
-\ikwd{fun\@\texttt{fun}}
-\begin{center}
-@"fun" parameter_1 \ldots parameter_n "->" expr@
-\end{center}
-This expression is equivalent to:
-\begin{center}
-@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
-\end{center}
-
-An optional type constraint @typexpr@ can be added before "->" to enforce
-the type of the result to be compatible with the constraint @typexpr@:
-\begin{center}
-@"fun" parameter_1 \ldots parameter_n ":" typexpr "->" expr@
-\end{center}
-is equivalent to
-\begin{center}
- @"fun" parameter_1 "->" \ldots "fun" parameter_n "->" %
- (expr ":" typexpr )@
-\end{center}
-Beware of the small syntactic difference between a type constraint on
-the last parameter
-\begin{center}
- @"fun" parameter_1 \ldots (parameter_n":"typexpr)"->" expr @
-\end{center}
-and one on the result
-\begin{center}
- @"fun" parameter_1 \ldots parameter_n":" typexpr "->" expr @
-\end{center}
-
-The parameter patterns @"~"lab@ and @"~("lab [":" typ]")"@
-are shorthands for respectively @"~"lab":"lab@ and
-@"~"lab":("lab [":" typ]")"@, and similarly for their optional
-counterparts.
-
-A function of the form @"fun" "?" lab ":(" pattern '=' expr_0 ')' '->'
-expr@ is equivalent to
-\begin{center}
-@"fun" "?" lab ":" ident '->'
- "let" pattern '='
- "match" ident "with" "Some" ident "->" ident '|' "None" '->' expr_0
- "in" expr@
-\end{center}
-where @ident@
-is a fresh variable, except that it is unspecified when @expr_0@ is evaluated.
-
-After these two transformations, expressions are of the form
-\begin{center}
-@"fun" [label_1] pattern_1 "->" \ldots "fun" [label_n] pattern_n "->" expr@
-\end{center}
-If we ignore labels, which will only be meaningful at function
-application, this is equivalent to
-\begin{center}
-@"function" pattern_1 "->" \ldots "function" pattern_n "->" expr@
-\end{center}
-That is, the @"fun"@ expression above evaluates to a curried function
-with \var{n} arguments: after applying this function $n$ times to the
-values @@v@_1 \ldots @v@_n@, the values will be matched
-in parallel against the patterns @pattern_1 \ldots pattern_n@.
-If the matching succeeds, the function returns the value of @expr@ in
-an environment enriched by the bindings performed during the matchings.
-If the matching fails, the exception "Match_failure" is raised.
-
-\subsubsection*{sss:guards-in-pattern-matchings}{Guards in pattern-matchings}
-
-\ikwd{when\@\texttt{when}}
-The cases of a pattern matching (in the @"function"@, @"match"@ and
-@"try"@ constructs) can include guard expressions, which are
-arbitrary boolean expressions that must evaluate to "true" for the
-match case to be selected. Guards occur just before the @"->"@ token and
-are introduced by the @"when"@ keyword:
-
-$$\begin{array}{rlll}
-\token{function} & \nt{pattern}_1 \; [\token{when} \; \nt{cond}_1] & \token{->} & \nt{expr}_1 \\
-\token{|} & \ldots \\
-\token{|} & \nt{pattern}_n \; [\token{when} \; \nt{cond}_n] & \token{->} & \nt{expr}_n
-\end{array}$$
-
-
-Matching proceeds as described before, except that if the value
-matches some pattern @pattern_i@ which has a guard @@cond@_i@, then the
-expression @@cond@_i@ is evaluated (in an environment enriched by the
-bindings performed during matching). If @@cond@_i@ evaluates to "true",
-then @expr_i@ is evaluated and its value returned as the result of the
-matching, as usual. But if @@cond@_i@ evaluates to "false", the matching
-is resumed against the patterns following @pattern_i@.
-
-\subsubsection*{sss:expr-localdef}{Local definitions}
-
-\ikwd{let\@\texttt{let}}
-
-The @"let"@ and @"let" "rec"@ constructs bind value names locally.
-The construct
-\begin{center}
-@"let" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n "in" expr@
-\end{center}
-evaluates @expr_1 \ldots expr_n@ in some unspecified order and matches
-their values against the patterns @pattern_1 \ldots pattern_n@. If the
-matchings succeed, @expr@ is evaluated in the environment enriched by
-the bindings performed during matching, and the value of @expr@ is
-returned as the value of the whole @"let"@ expression. If one of the
-matchings fails, the exception "Match_failure" is raised.
-%
-\index{Matchfailure\@\verb`Match_failure`}
-
-An alternate syntax is provided to bind variables to functional
-values: instead of writing
-\begin{center}
-@"let" ident "=" "fun" parameter_1 \ldots parameter_m "->" expr@
-\end{center}
-in a @"let"@ expression, one may instead write
-\begin{center}
-@"let" ident parameter_1 \ldots parameter_m "=" expr@
-\end{center}
-
-\medskip
-\noindent
-Recursive definitions of names are introduced by @"let" "rec"@:
-\begin{center}
-@"let" "rec" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n
- "in" expr@
-\end{center}
-The only difference with the @"let"@ construct described above is
-that the bindings of names to values performed by the
-pattern-matching are considered already performed when the expressions
-@expr_1@ to @expr_n@ are evaluated. That is, the expressions @expr_1@
-to @expr_n@ can reference identifiers that are bound by one of the
-patterns @pattern_1, \ldots, pattern_n@, and expect them to have the
-same value as in @expr@, the body of the @"let" "rec"@ construct.
-
-The recursive definition is guaranteed to behave as described above if
-the expressions @expr_1@ to @expr_n@ are function definitions
-(@"fun" \ldots@ or @"function" \ldots@), and the patterns @pattern_1
-\ldots pattern_n@ are just value names, as in:
-\begin{center}
-@"let" "rec" name_1 "=" "fun" \ldots
-"and" \ldots
-"and" name_n "=" "fun" \ldots
-"in" expr@
-\end{center}
-This defines @name_1 \ldots name_n@ as mutually recursive functions
-local to @expr@.
-
-The behavior of other forms of @"let" "rec"@ definitions is
-implementation-dependent. The current implementation also supports
-a certain class of recursive definitions of non-functional values,
-as explained in section~\ref{s:letrecvalues}.
-\subsubsection{sss:expr-explicit-polytype}{Explicit polymorphic type annotations}
-(Introduced in OCaml 3.12)
-
-Polymorphic type annotations in @"let"@-definitions behave in a way
-similar to polymorphic methods:
-
-\begin{center}
-@"let" pattern_1 ":" typ_1 \ldots typ_n "." typeexpr "=" expr @
-\end{center}
-
-These annotations explicitly require the defined value to be polymorphic,
-and allow one to use this polymorphism in recursive occurrences
-(when using @"let" "rec"@). Note however that this is a normal polymorphic
-type, unifiable with any instance of itself.
-
-It is possible to define local exceptions in expressions:
-@ "let" exception constr-decl "in" expr @ .
-The syntactic scope of the exception constructor is the inner
-expression, but nothing prevents exception values created with this
-constructor from escaping this scope. Two executions of the definition
-above result in two incompatible exception constructors (as for any
-exception definition). For instance, the following assertion is
-true:
-\begin{verbatim}
- let gen () = let exception A in A
- let () = assert(gen () <> gen ())
-\end{verbatim}
-
-\subsection{ss:expr-control}{Control structures}
-
-\subsubsection*{sss:expr-sequence}{Sequence}
-
-The expression @expr_1 ";" expr_2@ evaluates @expr_1@ first, then
-@expr_2@, and returns the value of @expr_2@.
-
-\subsubsection*{sss:expr-conditional}{Conditional}
-\ikwd{if\@\texttt{if}}
-
-The expression @"if" expr_1 "then" expr_2 "else" expr_3@ evaluates to
-the value of @expr_2@ if @expr_1@ evaluates to the boolean @"true"@,
-and to the value of @expr_3@ if @expr_1@ evaluates to the boolean
-@"false"@.
-
-The @"else" expr_3@ part can be omitted, in which case it defaults to
-@"else" "()"@.
-
-\subsubsection*{sss:expr-case}{Case expression}\ikwd{match\@\texttt{match}}
-
-The expression
-$$\begin{array}{rlll}
-\token{match} & \textsl{expr} \\
-\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
-\token{|} & \ldots \\
-\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
-\end{array}$$
-matches the value of @expr@ against the patterns @pattern_1@ to
-@pattern_n@. If the matching against @pattern_i@ succeeds, the
-associated expression @expr_i@ is evaluated, and its value becomes the
-value of the whole @'match'@ expression. The evaluation of
-@expr_i@ takes place in an environment enriched by the bindings
-performed during matching. If several patterns match the value of
-@expr@, the one that occurs first in the @'match'@ expression is
-selected. If none of the patterns match the value of @expr@, the
-exception "Match_failure" is raised.
-%
-\index{Matchfailure\@\verb`Match_failure`}
-
-\subsubsection*{sss:expr-boolean-operators}{Boolean operators}
-
-The expression @expr_1 '&&' expr_2@ evaluates to @'true'@ if both
-@expr_1@ and @expr_2@ evaluate to @'true'@; otherwise, it evaluates to
-@'false'@. The first component, @expr_1@, is evaluated first. The
-second component, @expr_2@, is not evaluated if the first component
-evaluates to @'false'@. Hence, the expression @expr_1 '&&' expr_2@ behaves
-exactly as
-\begin{center}
-@'if' expr_1 'then' expr_2 'else' 'false'@.
-\end{center}
-
-The expression @expr_1 '||' expr_2@ evaluates to @'true'@ if one of
-the expressions
-@expr_1@ and @expr_2@ evaluates to @'true'@; otherwise, it evaluates to
-@'false'@. The first component, @expr_1@, is evaluated first. The
-second component, @expr_2@, is not evaluated if the first component
-evaluates to @'true'@. Hence, the expression @expr_1 '||' expr_2@ behaves
-exactly as
-\begin{center}
-@'if' expr_1 'then' 'true' 'else' expr_2@.
-\end{center}
-
-\ikwd{or\@\texttt{or}}
-The boolean operators @'&'@ and @'or'@ are deprecated synonyms for
-(respectively) @'&&'@ and @'||'@.
-
-\subsubsection*{sss:expr-loops}{Loops}
-
-\ikwd{while\@\texttt{while}}
-The expression @'while' expr_1 'do' expr_2 'done'@ repeatedly
-evaluates @expr_2@ while @expr_1@ evaluates to @'true'@. The loop
-condition @expr_1@ is evaluated and tested at the beginning of each
-iteration. The whole @'while' \ldots 'done'@ expression evaluates to
-the unit value @'()'@.
-
-\ikwd{for\@\texttt{for}}
-The expression @'for' name '=' expr_1 'to' expr_2 'do' expr_3 'done'@
-first evaluates the expressions @expr_1@ and @expr_2@ (the boundaries)
-into integer values \var{n} and \var{p}. Then, the loop body @expr_3@ is
-repeatedly evaluated in an environment where @name@ is successively
-bound to the values
- $n$, $n+1$, \ldots, $p-1$, $p$.
- The loop body is never evaluated if $n > p$.
-
-
-The expression @'for' name '=' expr_1 'downto' expr_2 'do' expr_3 'done'@
-evaluates similarly, except that @name@ is successively bound to the values
- $n$, $n-1$, \ldots, $p+1$, $p$.
- The loop body is never evaluated if $n < p$.
-
-
-In both cases, the whole @'for'@ expression evaluates to the unit
-value @'()'@.
-
-\subsubsection*{sss:expr-exception-handling}{Exception handling}
-\ikwd{try\@\texttt{try}}
-
-The expression
-$$\begin{array}{rlll}
-\token{try~} & \textsl{expr} \\
-\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
-\token{|} & \ldots \\
-\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
-\end{array}$$
-evaluates the expression @expr@ and returns its value if the
-evaluation of @expr@ does not raise any exception. If the evaluation
-of @expr@ raises an exception, the exception value is matched against
-the patterns @pattern_1@ to @pattern_n@. If the matching against
-@pattern_i@ succeeds, the associated expression @expr_i@ is evaluated,
-and its value becomes the value of the whole @'try'@ expression. The
-evaluation of @expr_i@ takes place in an environment enriched by the
-bindings performed during matching. If several patterns match the value of
-@expr@, the one that occurs first in the @'try'@ expression is
-selected. If none of the patterns matches the value of @expr@, the
-exception value is raised again, thereby transparently ``passing
-through'' the @'try'@ construct.
-
-\subsection{ss:expr-ops-on-data}{Operations on data structures}
-
-\subsubsection*{sss:expr-products}{Products}
-
-The expression @expr_1 ',' \ldots ',' expr_n@ evaluates to the
-\var{n}-tuple of the values of expressions @expr_1@ to @expr_n@. The
-evaluation order of the subexpressions is not specified.
-
-\subsubsection*{sss:expr-variants}{Variants}
-
-The expression @constr expr@ evaluates to the unary variant value
-whose constructor is @constr@, and whose argument is the value of
-@expr@. Similarly, the expression @constr '(' expr_1 ',' \ldots ','
-expr_n ')'@ evaluates to the n-ary variant value whose constructor is
-@constr@ and whose arguments are the values of @expr_1, \ldots,
-expr_n@.
-
-The expression @constr '('expr_1, \ldots, expr_n')'@ evaluates to the
-variant value whose constructor is @constr@, and whose arguments are
-the values of @expr_1 \ldots expr_n@.
-
-For lists, some syntactic sugar is provided. The expression
-@expr_1 '::' expr_2@ stands for the constructor @'(' '::' ')' @
-applied to the arguments @'(' expr_1 ',' expr_2 ')'@, and therefore
-evaluates to the list whose head is the value of @expr_1@ and whose tail
-is the value of @expr_2@. The expression @'[' expr_1 ';' \ldots ';'
-expr_n ']'@ is equivalent to @expr_1 '::' \ldots '::' expr_n '::'
-'[]'@, and therefore evaluates to the list whose elements are the
-values of @expr_1@ to @expr_n@.
-
-\subsubsection*{sss:expr-polyvars}{Polymorphic variants}
-
-The expression @"`"tag-name expr@ evaluates to the polymorphic variant
-value whose tag is @tag-name@, and whose argument is the value of @expr@.
-
-\subsubsection*{sss:expr-records}{Records}
-
-The expression @'{' field_1 ['=' expr_1] ';' \ldots ';' field_n ['='
-expr_n ']}'@ evaluates to the record value
-$\{ field_1 = v_1; \ldots; field_n = v_n \}$
-where $v_i$ is the value of @expr_i@ for \fromoneto{i}{n}.
-A single identifier @field_k@ stands for @field_k '=' field_k@,
-and a qualified identifier @module-path '.' field_k@ stands for
-@module-path '.' field_k '=' field_k@.
-The fields @field_1@ to @field_n@ must all belong to the same record
-type; each field of this record type must appear exactly
-once in the record expression, though they can appear in any
-order. The order in which @expr_1@ to @expr_n@ are evaluated is not
-specified. Optional type constraints can be added after each field
-@'{' field_1 ':' typexpr_1 '=' expr_1 ';'%
- \ldots ';' field_n ':' typexpr_n '=' expr_n '}'@
-to force the type of @field_k@ to be compatible with @typexpr_k@.
-
-The expression
-@"{" expr "with" field_1 ["=" expr_1] ";" \ldots ";" field_n ["=" expr_n] "}"@
-builds a fresh record with fields @field_1 \ldots field_n@ equal to
-@expr_1 \ldots expr_n@, and all other fields having the same value as
-in the record @expr@. In other terms, it returns a shallow copy of
-the record @expr@, except for the fields @field_1 \ldots field_n@,
-which are initialized to @expr_1 \ldots expr_n@. As previously,
-single identifier @field_k@ stands for @field_k '=' field_k@,
-a qualified identifier @module-path '.' field_k@ stands for
-@module-path '.' field_k '=' field_k@ and it is
-possible to add an optional type constraint on each field being updated
-with
-@"{" expr "with" field_1 ':' typexpr_1 "=" expr_1 ";" %
- \ldots ";" field_n ':' typexpr_n "=" expr_n "}"@.
-
-The expression @expr_1 '.' field@ evaluates @expr_1@ to a record
-value, and returns the value associated to @field@ in this record
-value.
-
-The expression @expr_1 '.' field '<-' expr_2@ evaluates @expr_1@ to a record
-value, which is then modified in-place by replacing the value
-associated to @field@ in this record by the value of
-@expr_2@. This operation is permitted only if @field@ has been
-declared @'mutable'@ in the definition of the record type. The whole
-expression @expr_1 '.' field '<-' expr_2@ evaluates to the unit value
-@'()'@.
-
-\subsubsection*{sss:expr-arrays}{Arrays}
-
-The expression @'[|' expr_1 ';' \ldots ';' expr_n '|]'@ evaluates to
-a \var{n}-element array, whose elements are initialized with the values of
-@expr_1@ to @expr_n@ respectively. The order in which these
-expressions are evaluated is unspecified.
-
-The expression @expr_1 '.(' expr_2 ')'@ returns the value of element
-number @expr_2@ in the array denoted by @expr_1@. The first element
-has number 0; the last element has number $n-1$, where \var{n} is the
-size of the array. The exception "Invalid_argument" is raised if the
-access is out of bounds.
-
-The expression @expr_1 '.(' expr_2 ')' '<-' expr_3@ modifies in-place
-the array denoted by @expr_1@, replacing element number @expr_2@ by
-the value of @expr_3@. The exception "Invalid_argument" is raised if
-the access is out of bounds. The value of the whole expression is @'()'@.
-
-\subsubsection*{sss:expr-strings}{Strings}
-
-The expression @expr_1 '.[' expr_2 ']'@ returns the value of character
-number @expr_2@ in the string denoted by @expr_1@. The first character
-has number 0; the last character has number $n-1$, where \var{n} is the
-length of the string. The exception "Invalid_argument" is raised if the
-access is out of bounds.
-
-The expression @expr_1 '.[' expr_2 ']' '<-' expr_3@ modifies in-place
-the string denoted by @expr_1@, replacing character number @expr_2@ by
-the value of @expr_3@. The exception "Invalid_argument" is raised if
-the access is out of bounds. The value of the whole expression is @'()'@.
-
-{\bf Note:} this possibility is offered only for backward
-compatibility with older versions of OCaml and will be removed in a
-future version. New code should use byte sequences and the "Bytes.set"
-function.
-
-\subsection{ss:expr-operators}{Operators}
-\ikwd{mod\@\texttt{mod}}
-\ikwd{land\@\texttt{land}}
-\ikwd{lor\@\texttt{lor}}
-\ikwd{lxor\@\texttt{lxor}}
-\ikwd{lsl\@\texttt{lsl}}
-\ikwd{lsr\@\texttt{lsr}}
-\ikwd{asr\@\texttt{asr}}
-
-Symbols from the class @infix-symbol@, as well as the keywords
-@"*"@, @"+"@, @"-"@, @'-.'@, @"="@, @"!="@, @"<"@, @">"@, @"or"@, @"||"@,
-@"&"@, @"&&"@, @":="@, @"mod"@, @"land"@, @"lor"@, @"lxor"@, @"lsl"@, @"lsr"@,
-and @"asr"@ can appear in infix position (between two
-expressions). Symbols from the class @prefix-symbol@, as well as
-the keywords @"-"@ and @"-."@
-can appear in prefix position (in front of an expression).
-
-Infix and prefix symbols do not have a fixed meaning: they are simply
-interpreted as applications of functions bound to the names
-corresponding to the symbols. The expression @prefix-symbol expr@ is
-interpreted as the application @'(' prefix-symbol ')'
-expr@. Similarly, the expression @expr_1 infix-symbol expr_2@ is
-interpreted as the application @'(' infix-symbol ')' expr_1 expr_2@.
-
-The table below lists the symbols defined in the initial environment
-and their initial meaning. (See the description of the core
-library module "Stdlib" in chapter~\ref{c:corelib} for more
-details). Their meaning may be changed at any time using
-@"let" "(" infix-op ")" name_1 name_2 "=" \ldots@
-
-Note: the operators @'&&'@, @'||'@, and @'~-'@ are handled specially
-and it is not advisable to change their meaning.
-
-The keywords @'-'@ and @'-.'@ can appear both as infix and
-prefix operators. When they appear as prefix operators, they are
-interpreted respectively as the functions @'(~-)'@ and @'(~-.)'@.
-
-%% Conversely, a regular function identifier can also be used as an infix
-%% operator by enclosing it in backquotes: @expr_1 '`' ident '`' expr_2@
-%% is interpreted as the application @ident expr_1 expr_2@.
-
-\ikwd{mod\@\texttt{mod}}%
-\ikwd{land\@\texttt{land}}%
-\ikwd{lor\@\texttt{lor}}%
-\ikwd{lxor\@\texttt{lxor}}%
-\ikwd{lsl\@\texttt{lsl}}%
-\ikwd{lsr\@\texttt{lsr}}%
-\ikwd{asr\@\texttt{asr}}%
-\begin{tableau}{|l|p{12cm}|}{Operator}{Initial meaning}
-\entree{"+"}{Integer addition.}
-\entree{"-" (infix)}{Integer subtraction.}
-\entree{"~- -" (prefix)}{Integer negation.}
-\entree{"*"}{Integer multiplication.}
-\entree{"/"}{Integer division.
- Raise "Division_by_zero" if second argument is zero.}
-\entree{"mod"}{Integer modulus. Raise
- "Division_by_zero" if second argument is zero.}
-\entree{"land"}{Bitwise logical ``and'' on integers.}
-\entree{"lor"}{Bitwise logical ``or'' on integers.}
-\entree{"lxor"}{Bitwise logical ``exclusive or'' on integers.}
-\entree{"lsl"}{Bitwise logical shift left on integers.}
-\entree{"lsr"}{Bitwise logical shift right on integers.}
-\entree{"asr"}{Bitwise arithmetic shift right on integers.}
-\entree{"+."}{Floating-point addition.}
-\entree{"-." (infix)}{Floating-point subtraction.}
-\entree{"~-. -." (prefix)}{Floating-point negation.}
-\entree{"*."}{Floating-point multiplication.}
-\entree{"/."}{Floating-point division.}
-\entree{"**"}{Floating-point exponentiation.}
-\entree{{\tt\char64} }{List concatenation.}
-\entree{"^" }{String concatenation.}
-\entree{"!" }{Dereferencing (return the current
- contents of a reference).}
-\entree{":="}{Reference assignment (update the
- reference given as first argument with the value of the second
- argument).}
-\entree{"=" }{Structural equality test.}
-\entree{"<>" }{Structural inequality test.}
-\entree{"==" }{Physical equality test.}
-\entree{"!=" }{Physical inequality test.}
-\entree{"<" }{Test ``less than''.}
-\entree{"<=" }{Test ``less than or equal''.}
-\entree{">" }{Test ``greater than''.}
-\entree{">=" }{Test ``greater than or equal''.}
-\entree{"&& &"}{Boolean conjunction.}
-\entree{"|| or"}{Boolean disjunction.}
-\end{tableau}
-
-\subsection{ss:expr-obj}{Objects} \label{s:objects}
-
-\subsubsection*{sss:expr-obj-creation}{Object creation}
-
-\ikwd{new\@\texttt{new}}
-
-When @class-path@ evaluates to a class body, @'new' class-path@
-evaluates to a new object containing the instance variables and
-methods of this class.
-
-When @class-path@ evaluates to a class function, @'new' class-path@
-evaluates to a function expecting the same number of arguments and
-returning a new object of this class.
-
-\subsubsection*{sss:expr-obj-immediate}{Immediate object creation}
-
-\ikwd{object\@\texttt{object}}
-
-Creating directly an object through the @'object' class-body 'end'@
-construct is operationally equivalent to defining locally a @'class'
-class-name '=' 'object' class-body 'end'@ ---see sections
-\ref{sss:class-body} and following for the syntax of @class-body@---
-and immediately creating a single object from it by @'new' class-name@.
-
-The typing of immediate objects is slightly different from explicitly
-defining a class in two respects. First, the inferred object type may
-contain free type variables. Second, since the class body of an
-immediate object will never be extended, its self type can be unified
-with a closed object type.
-
-\subsubsection*{sss:expr-method}{Method invocation}
-
-The expression @expr '#' method-name@ invokes the method
-@method-name@ of the object denoted by @expr@.
-
-If @method-name@ is a polymorphic method, its type should be known at
-the invocation site. This is true for instance if @expr@ is the name
-of a fresh object (@'let' ident = 'new' class-path \dots @) or if
-there is a type constraint. Principality of the derivation can be
-checked in the "-principal" mode.
-
-\subsubsection*{sss:expr-obj-variables}{Accessing and modifying instance variables}
-
-The instance variables of a class are visible only in the body of the
-methods defined in the same class or a class that inherits from the
-class defining the instance variables. The expression @inst-var-name@
-evaluates to the value of the given instance variable. The expression
-@inst-var-name '<-' expr@ assigns the value of @expr@ to the instance
-variable @inst-var-name@, which must be mutable. The whole expression
-@inst-var-name '<-' expr@ evaluates to @"()"@.
-
-
-\subsubsection*{sss:expr-obj-duplication}{Object duplication}
-
-An object can be duplicated using the library function "Oo.copy"
-(see module \stdmoduleref{Oo}). Inside a method, the expression
-@ '{<' [inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] }] '>}'@
-returns a copy of self with the given instance variables replaced by
-the values of the associated expressions. A single instance variable
-name @id@ stands for @id '=' id@. Other instance variables have the same
-value in the returned object as in self.
-
-\subsection{ss:expr-coercions}{Coercions}
-
-Expressions whose type contains object or polymorphic variant types
-can be explicitly coerced (weakened) to a supertype.
-%
-The expression @'('expr ':>' typexpr')'@ coerces the expression @expr@
-to type @typexpr@.
-%
-The expression @'('expr ':' typexpr_1 ':>' typexpr_2')'@ coerces the
-expression @expr@ from type @typexpr_1@ to type @typexpr_2@.
-
-The former operator will sometimes fail to coerce an expression @expr@
-from a type @typ_1@ to a type @typ_2@
-even if type @typ_1@ is a subtype of type
-@typ_2@: in the current implementation it only expands two levels of
-type abbreviations containing objects and/or polymorphic variants,
-keeping only recursion when it is explicit in the class type (for objects).
-As an exception to the above algorithm, if both the inferred type of @expr@
-and @typ@ are ground ({\em i.e.} do not contain type variables), the
-former operator behaves as the latter one, taking the inferred type of
-@expr@ as @typ_1@. In case of failure with the former operator,
-the latter one should be used.
-
-It is only possible to coerce an expression @expr@ from type
-@typ_1@ to type @typ_2@, if the type of @expr@ is an instance of
-@typ_1@ (like for a type annotation), and @typ_1@ is a subtype
-of @typ_2@. The type of the coerced expression is an
-instance of @typ_2@. If the types contain variables,
-they may be instantiated by the subtyping algorithm, but this is only
-done after determining whether @typ_1@ is a potential subtype of
-@typ_2@. This means that typing may fail during this latter
-unification step, even if some instance of @typ_1@ is a subtype of
-some instance of @typ_2@.
-%
-In the following paragraphs we describe the subtyping relation used.
-
-\subsubsection*{sss:expr-obj-types}{Object types}
-
-A fixed object type admits as subtype any object type that includes all
-its methods. The types of the methods shall be subtypes of those in
-the supertype. Namely,
-\begin{center}
-@ '<' met_1 ':' typ_1 ';' \dots ';' met_n ':' typ_n '>' @
-\end{center}
-is a supertype of
-\begin{center}
-@ '<' met_1 ':' typ@$'_1$@ ';' \dots ';' met_n ':' typ@$'_n$@ ';'
-met@$_{n+1}$@ ':' typ@$'_{n+1}$@ ';' \dots ';' met@$_{n+m}$@ ':' typ@$'_{n+m}$@
-~[';' '..'] '>' @
-\end{center}
-which may contain an ellipsis ".." if every @typ_i@ is a supertype of
-the corresponding @typ@$'_i$.
-
-A monomorphic method type can be a supertype of a polymorphic method
-type. Namely, if @typ@ is an instance of @typ@$'$, then @ "'"@a@_1
-\dots "'"@a@_n '.' typ@$'$ is a subtype of @typ@.
-
-Inside a class definition, newly defined types are not available for
-subtyping, as the type abbreviations are not yet completely
-defined. There is an exception for coercing @@self@@ to the (exact)
-type of its class: this is allowed if the type of @@self@@ does not
-appear in a contravariant position in the class type, {\em i.e.} if
-there are no binary methods.
-
-\subsubsection*{sss:expr-polyvar-types}{Polymorphic variant types}
-
-A polymorphic variant type @typ@ is a subtype of another polymorphic
-variant type @typ@$'$ if the upper bound of @typ@ ({\em i.e.} the
-maximum set of constructors that may appear in an instance of @typ@)
-is included in the lower bound of @typ@$'$, and the types of arguments
-for the constructors of @typ@ are subtypes of those in
-@typ@$'$. Namely,
-\begin{center}
-@ "["["<"] "`"C_1 "of" typ_1 "|" \dots "|" "`"C_n "of" typ_n "]" @
-\end{center}
-which may be a shrinkable type, is a subtype of
-\begin{center}
-@ "["[">"] "`"C_1 "of" typ@$'_1$@ "|" \dots "|" "`"C_n "of" typ@$'_n$@
- "|" "`"C@$_{n+1}$@ "of" typ@$'_{n+1}$@ "|" \dots "|" "`"C@$_{n+m}$@ "of"
- typ@$'_{n+m}$@ "]" @
-\end{center}
-which may be an extensible type, if every @typ_i@ is a subtype of @typ@$'_i$.
-
-\subsubsection*{sss:expr-variance}{Variance}
-
-Other types do not introduce new subtyping, but they may propagate the
-subtyping of their arguments. For instance, @typ_1 "*" typ_2@ is a
-subtype of @typ@$'_1$@ "*" typ@$'_2$ when @typ_1@ and @typ_2@ are
-respectively subtypes of @typ@$'_1$ and @typ@$'_2$.
-For function types, the relation is more subtle:
-@typ_1 "->" typ_2@ is a subtype of @typ@$'_1$@~"->" typ@$'_2$
-if @typ_1@ is a supertype of @typ@$'_1$ and @typ_2@ is a
-subtype of @typ@$'_2$. For this reason, function types are covariant in
-their second argument (like tuples), but contravariant in their first
-argument. Mutable types, like "array" or "ref" are neither covariant
-nor contravariant, they are nonvariant, that is they do not propagate
-subtyping.
-
-For user-defined types, the variance is automatically inferred: a
-parameter is covariant if it has only covariant occurrences,
-contravariant if it has only contravariant occurrences,
-variance-free if it has no occurrences, and nonvariant otherwise.
-A variance-free parameter may change freely through subtyping, it does
-not have to be a subtype or a supertype.
-%
-For abstract and private types, the variance must be given explicitly
-(see section~\ref{ss:typedefs}),
-otherwise the default is nonvariant. This is also the case for
-constrained arguments in type definitions.
-
-
-\subsection{ss:expr-other}{Other}
-
-\subsubsection*{sss:expr-assertion}{Assertion checking}
-
-
-\ikwd{assert\@\texttt{assert}}
-
-OCaml supports the @"assert"@ construct to check debugging assertions.
-The expression @"assert" expr@ evaluates the expression @expr@ and
-returns @"()"@ if @expr@ evaluates to @"true"@. If it evaluates to
-@"false"@ the exception
-"Assert_failure" is raised with the source file name and the
-location of @expr@ as arguments. Assertion
-checking can be turned off with the "-noassert" compiler option. In
-this case, @expr@ is not evaluated at all.
-
-As a special case, @"assert false"@ is reduced to
-@'raise' '('@"Assert_failure ..."@')'@, which gives it a polymorphic
-type. This means that it can be used in place of any expression (for
-example as a branch of any pattern-matching). It also means that
-the @"assert false"@ ``assertions'' cannot be turned off by the
-"-noassert" option.
-%
-\index{Assertfailure\@\verb`Assert_failure`}
-
-\subsubsection*{sss:expr-lazy}{Lazy expressions}
-\ikwd{lazy\@\texttt{lazy}}
-
-The expression @"lazy" expr@ returns a value \var{v} of type "Lazy.t" that
-encapsulates the computation of @expr@. The argument @expr@ is not
-evaluated at this point in the program. Instead, its evaluation will
-be performed the first time the function "Lazy.force" is applied to the value
-\var{v}, returning the actual value of @expr@. Subsequent applications
-of "Lazy.force" to \var{v} do not evaluate @expr@ again. Applications
-of "Lazy.force" may be implicit through pattern matching (see~\ref{sss:pat-lazy}).
-
-\subsubsection*{sss:expr-local-modules}{Local modules}
-\ikwd{let\@\texttt{let}}
-\ikwd{module\@\texttt{module}}
-
-The expression
-@"let" "module" module-name "=" module-expr "in" expr@
-locally binds the module expression @module-expr@ to the identifier
-@module-name@ during the evaluation of the expression @expr@.
-It then returns the value of @expr@. For example:
-\begin{caml_example}{verbatim}
-let remove_duplicates comparison_fun string_list =
- let module StringSet =
- Set.Make(struct type t = string
- let compare = comparison_fun end) in
- StringSet.elements
- (List.fold_right StringSet.add string_list StringSet.empty)
-\end{caml_example}
-
-\subsubsection*{sss:local-opens}{Local opens}
-\ikwd{let\@\texttt{let}}
-\ikwd{module\@\texttt{open}}
-
-The expressions @"let" "open" module-path "in" expr@ and
-@module-path'.('expr')'@ are strictly equivalent. These
-constructions locally open the module referred to by the module path
-@module-path@ in the respective scope of the expression @expr@.
-
-When the body of a local open expression is delimited by
-@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
-For expression, parentheses can also be omitted for @'{<' '>}'@.
-For example, @module-path'.['expr']'@ is equivalent to
-@module-path'.(['expr'])'@, and @module-path'.[|' expr '|]'@ is
-equivalent to @module-path'.([|' expr '|])'@.
-
-%% \newpage
+++ /dev/null
-\chapter{Language extensions} \label{c:extensions}
-%HEVEA\cutname{extn.html}
-
-This chapter describes language extensions and convenience features
-that are implemented in OCaml, but not described in chapter \ref{c:refman}.
-
-
-%HEVEA\cutdef{section}
-\section{s:letrecvalues}{Recursive definitions of values}
-%HEVEA\cutname{letrecvalues.html}
-
-(Introduced in Objective Caml 1.00)
-
-As mentioned in section~\ref{sss:expr-localdef}, the @'let' 'rec'@ binding
-construct, in addition to the definition of recursive functions,
-also supports a certain class of recursive definitions of
-non-functional values, such as
-\begin{center}
-@"let" "rec" name_1 "=" "1" "::" name_2
-"and" name_2 "=" "2" "::" name_1
-"in" expr@
-\end{center}
-which binds @name_1@ to the cyclic list "1::2::1::2::"\ldots, and
-@name_2@ to the cyclic list "2::1::2::1::"\ldots
-Informally, the class of accepted definitions consists of those
-definitions where the defined names occur only inside function
-bodies or as argument to a data constructor.
-
-More precisely, consider the expression:
-\begin{center}
-@"let" "rec" name_1 "=" expr_1 "and" \ldots "and" name_n "=" expr_n "in" expr@
-\end{center}
-It will be accepted if each one of @expr_1 \ldots expr_n@ is
-statically constructive with respect to @name_1 \ldots name_n@,
-is not immediately linked to any of @name_1 \ldots name_n@,
-and is not an array constructor whose arguments have abstract type.
-
-An expression @@e@@ is said to be {\em statically constructive
-with respect to} the variables @name_1 \ldots name_n@ if at least
-one of the following conditions is true:
-\begin{itemize}
-\item @@e@@ has no free occurrence of any of @name_1 \ldots name_n@
-\item @@e@@ is a variable
-\item @@e@@ has the form @"fun" \ldots "->" \ldots@
-\item @@e@@ has the form @"function" \ldots "->" \ldots@
-\item @@e@@ has the form @"lazy" "(" \ldots ")"@
-\item @@e@@ has one of the following forms, where each one of
- @expr_1 \ldots expr_m@ is statically constructive with respect to
- @name_1 \ldots name_n@, and @expr_0@ is statically constructive with
- respect to @name_1 \ldots name_n, xname_1 \ldots xname_m@:
- \begin{itemize}
- \item @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
- "and" xname_m "=" expr_m "in" expr_0@
- \item @"let" "module" \ldots "in" expr_1@
- \item @constr "("expr_1"," \ldots "," expr_m")"@
- \item @"`"tag-name "("expr_1"," \ldots "," expr_m")"@
- \item @"[|" expr_1";" \ldots ";" expr_m "|]"@
- \item @"{" field_1 "=" expr_1";" \ldots ";" field_m = expr_m "}"@
- \item @"{" expr_1 "with" field_2 "=" expr_2";" \ldots ";"
- field_m = expr_m "}"@ where @expr_1@ is not immediately
- linked to @name_1 \ldots name_n@
- \item @"(" expr_1"," \ldots "," expr_m ")"@
- \item @expr_1";" \ldots ";" expr_m@
- \end{itemize}
-\end{itemize}
-
-An expression @@e@@ is said to be {\em immediately linked to} the variable
-@name@ in the following cases:
-\begin{itemize}
-\item @@e@@ is @name@
-\item @@e@@ has the form @expr_1";" \ldots ";" expr_m@ where @expr_m@
- is immediately linked to @name@
-\item @@e@@ has the form @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
- "and" xname_m "=" expr_m "in" expr_0@ where @expr_0@ is immediately
- linked to @name@ or to one of the @xname_i@ such that @expr_i@
- is immediately linked to @name@.
-\end{itemize}
-
-\section{s:recursive-modules}{Recursive modules}
-\ikwd{module\@\texttt{module}}
-\ikwd{and\@\texttt{and}}
-
-(Introduced in Objective Caml 3.07)
-
-% TODO: relaxed syntax
-
-\begin{syntax}
-definition:
- ...
- | 'module' 'rec' module-name ':' module-type '=' module-expr \\
- { 'and' module-name ':' module-type '=' module-expr }
-;
-specification:
- ...
- | 'module' 'rec' module-name ':' module-type
- { 'and' module-name':' module-type }
-\end{syntax}
-
-Recursive module definitions, introduced by the @"module rec"@ \ldots
-@"and"@ \ldots\ construction, generalize regular module definitions
-@'module' module-name '=' module-expr@ and module specifications
-@'module' module-name ':' module-type@ by allowing the defining
-@module-expr@ and the @module-type@ to refer recursively to the module
-identifiers being defined. A typical example of a recursive module
-definition is:
-\begin{caml_example*}{verbatim}
-module rec A : sig
- type t = Leaf of string | Node of ASet.t
- val compare: t -> t -> int
-end = struct
- type t = Leaf of string | Node of ASet.t
- let compare t1 t2 =
- match (t1, t2) with
- | (Leaf s1, Leaf s2) -> Stdlib.compare s1 s2
- | (Leaf _, Node _) -> 1
- | (Node _, Leaf _) -> -1
- | (Node n1, Node n2) -> ASet.compare n1 n2
-end
-and ASet
- : Set.S with type elt = A.t
- = Set.Make(A)
-\end{caml_example*}
-It can be given the following specification:
-\begin{caml_example*}{signature}
-module rec A : sig
- type t = Leaf of string | Node of ASet.t
- val compare: t -> t -> int
-end
-and ASet : Set.S with type elt = A.t
-\end{caml_example*}
-
-This is an experimental extension of OCaml: the class of
-recursive definitions accepted, as well as its dynamic semantics are
-not final and subject to change in future releases.
-
-Currently, the compiler requires that all dependency cycles between
-the recursively-defined module identifiers go through at least one
-``safe'' module. A module is ``safe'' if all value definitions that
-it contains have function types @typexpr_1 '->' typexpr_2@. Evaluation of a
-recursive module definition proceeds by building initial values for
-the safe modules involved, binding all (functional) values to
-@'fun' '_' '->' 'raise' @"Undefined_recursive_module". The defining
-module expressions are then evaluated, and the initial values
-for the safe modules are replaced by the values thus computed. If a
-function component of a safe module is applied during this computation
-(which corresponds to an ill-founded recursive definition), the
-"Undefined_recursive_module" exception is raised at runtime:
-
-\begin{caml_example}{verbatim}
-module rec M: sig val f: unit -> int end = struct let f () = N.x end
-and N:sig val x: int end = struct let x = M.f () end
-\end{caml_example}
-
-If there are no safe modules along a dependency cycle, an error is raised
-
-\begin{caml_example}{verbatim}[error]
-module rec M: sig val x: int end = struct let x = N.y end
-and N:sig val x: int val y:int end = struct let x = M.x let y = 0 end
-\end{caml_example}
-
-Note that, in the @specification@ case, the @module-type@s must be
-parenthesized if they use the @'with' mod-constraint@ construct.
-
-\section{s:private-types}{Private types}
-%HEVEA\cutname{privatetypes.html}
-\ikwd{private\@\texttt{private}}
-
-Private type declarations in module signatures, of the form
-"type t = private ...", enable libraries to
-reveal some, but not all aspects of the implementation of a type to
-clients of the library. In this respect, they strike a middle ground
-between abstract type declarations, where no information is revealed
-on the type implementation, and data type definitions and type
-abbreviations, where all aspects of the type implementation are
-publicized. Private type declarations come in three flavors: for
-variant and record types (section~\ref{ss:private-types-variant}),
-for type abbreviations (section~\ref{ss:private-types-abbrev}),
-and for row types (section~\ref{ss:private-rows}).
-
-\subsection{ss:private-types-variant}{Private variant and record types}
-
-
-(Introduced in Objective Caml 3.07)
-
-\begin{syntax}
-type-representation:
- ...
- | '=' 'private' [ '|' ] constr-decl { '|' constr-decl }
- | '=' 'private' record-decl
-\end{syntax}
-
-Values of a variant or record type declared @"private"@
-can be de-structured normally in pattern-matching or via
-the @expr '.' field@ notation for record accesses. However, values of
-these types cannot be constructed directly by constructor application
-or record construction. Moreover, assignment on a mutable field of a
-private record type is not allowed.
-
-The typical use of private types is in the export signature of a
-module, to ensure that construction of values of the private type always
-go through the functions provided by the module, while still allowing
-pattern-matching outside the defining module. For example:
-\begin{caml_example*}{verbatim}
-module M : sig
- type t = private A | B of int
- val a : t
- val b : int -> t
-end = struct
- type t = A | B of int
- let a = A
- let b n = assert (n > 0); B n
-end
-\end{caml_example*}
-Here, the @"private"@ declaration ensures that in any value of type
-"M.t", the argument to the "B" constructor is always a positive integer.
-
-With respect to the variance of their parameters, private types are
-handled like abstract types. That is, if a private type has
-parameters, their variance is the one explicitly given by prefixing
-the parameter by a `"+"' or a `"-"', it is invariant otherwise.
-
-\subsection{ss:private-types-abbrev}{Private type abbreviations}
-
-(Introduced in Objective Caml 3.11)
-
-\begin{syntax}
-type-equation:
- ...
- | '=' 'private' typexpr
-\end{syntax}
-
-Unlike a regular type abbreviation, a private type abbreviation
-declares a type that is distinct from its implementation type @typexpr@.
-However, coercions from the type to @typexpr@ are permitted.
-Moreover, the compiler ``knows'' the implementation type and can take
-advantage of this knowledge to perform type-directed optimizations.
-
-The following example uses a private type abbreviation to define a
-module of nonnegative integers:
-\begin{caml_example*}{verbatim}
-module N : sig
- type t = private int
- val of_int: int -> t
- val to_int: t -> int
-end = struct
- type t = int
- let of_int n = assert (n >= 0); n
- let to_int n = n
-end
-\end{caml_example*}
-The type "N.t" is incompatible with "int", ensuring that nonnegative
-integers and regular integers are not confused. However, if "x" has
-type "N.t", the coercion "(x :> int)" is legal and returns the
-underlying integer, just like "N.to_int x". Deep coercions are also
-supported: if "l" has type "N.t list", the coercion "(l :> int list)"
-returns the list of underlying integers, like "List.map N.to_int l"
-but without copying the list "l".
-
-Note that the coercion @"(" expr ":>" typexpr ")"@ is actually an abbreviated
-form,
-and will only work in presence of private abbreviations if neither the
-type of @expr@ nor @typexpr@ contain any type variables. If they do,
-you must use the full form @"(" expr ":" typexpr_1 ":>" typexpr_2 ")"@ where
-@typexpr_1@ is the expected type of @expr@. Concretely, this would be "(x :
-N.t :> int)" and "(l : N.t list :> int list)" for the above examples.
-
-\subsection{ss:private-rows}{Private row types}
-\ikwd{private\@\texttt{private}}
-
-(Introduced in Objective Caml 3.09)
-
-\begin{syntax}
-type-equation:
- ...
- | '=' 'private' typexpr
-\end{syntax}
-
-Private row types are type abbreviations where part of the
-structure of the type is left abstract. Concretely @typexpr@ in the
-above should denote either an object type or a polymorphic variant
-type, with some possibility of refinement left. If the private
-declaration is used in an interface, the corresponding implementation
-may either provide a ground instance, or a refined private type.
-\begin{caml_example*}{verbatim}
-module M : sig type c = private < x : int; .. > val o : c end =
-struct
- class c = object method x = 3 method y = 2 end
- let o = new c
-end
-\end{caml_example*}
-This declaration does more than hiding the "y" method, it also makes
-the type "c" incompatible with any other closed object type, meaning
-that only "o" will be of type "c". In that respect it behaves
-similarly to private record types. But private row types are
-more flexible with respect to incremental refinement. This feature can
-be used in combination with functors.
-\begin{caml_example*}{verbatim}
-module F(X : sig type c = private < x : int; .. > end) =
-struct
- let get_x (o : X.c) = o#x
-end
-module G(X : sig type c = private < x : int; y : int; .. > end) =
-struct
- include F(X)
- let get_y (o : X.c) = o#y
-end
-\end{caml_example*}
-
-A polymorphic variant type [t], for example
-\begin{caml_example*}{verbatim}
-type t = [ `A of int | `B of bool ]
-\end{caml_example*}
-can be refined in two ways. A definition [u] may add new field to [t],
-and the declaration
-\begin{caml_example*}{verbatim}
-type u = private [> t]
-\end{caml_example*}
-will keep those new fields abstract. Construction of values of type
-[u] is possible using the known variants of [t], but any
-pattern-matching will require a default case to handle the potential
-extra fields. Dually, a declaration [u] may restrict the fields of [t]
-through abstraction: the declaration
-\begin{caml_example*}{verbatim}
-type v = private [< t > `A]
-\end{caml_example*}
-corresponds to private variant types. One cannot create a value of the
-private type [v], except using the constructors that are explicitly
-listed as present, "(`A n)" in this example; yet, when
-patter-matching on a [v], one should assume that any of the
-constructors of [t] could be present.
-
-Similarly to abstract types, the variance of type parameters
-is not inferred, and must be given explicitly.
-
-\section{s:locally-abstract}{Locally abstract types}
-\ikwd{type\@\texttt{type}}
-\ikwd{fun\@\texttt{fun}}
-%HEVEA\cutname{locallyabstract.html}
-
-
-(Introduced in OCaml 3.12, short syntax added in 4.03)
-
-\begin{syntax}
-parameter:
- ...
- | '(' "type" {{typeconstr-name}} ')'
-\end{syntax}
-
-The expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ introduces a
-type constructor named @typeconstr-name@ which is considered abstract
-in the scope of the sub-expression, but then replaced by a fresh type
-variable. Note that contrary to what the syntax could suggest, the
-expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ itself does not
-suspend the evaluation of @expr@ as a regular abstraction would. The
-syntax has been chosen to fit nicely in the context of function
-declarations, where it is generally used. It is possible to freely mix
-regular function parameters with pseudo type parameters, as in:
-\begin{caml_example*}{verbatim}
-let f = fun (type t) (foo : t list) -> (assert false)[@ellipsis]
-\end{caml_example*}
-and even use the alternative syntax for declaring functions:
-\begin{caml_example*}{verbatim}
-let f (type t) (foo : t list) = (assert false)[@ellipsis]
-\end{caml_example*}
-If several locally abstract types need to be introduced, it is possible to use
-the syntax
-@"fun" '(' "type" typeconstr-name_1 \ldots typeconstr-name_n ')' "->" expr@
-as syntactic sugar for @"fun" '(' "type" typeconstr-name_1 ')' "->" \ldots "->"
-"fun" '(' "type" typeconstr-name_n ')' "->" expr@. For instance,
-\begin{caml_example*}{verbatim}
-let f = fun (type t u v) -> fun (foo : (t * u * v) list) -> (assert false)[@ellipsis]
-let f' (type t u v) (foo : (t * u * v) list) = (assert false)[@ellipsis]
-\end{caml_example}
-
-This construction is useful because the type constructors it introduces
-can be used in places where a type variable is not allowed. For
-instance, one can use it to define an exception in a local module
-within a polymorphic function.
-\begin{caml_example*}{verbatim}
-let f (type t) () =
- let module M = struct exception E of t end in
- (fun x -> M.E x), (function M.E x -> Some x | _ -> None)
-\end{caml_example*}
-
-Here is another example:
-\begin{caml_example*}{verbatim}
-let sort_uniq (type s) (cmp : s -> s -> int) =
- let module S = Set.Make(struct type t = s let compare = cmp end) in
- fun l ->
- S.elements (List.fold_right S.add l S.empty)
-\end{caml_example*}
-
-It is also extremely useful for first-class modules (see
-section~\ref{s:first-class-modules}) and generalized algebraic datatypes
-(GADTs: see section~\ref{s:gadts}).
-
-\lparagraph{p:polymorpic-locally-abstract}{Polymorphic syntax} (Introduced in OCaml 4.00)
-
-\begin{syntax}
-let-binding:
- ...
- | value-name ':' 'type' {{ typeconstr-name }} '.' typexpr '=' expr
-;
-class-field:
- ...
- | 'method' ['private'] method-name ':' 'type'
- {{ typeconstr-name }} '.' typexpr '=' expr
- | 'method!' ['private'] method-name ':' 'type'
- {{ typeconstr-name }} '.' typexpr '=' expr
-\end{syntax}
-
-The @"(type" typeconstr-name")"@ syntax construction by itself does not make
-polymorphic the type variable it introduces, but it can be combined
-with explicit polymorphic annotations where needed.
-The above rule is provided as syntactic sugar to make this easier:
-\begin{caml_example*}{verbatim}
-let rec f : type t1 t2. t1 * t2 list -> t1 = (assert false)[@ellipsis]
-\end{caml_example*}
-\noindent
-is automatically expanded into
-\begin{caml_example*}{verbatim}
-let rec f : 't1 't2. 't1 * 't2 list -> 't1 =
- fun (type t1) (type t2) -> ( (assert false)[@ellipsis] : t1 * t2 list -> t1)
-\end{caml_example*}
-This syntax can be very useful when defining recursive functions involving
-GADTs, see the section~\ref{s:gadts} for a more detailed explanation.
-
-The same feature is provided for method definitions.
-
-\section{s:first-class-modules}{First-class modules}
-\ikwd{module\@\texttt{module}}
-\ikwd{val\@\texttt{val}}
-\ikwd{with\@\texttt{with}}
-\ikwd{and\@\texttt{and}}
-%HEVEA\cutname{firstclassmodules.html}
-
-
-(Introduced in OCaml 3.12; pattern syntax and package type inference
-introduced in 4.00; structural comparison of package types introduced in 4.02.;
-fewer parens required starting from 4.05)
-
-\begin{syntax}
-typexpr:
- ...
- | '(''module' package-type')'
-;
-module-expr:
- ...
- | '(''val' expr [':' package-type]')'
-;
-expr:
- ...
- | '(''module' module-expr [':' package-type]')'
-;
-pattern:
- ...
- | '(''module' module-name [':' package-type]')'
-;
-package-type:
- modtype-path
- | modtype-path 'with' package-constraint { 'and' package-constraint }
-;
-package-constraint:
- 'type' typeconstr '=' typexpr
-;
-\end{syntax}
-
-Modules are typically thought of as static components. This extension
-makes it possible to pack a module as a first-class value, which can
-later be dynamically unpacked into a module.
-
-The expression @'(' 'module' module-expr ':' package-type ')'@ converts the
-module (structure or functor) denoted by module expression @module-expr@
-to a value of the core language that encapsulates this module. The
-type of this core language value is @'(' 'module' package-type ')'@.
-The @package-type@ annotation can be omitted if it can be inferred
-from the context.
-
-Conversely, the module expression @'(' 'val' expr ':' package-type ')'@
-evaluates the core language expression @expr@ to a value, which must
-have type @'module' package-type@, and extracts the module that was
-encapsulated in this value. Again @package-type@ can be omitted if the
-type of @expr@ is known.
-If the module expression is already parenthesized, like the arguments
-of functors are, no additional parens are needed: "Map.Make(val key)".
-
-The pattern @'(' 'module' module-name ':' package-type ')'@ matches a
-package with type @package-type@ and binds it to @module-name@.
-It is not allowed in toplevel let bindings.
-Again @package-type@ can be omitted if it can be inferred from the
-enclosing pattern.
-
-The @package-type@ syntactic class appearing in the @'(' 'module'
-package-type ')'@ type expression and in the annotated forms represents a
-subset of module types.
-This subset consists of named module types with optional constraints
-of a limited form: only non-parametrized types can be specified.
-
-For type-checking purposes (and starting from OCaml 4.02), package types
-are compared using the structural comparison of module types.
-
-In general, the module expression @'(' "val" expr ":" package-type
-')'@ cannot be used in the body of a functor, because this could cause
-unsoundness in conjunction with applicative functors.
-Since OCaml 4.02, this is relaxed in two ways:
-if @package-type@ does not contain nominal type declarations ({\em
- i.e.} types that are created with a proper identity), then this
-expression can be used anywhere, and even if it contains such types
-it can be used inside the body of a generative
-functor, described in section~\ref{s:generative-functors}.
-It can also be used anywhere in the context of a local module binding
-@'let' 'module' module-name '=' '(' "val" expr_1 ":" package-type ')'
- "in" expr_2@.
-
-\lparagraph{p:fst-mod-example}{Basic example} A typical use of first-class modules is to
-select at run-time among several implementations of a signature.
-Each implementation is a structure that we can encapsulate as a
-first-class module, then store in a data structure such as a hash
-table:
-\begin{caml_example*}{verbatim}
-type picture = unit[@ellipsis]
-module type DEVICE = sig
- val draw : picture -> unit
- [@@@ellipsis]
-end
-let devices : (string, (module DEVICE)) Hashtbl.t = Hashtbl.create 17
-
-module SVG = struct let draw () = () [@@ellipsis] end
-let _ = Hashtbl.add devices "SVG" (module SVG : DEVICE)
-
-module PDF = struct let draw () = () [@@ellipsis] end
-let _ = Hashtbl.add devices "PDF" (module PDF : DEVICE)
-\end{caml_example*}
-
-We can then select one implementation based on command-line
-arguments, for instance:
-\begin{caml_example*}{verbatim}
-let parse_cmdline () = "SVG"[@ellipsis]
-module Device =
- (val (let device_name = parse_cmdline () in
- try Hashtbl.find devices device_name
- with Not_found ->
- Printf.eprintf "Unknown device %s\n" device_name;
- exit 2)
- : DEVICE)
-\end{caml_example*}
-Alternatively, the selection can be performed within a function:
-\begin{caml_example*}{verbatim}
-let draw_using_device device_name picture =
- let module Device =
- (val (Hashtbl.find devices device_name) : DEVICE)
- in
- Device.draw picture
-\end{caml_example*}
-
-\lparagraph{p:fst-mod-advexamples}{Advanced examples}
-With first-class modules, it is possible to parametrize some code over the
-implementation of a module without using a functor.
-
-\begin{caml_example}{verbatim}
-let sort (type s) (module Set : Set.S with type elt = s) l =
- Set.elements (List.fold_right Set.add l Set.empty)
-\end{caml_example}
-
-To use this function, one can wrap the "Set.Make" functor:
-
-\begin{caml_example}{verbatim}
-let make_set (type s) cmp =
- let module S = Set.Make(struct
- type t = s
- let compare = cmp
- end) in
- (module S : Set.S with type elt = s)
-\end{caml_example}
-
-\iffalse
-Another advanced use of first-class module is to encode existential
-types. In particular, they can be used to simulate generalized
-algebraic data types (GADT). To demonstrate this, we first define a type
-of witnesses for type equalities:
-
-\begin{caml_example*}{verbatim}
-module TypEq : sig
- type ('a, 'b) t
- val apply: ('a, 'b) t -> 'a -> 'b
- val refl: ('a, 'a) t
- val sym: ('a, 'b) t -> ('b, 'a) t
-end = struct
- type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
- let refl = (fun x -> x), (fun x -> x)
- let apply (f, _) x = f x
- let sym (f, g) = (g, f)
-end
-\end{caml_example*}
-
-We can then define a parametrized algebraic data type whose
-constructors provide some information about the type parameter:
-
-\begin{caml_example*}{verbatim}
-module rec Typ : sig
- module type PAIR = sig
- type t and t1 and t2
- val eq: (t, t1 * t2) TypEq.t
- val t1: t1 Typ.typ
- val t2: t2 Typ.typ
- end
-
- type 'a typ =
- | Int of ('a, int) TypEq.t
- | String of ('a, string) TypEq.t
- | Pair of (module PAIR with type t = 'a)
-end = Typ
-\end{caml_example*}
-
-Values of type "'a typ" are supposed to be runtime representations for
-the type "'a". The constructors "Int" and "String" are easy: they
-directly give a witness of type equality between the parameter "'a"
-and the ground types "int" (resp. "string"). The constructor "Pair" is
-more complex. One wants to give a witness of type equality between
-"'a" and a type of the form "t1 * t2" together with the representations
-for "t1" and "t2". However, these two types are unknown. The code above
-shows how to use first-class modules to simulate existentials.
-
-Here is how to construct values of type "'a typ":
-
-\begin{caml_example*}{verbatim}
-let int = Typ.Int TypEq.refl
-
-let str = Typ.String TypEq.refl
-
-let pair (type s1) (type s2) t1 t2 =
- let module P = struct
- type t = s1 * s2
- type t1 = s1
- type t2 = s2
- let eq = TypEq.refl
- let t1 = t1
- let t2 = t2
- end in
- let pair = (module P : Typ.PAIR with type t = s1 * s2) in
- Typ.Pair pair
-\end{caml_example*}
-
-And finally, here is an example of a polymorphic function that takes the
-runtime representation of some type "'a" and a value of the same type,
-then pretty-prints the value into a string:
-
-\begin{caml_example*}{verbatim}
-open Typ
-let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
- fun (type s) t x ->
- match t with
- | Int eq -> Int.to_string (TypEq.apply eq x)
- | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
- | Pair p ->
- let module P = (val p : PAIR with type t = s) in
- let (x1, x2) = TypEq.apply P.eq x in
- Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
-\end{caml_example*}
-
-Note that this function uses an explicit polymorphic annotation to obtain
-polymorphic recursion.
-\fi
-
-\section{s:module-type-of}{Recovering the type of a module}
-%HEVEA\cutname{moduletypeof.html}
-
-\ikwd{module\@\texttt{module}}
-\ikwd{type\@\texttt{type}}
-\ikwd{of\@\texttt{of}}
-\ikwd{include\@\texttt{include}}
-
-(Introduced in OCaml 3.12)
-
-\begin{syntax}
-module-type:
- ...
- | 'module' 'type' 'of' module-expr
-\end{syntax}
-
-The construction @'module' 'type' 'of' module-expr@ expands to the module type
-(signature or functor type) inferred for the module expression @module-expr@.
-To make this module type reusable in many situations, it is
-intentionally not strengthened: abstract types and datatypes are not
-explicitly related with the types of the original module.
-For the same reason, module aliases in the inferred type are expanded.
-
-A typical use, in conjunction with the signature-level @'include'@
-construct, is to extend the signature of an existing structure.
-In that case, one wants to keep the types equal to types in the
-original module. This can done using the following idiom.
-\begin{caml_example*}{verbatim}
-module type MYHASH = sig
- include module type of struct include Hashtbl end
- val replace: ('a, 'b) t -> 'a -> 'b -> unit
-end
-\end{caml_example*}
-The signature "MYHASH" then contains all the fields of the signature
-of the module "Hashtbl" (with strengthened type definitions), plus the
-new field "replace". An implementation of this signature can be
-obtained easily by using the @'include'@ construct again, but this
-time at the structure level:
-\begin{caml_example*}{verbatim}
-module MyHash : MYHASH = struct
- include Hashtbl
- let replace t k v = remove t k; add t k v
-end
-\end{caml_example*}
-
-Another application where the absence of strengthening comes handy, is
-to provide an alternative implementation for an existing module.
-\begin{caml_example*}{verbatim}
-module MySet : module type of Set = struct
- include Set[@@ellipsis]
-end
-\end{caml_example*}
-This idiom guarantees that "Myset" is compatible with Set, but allows
-it to represent sets internally in a different way.
-
-\section{s:signature-substitution}{Substituting inside a signature}
-\ikwd{with\@\texttt{with}}
-\ikwd{module\@\texttt{module}}
-\ikwd{type\@\texttt{type}}
-%HEVEA\cutname{signaturesubstitution.html}
-
-
-\subsection{ss:destructive-substitution}{Destructive substitutions}
-
-(Introduced in OCaml 3.12, generalized in 4.06)
-
-\begin{syntax}
-mod-constraint:
- ...
- | 'type' [type-params] typeconstr-name ':=' typexpr
- | 'module' module-path ':=' extended-module-path
-\end{syntax}
-
-A ``destructive'' substitution (@'with' ... ':=' ...@) behaves essentially like
-normal signature constraints (@'with' ... '=' ...@), but it additionally removes
-the redefined type or module from the signature.
-
-Prior to OCaml 4.06, there were a number of restrictions: one could only remove
-types and modules at the outermost level (not inside submodules), and in the
-case of @'with type'@ the definition had to be another type constructor with the
-same type parameters.
-
-A natural application of destructive substitution is merging two
-signatures sharing a type name.
-\begin{caml_example*}{verbatim}
-module type Printable = sig
- type t
- val print : Format.formatter -> t -> unit
-end
-module type Comparable = sig
- type t
- val compare : t -> t -> int
-end
-module type PrintableComparable = sig
- include Printable
- include Comparable with type t := t
-end
-\end{caml_example*}
-
-One can also use this to completely remove a field:
-\begin{caml_example}{verbatim}
-module type S = Comparable with type t := int
-\end{caml_example}
-or to rename one:
-\begin{caml_example}{verbatim}
-module type S = sig
- type u
- include Comparable with type t := u
-end
-\end{caml_example}
-
-Note that you can also remove manifest types, by substituting with the
-same type.
-\begin{caml_example}{verbatim}
-module type ComparableInt = Comparable with type t = int ;;
-module type CompareInt = ComparableInt with type t := int
-\end{caml_example}
-
-\subsection{ss:local-substitution}{Local substitution declarations}
-
-(Introduced in OCaml 4.08)
-
-\begin{syntax}
-specification:
- ...
- | 'type' type-subst { 'and' type-subst }
- | 'module' module-name ':=' extended-module-path
-;
-
-type-subst:
- [type-params] typeconstr-name ':=' typexpr { type-constraint }
-\end{syntax}
-
-
-Local substitutions behave like destructive substitutions (@'with' ... ':=' ...@)
-but instead of being applied to a whole signature after the fact, they are
-introduced during the specification of the signature, and will apply to all the
-items that follow.
-
-This provides a convenient way to introduce local names for types and modules
-when defining a signature:
-
-\begin{caml_example}{verbatim}
-module type S = sig
- type t
- module Sub : sig
- type outer := t
- type t
- val to_outer : t -> outer
- end
-end
-\end{caml_example}
-
-Note that, unlike type declarations, type substitution declarations are not
-recursive, so substitutions like the following are rejected:
-
-\begin{caml_example}{toplevel}
-module type S = sig
- type 'a poly_list := [ `Cons of 'a * 'a poly_list | `Nil ]
-end [@@expect error];;
-\end{caml_example}
-
-\section{s:module-alias}{Type-level module aliases}
-\ikwd{module\@\texttt{module}}
-%HEVEA\cutname{modulealias.html}
-
-(Introduced in OCaml 4.02)
-
-\begin{syntax}
-specification:
- ...
- | 'module' module-name '=' module-path
-\end{syntax}
-
-The above specification, inside a signature, only matches a module
-definition equal to @module-path@. Conversely, a type-level module
-alias can be matched by itself, or by any supertype of the type of the
-module it references.
-
-There are several restrictions on @module-path@:
-\begin{enumerate}
-\item it should be of the form \(M_0.M_1...M_n\) ({\em i.e.} without
- functor applications);
-\item inside the body of a functor, \(M_0\) should not be one of the
- functor parameters;
-\item inside a recursive module definition, \(M_0\) should not be one of
- the recursively defined modules.
-\end{enumerate}
-
-Such specifications are also inferred. Namely, when @P@ is a path
-satisfying the above constraints,
-\begin{caml_eval}
-module P = struct end
-\end{caml_eval}
-\begin{caml_example*}{verbatim}
-module N = P
-\end{caml_example*}
-has type
-\begin{caml_example*}{signature}
-module N = P
-\end{caml_example*}
-
-Type-level module aliases are used when checking module path
-equalities. That is, in a context where module name @N@ is known to be
-an alias for @P@, not only these two module paths check as equal, but
-@F(N)@ and @F(P)@ are also recognized as equal. In the default
-compilation mode, this is the only difference with the previous
-approach of module aliases having just the same module type as the
-module they reference.
-
-When the compiler flag @'-no-alias-deps'@ is enabled, type-level
-module aliases are also exploited to avoid introducing dependencies
-between compilation units. Namely, a module alias referring to a
-module inside another compilation unit does not introduce a link-time
-dependency on that compilation unit, as long as it is not
-dereferenced; it still introduces a compile-time dependency if the
-interface needs to be read, {\em i.e.} if the module is a submodule
-of the compilation unit, or if some type components are referred to.
-Additionally, accessing a module alias introduces a link-time
-dependency on the compilation unit containing the module referenced by
-the alias, rather than the compilation unit containing the alias.
-Note that these differences in link-time behavior may be incompatible
-with the previous behavior, as some compilation units might not be
-extracted from libraries, and their side-effects ignored.
-
-These weakened dependencies make possible to use module aliases in
-place of the @'-pack'@ mechanism. Suppose that you have a library
-@'Mylib'@ composed of modules @'A'@ and @'B'@. Using @'-pack'@, one
-would issue the command line
-\begin{verbatim}
-ocamlc -pack a.cmo b.cmo -o mylib.cmo
-\end{verbatim}
-and as a result obtain a @'Mylib'@ compilation unit, containing
-physically @'A'@ and @'B'@ as submodules, and with no dependencies on
-their respective compilation units.
-Here is a concrete example of a possible alternative approach:
-\begin{enumerate}
-\item Rename the files containing @'A'@ and @'B'@ to @'Mylib__A'@ and
- @'Mylib__B'@.
-\item Create a packing interface @'Mylib.ml'@, containing the
- following lines.
-\begin{verbatim}
-module A = Mylib__A
-module B = Mylib__B
-\end{verbatim}
-\item Compile @'Mylib.ml'@ using @'-no-alias-deps'@, and the other
- files using @'-no-alias-deps'@ and @'-open' 'Mylib'@ (the last one is
- equivalent to adding the line @'open!' 'Mylib'@ at the top of each
- file).
-\begin{verbatim}
-ocamlc -c -no-alias-deps Mylib.ml
-ocamlc -c -no-alias-deps -open Mylib Mylib__*.mli Mylib__*.ml
-\end{verbatim}
-\item Finally, create a library containing all the compilation units,
- and export all the compiled interfaces.
-\begin{verbatim}
-ocamlc -a Mylib*.cmo -o Mylib.cma
-\end{verbatim}
-\end{enumerate}
-This approach lets you access @'A'@ and @'B'@ directly inside the
-library, and as @'Mylib.A'@ and @'Mylib.B'@ from outside.
-It also has the advantage that @'Mylib'@ is no longer monolithic: if
-you use @'Mylib.A'@, only @'Mylib__A'@ will be linked in, not
-@'Mylib__B'@.
-%Note that in the above @'Mylib.cmo'@ is actually empty, and one could
-%name the interface @'Mylib.mli'@, but this would require that all
-%clients are compiled with the @'-no-alias-deps'@ flag.
-
-Note the use of double underscores in @'Mylib__A'@ and
-@'Mylib__B'@. These were chosen on purpose; the compiler uses the
-following heuristic when printing paths: given a path @'Lib__fooBar'@,
-if @'Lib.FooBar'@ exists and is an alias for @'Lib__fooBar'@, then the
-compiler will always display @'Lib.FooBar'@ instead of
-@'Lib__fooBar'@. This way the long @'Mylib__'@ names stay hidden and
-all the user sees is the nicer dot names. This is how the OCaml
-standard library is compiled.
-
-\section{s:explicit-overriding-open}{Overriding in open statements}
-\ikwd{open.\@\texttt{open\char33}}
-%HEVEA\cutname{overridingopen.html}
-
-(Introduced in OCaml 4.01)
-
-\begin{syntax}
-definition:
- ...
- | 'open!' module-path
-;
-specification:
- ...
- | 'open!' module-path
-;
-expr:
- ...
- | 'let' 'open!' module-path 'in' expr
-;
-class-body-type:
- ...
- | 'let' 'open!' module-path 'in' class-body-type
-;
-class-expr:
- ...
- | 'let' 'open!' module-path 'in' class-expr
-;
-\end{syntax}
-
-Since OCaml 4.01, @"open"@ statements shadowing an existing identifier
-(which is later used) trigger the warning 44. Adding a @"!"@
-character after the @"open"@ keyword indicates that such a shadowing is
-intentional and should not trigger the warning.
-
-This is also available (since OCaml 4.06) for local opens in class
-expressions and class type expressions.
-
-\section{s:gadts}{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}}
-\ikwd{match\@\texttt{match}}
-%HEVEA\cutname{gadts.html}
-
-
-(Introduced in OCaml 4.00)
-
-\begin{syntax}
-constr-decl:
- ...
- | constr-name ':' [ constr-args '->' ] typexpr
-;
-type-param:
- ...
- | [variance] '_'
-\end{syntax}
-
-Generalized algebraic datatypes, or GADTs, extend usual sum types in
-two ways: constraints on type parameters may change depending on the
-value constructor, and some type variables may be existentially
-quantified.
-Adding constraints is done by giving an explicit return type
-(the rightmost @typexpr@ in the above syntax), where type parameters
-are instantiated.
-This return type must use the same type constructor as the type being
-defined, and have the same number of parameters.
-Variables are made existential when they appear inside a constructor's
-argument, but not in its return type.
-
-Since the use of a return type often eliminates the need to name type
-parameters in the left-hand side of a type definition, one can replace
-them with anonymous types @"_"@ in that case.
-
-The constraints associated to each constructor can be recovered
-through pattern-matching.
-Namely, if the type of the scrutinee of a pattern-matching contains
-a locally abstract type, this type can be refined according to the
-constructor used.
-These extra constraints are only valid inside the corresponding branch
-of the pattern-matching.
-If a constructor has some existential variables, fresh locally
-abstract types are generated, and they must not escape the
-scope of this branch.
-
-\lparagraph{p:gadts-recfun}{Recursive functions}
-
-Here is a concrete example:
-\begin{caml_example*}{verbatim}
-type _ term =
- | Int : int -> int term
- | Add : (int -> int -> int) term
- | App : ('b -> 'a) term * 'b term -> 'a term
-
-let rec eval : type a. a term -> a = function
- | Int n -> n (* a = int *)
- | Add -> (fun x y -> x+y) (* a = int -> int -> int *)
- | App(f,x) -> (eval f) (eval x)
- (* eval called at types (b->a) and b for fresh b *)
-\end{caml_example*}
-\begin{caml_example}{verbatim}
-let two = eval (App (App (Add, Int 1), Int 1))
-\end{caml_example}
-It is important to remark that the function "eval" is using the
-polymorphic syntax for locally abstract types. When defining a recursive
-function that manipulates a GADT, explicit polymorphic recursion should
-generally be used. For instance, the following definition fails with a
-type error:
-\begin{caml_example}{verbatim}[error]
-let rec eval (type a) : a term -> a = function
- | Int n -> n
- | Add -> (fun x y -> x+y)
- | App(f,x) -> (eval f) (eval x)
-\end{caml_example}
-In absence of an explicit polymorphic annotation, a monomorphic type
-is inferred for the recursive function. If a recursive call occurs
-inside the function definition at a type that involves an existential
-GADT type variable, this variable flows to the type of the recursive
-function, and thus escapes its scope. In the above example, this happens
-in the branch "App(f,x)" when "eval" is called with "f" as an argument.
-In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in
-"$App_ 'b" denotes an existential type named by the compiler
-(see~\ref{p:existential-names}). Since the type of "eval" is
-"'a term -> 'a", the call "eval f" makes the existential type "$App_'b"
-flow to the type variable "'a" and escape its scope. This triggers the
-above error.
-
-\lparagraph{p:gadts-type-inference}{Type inference}
-
-Type inference for GADTs is notoriously hard.
-This is due to the fact some types may become ambiguous when escaping
-from a branch.
-For instance, in the "Int" case above, "n" could have either type "int"
-or "a", and they are not equivalent outside of that branch.
-As a first approximation, type inference will always work if a
-pattern-matching is annotated with types containing no free type
-variables (both on the scrutinee and the return type).
-This is the case in the above example, thanks to the type annotation
-containing only locally abstract types.
-
-In practice, type inference is a bit more clever than that: type
-annotations do not need to be immediately on the pattern-matching, and
-the types do not have to be always closed.
-As a result, it is usually enough to only annotate functions, as in
-the example above. Type annotations are
-propagated in two ways: for the scrutinee, they follow the flow of
-type inference, in a way similar to polymorphic methods; for the
-return type, they follow the structure of the program, they are split
-on functions, propagated to all branches of a pattern matching,
-and go through tuples, records, and sum types.
-Moreover, the notion of ambiguity used is stronger: a type is only
-seen as ambiguous if it was mixed with incompatible types (equated by
-constraints), without type annotations between them.
-For instance, the following program types correctly.
-\begin{caml_example}{verbatim}
-let rec sum : type a. a term -> _ = fun x ->
- let y =
- match x with
- | Int n -> n
- | Add -> 0
- | App(f,x) -> sum f + sum x
- in y + 1
-\end{caml_example}
-Here the return type "int" is never mixed with "a", so it is seen as
-non-ambiguous, and can be inferred.
-When using such partial type annotations we strongly suggest
-specifying the "-principal" mode, to check that inference is
-principal.
-
-The exhaustiveness check is aware of GADT constraints, and can
-automatically infer that some cases cannot happen.
-For instance, the following pattern matching is correctly seen as
-exhaustive (the "Add" case cannot happen).
-\begin{caml_example*}{verbatim}
-let get_int : int term -> int = function
- | Int n -> n
- | App(_,_) -> 0
-\end{caml_example*}
-
-
-\lparagraph{p:gadt-refutation-cases}{Refutation cases} (Introduced in OCaml 4.03)
-
-Usually, the exhaustiveness check only tries to check whether the
-cases omitted from the pattern matching are typable or not.
-However, you can force it to try harder by adding {\em refutation cases}:
-\begin{syntax}
-matching-case:
- pattern ['when' expr] '->' expr
- | pattern '->' '.'
-\end{syntax}
-In presence of a refutation case, the exhaustiveness check will first
-compute the intersection of the pattern with the complement of the
-cases preceding it. It then checks whether the resulting patterns can
-really match any concrete values by trying to type-check them.
-Wild cards in the generated patterns are handled in a special way: if
-their type is a variant type with only GADT constructors, then the
-pattern is split into the different constructors, in order to check whether
-any of them is possible (this splitting is not done for arguments of these
-constructors, to avoid non-termination). We also split tuples and
-variant types with only one case, since they may contain GADTs inside.
-For instance, the following code is deemed exhaustive:
-
-\begin{caml_example*}{verbatim}
-type _ t =
- | Int : int t
- | Bool : bool t
-
-let deep : (char t * int) option -> char = function
- | None -> 'c'
- | _ -> .
-\end{caml_example*}
-
-Namely, the inferred remaining case is "Some _", which is split into
-"Some (Int, _)" and "Some (Bool, _)", which are both untypable because
-"deep" expects a non-existing "char t" as the first element of the tuple.
-Note that the refutation case could be omitted here, because it is
-automatically added when there is only one case in the pattern
-matching.
-
-Another addition is that the redundancy check is now aware of GADTs: a
-case will be detected as redundant if it could be replaced by a
-refutation case using the same pattern.
-
-\lparagraph{p:gadts-advexamples}{Advanced examples}
-The "term" type we have defined above is an {\em indexed} type, where
-a type parameter reflects a property of the value contents.
-Another use of GADTs is {\em singleton} types, where a GADT value
-represents exactly one type. This value can be used as runtime
-representation for this type, and a function receiving it can have a
-polytypic behavior.
-
-Here is an example of a polymorphic function that takes the
-runtime representation of some type "t" and a value of the same type,
-then pretty-prints the value as a string:
-\begin{caml_example*}{verbatim}
-type _ typ =
- | Int : int typ
- | String : string typ
- | Pair : 'a typ * 'b typ -> ('a * 'b) typ
-
-let rec to_string: type t. t typ -> t -> string =
- fun t x ->
- match t with
- | Int -> Int.to_string x
- | String -> Printf.sprintf "%S" x
- | Pair(t1,t2) ->
- let (x1, x2) = x in
- Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2)
-\end{caml_example*}
-
-Another frequent application of GADTs is equality witnesses.
-\begin{caml_example*}{verbatim}
-type (_,_) eq = Eq : ('a,'a) eq
-
-let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x
-\end{caml_example*}
-Here type "eq" has only one constructor, and by matching on it one
-adds a local constraint allowing the conversion between "a" and "b".
-By building such equality witnesses, one can make equal types which
-are syntactically different.
-
-Here is an example using both singleton types and equality witnesses
-to implement dynamic types.
-\begin{caml_example*}{verbatim}
-let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =
- fun a b ->
- match a, b with
- | Int, Int -> Some Eq
- | String, String -> Some Eq
- | Pair(a1,a2), Pair(b1,b2) ->
- begin match eq_type a1 b1, eq_type a2 b2 with
- | Some Eq, Some Eq -> Some Eq
- | _ -> None
- end
- | _ -> None
-
-type dyn = Dyn : 'a typ * 'a -> dyn
-
-let get_dyn : type a. a typ -> dyn -> a option =
- fun a (Dyn(b,x)) ->
- match eq_type a b with
- | None -> None
- | Some Eq -> Some x
-\end{caml_example*}
-
-\lparagraph{p:existential-names}{Existential type names in error messages}%
-(Updated in OCaml 4.03.0)
-
-The typing of pattern matching in presence of GADT can generate many
-existential types. When necessary, error messages refer to these
-existential types using compiler-generated names. Currently, the
-compiler generates these names according to the following nomenclature:
-\begin{itemize}
-\item First, types whose name starts with a "$" are existentials.
-\item "$Constr_'a" denotes an existential type introduced for the type
-variable "'a" of the GADT constructor "Constr":
-\begin{caml_example}{verbatim}[error]
-type any = Any : 'name -> any
-let escape (Any x) = x
-\end{caml_example}
-\item "$Constr" denotes an existential type introduced for an anonymous %$
-type variable in the GADT constructor "Constr":
-\begin{caml_example}{verbatim}[error]
-type any = Any : _ -> any
-let escape (Any x) = x
-\end{caml_example}
-\item "$'a" if the existential variable was unified with the type %$
-variable "'a" during typing:
-\begin{caml_example}{verbatim}[error]
-type ('arg,'result,'aux) fn =
- | Fun: ('a ->'b) -> ('a,'b,unit) fn
- | Mem1: ('a ->'b) * 'a * 'b -> ('a, 'b, 'a * 'b) fn
- let apply: ('arg,'result, _ ) fn -> 'arg -> 'result = fun f x ->
- match f with
- | Fun f -> f x
- | Mem1 (f,y,fy) -> if x = y then fy else f x
-\end{caml_example}
-\item "$n" (n a number) is an internally generated existential %$
-which could not be named using one of the previous schemes.
-\end{itemize}
-
-As shown by the last item, the current behavior is imperfect
-and may be improved in future versions.
-
-\lparagraph{p:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types} (Introduced in OCaml
-4.04)
-
-GADT pattern-matching may also add type equations to non-local
-abstract types. The behaviour is the same as with local abstract
-types. Reusing the above "eq" type, one can write:
-\begin{caml_example*}{verbatim}
-module M : sig type t val x : t val e : (t,int) eq end = struct
- type t = int
- let x = 33
- let e = Eq
-end
-
-let x : int = let Eq = M.e in M.x
-\end{caml_example*}
-
-Of course, not all abstract types can be refined, as this would
-contradict the exhaustiveness check. Namely, builtin types (those
-defined by the compiler itself, such as "int" or "array"), and
-abstract types defined by the local module, are non-instantiable, and
-as such cause a type error rather than introduce an equation.
-
-\section{s:bigarray-access}{Syntax for Bigarray access}
-%HEVEA\cutname{bigarray.html}
-
-(Introduced in Objective Caml 3.00)
-
-\begin{syntax}
-expr:
- ...
- | expr '.{' expr { ',' expr } '}'
- | expr '.{' expr { ',' expr } '}' '<-' expr
-\end{syntax}
-
-This extension provides syntactic sugar for getting and setting
-elements in the arrays provided by the \stdmoduleref{Bigarray} module.
-
-The short expressions are translated into calls to functions of the
-"Bigarray" module as described in the following table.
-
-\begin{tableau}{|l|l|}{expression}{translation}
-\entree{@expr_0'.{'expr_1'}'@}
- {"Bigarray.Array1.get "@expr_0 expr_1@}
-\entree{@expr_0'.{'expr_1'}' '<-'expr@}
- {"Bigarray.Array1.set "@expr_0 expr_1 expr@}
-\entree{@expr_0'.{'expr_1',' expr_2'}'@}
- {"Bigarray.Array2.get "@expr_0 expr_1 expr_2@}
-\entree{@expr_0'.{'expr_1',' expr_2'}' '<-'expr@}
- {"Bigarray.Array2.set "@expr_0 expr_1 expr_2 expr@}
-\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}'@}
- {"Bigarray.Array3.get "@expr_0 expr_1 expr_2 expr_3@}
-\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}' '<-'expr@}
- {"Bigarray.Array3.set "@expr_0 expr_1 expr_2 expr_3 expr@}
-\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}'@}
- {"Bigarray.Genarray.get "@ expr_0 '[|' expr_1',' \ldots ','
- expr_n '|]'@}
-\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}' '<-'expr@}
- {"Bigarray.Genarray.set "@ expr_0 '[|' expr_1',' \ldots ','
- expr_n '|]' expr@}
-\end{tableau}
-
-The last two entries are valid for any $n > 3$.
-
-\section{s:attributes}{Attributes}
-%HEVEA\cutname{attributes.html}
-
-\ikwd{when\@\texttt{when}}
-
-(Introduced in OCaml 4.02,
-infix notations for constructs other than expressions added in 4.03)
-
-Attributes are ``decorations'' of the syntax tree which are mostly
-ignored by the type-checker but can be used by external tools. An
-attribute is made of an identifier and a payload, which can be a
-structure, a type expression (prefixed with ":"), a signature
-(prefixed with ":") or a pattern (prefixed with "?") optionally
-followed by a "when" clause:
-
-
-\begin{syntax}
-attr-id:
- lowercase-ident
- | capitalized-ident
- | attr-id '.' attr-id
-;
-attr-payload:
- [ module-items ]
- | ':' typexpr
- | ':' [ specification ]
- | '?' pattern ['when' expr]
-;
-\end{syntax}
-
-The first form of attributes is attached with a postfix notation on
-``algebraic'' categories:
-
-\begin{syntax}
-attribute:
- '[@' attr-id attr-payload ']'
-;
-expr: ...
- | expr attribute
-;
-typexpr: ...
- | typexpr attribute
-;
-pattern: ...
- | pattern attribute
-;
-module-expr: ...
- | module-expr attribute
-;
-module-type: ...
- | module-type attribute
-;
-class-expr: ...
- | class-expr attribute
-;
-class-type: ...
- | class-type attribute
-;
-\end{syntax}
-
-This form of attributes can also be inserted after the @'`'tag-name@
-in polymorphic variant type expressions (@tag-spec-first@, @tag-spec@,
-@tag-spec-full@) or after the @method-name@ in @method-type@.
-
-The same syntactic form is also used to attach attributes to labels and
-constructors in type declarations:
-
-\begin{syntax}
-field-decl:
- ['mutable'] field-name ':' poly-typexpr {attribute}
-;
-constr-decl:
- (constr-name || '()') [ 'of' constr-args ] {attribute}
-;
-\end{syntax}
-
-Note: when a label declaration is followed by a semi-colon, attributes
-can also be put after the semi-colon (in which case they are merged to
-those specified before).
-
-
-The second form of attributes are attached to ``blocks'' such as type
-declarations, class fields, etc:
-
-\begin{syntax}
-item-attribute:
- '[@@' attr-id attr-payload ']'
-;
-typedef: ...
- | typedef item-attribute
-;
-exception-definition:
- 'exception' constr-decl
- | 'exception' constr-name '=' constr
-;
-module-items:
- [';;'] ( definition || expr { item-attribute } ) { [';;'] definition || ';;' expr { item-attribute } } [';;']
-;
-class-binding: ...
- | class-binding item-attribute
-;
-class-spec: ...
- | class-spec item-attribute
-;
-classtype-def: ...
- | classtype-def item-attribute
-;
-definition:
- 'let' ['rec'] let-binding { 'and' let-binding }
- | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
- | type-definition
- | exception-definition { item-attribute }
- | class-definition
- | classtype-definition
- | 'module' module-name { '(' module-name ':' module-type ')' }
- [ ':' module-type ] \\ '=' module-expr { item-attribute }
- | 'module' 'type' modtype-name '=' module-type { item-attribute }
- | 'open' module-path { item-attribute }
- | 'include' module-expr { item-attribute }
- | 'module' 'rec' module-name ':' module-type '=' \\
- module-expr { item-attribute } \\
- { 'and' module-name ':' module-type '=' module-expr \\
- { item-attribute } }
-;
-specification:
- 'val' value-name ':' typexpr { item-attribute }
- | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
- | type-definition
- | 'exception' constr-decl { item-attribute }
- | class-specification
- | classtype-definition
- | 'module' module-name ':' module-type { item-attribute }
- | 'module' module-name { '(' module-name ':' module-type ')' }
- ':' module-type { item-attribute }
- | 'module' 'type' modtype-name { item-attribute }
- | 'module' 'type' modtype-name '=' module-type { item-attribute }
- | 'open' module-path { item-attribute }
- | 'include' module-type { item-attribute }
-;
-class-field-spec: ...
- | class-field-spec item-attribute
-;
-class-field: ...
- | class-field item-attribute
-;
-\end{syntax}
-
-A third form of attributes appears as stand-alone structure or
-signature items in the module or class sub-languages. They are not
-attached to any specific node in the syntax tree:
-
-\begin{syntax}
-floating-attribute:
- '[@@@' attr-id attr-payload ']'
-;
-definition: ...
- | floating-attribute
-;
-specification: ...
- | floating-attribute
-;
-class-field-spec: ...
- | floating-attribute
-;
-class-field: ...
- | floating-attribute
-;
-\end{syntax}
-
-(Note: contrary to what the grammar above describes, @item-attributes@
-cannot be attached to these floating attributes in @class-field-spec@
-and @class-field@.)
-
-
-It is also possible to specify attributes using an infix syntax. For instance:
-
-\begin{verbatim}
-let[@foo] x = 2 in x + 1 === (let x = 2 [@@foo] in x + 1)
-begin[@foo][@bar x] ... end === (begin ... end)[@foo][@bar x]
-module[@foo] M = ... === module M = ... [@@foo]
-type[@foo] t = T === type t = T [@@foo]
-method[@foo] m = ... === method m = ... [@@foo]
-\end{verbatim}
-
-For "let", the attributes are applied to each bindings:
-
-\begin{verbatim}
-let[@foo] x = 2 and y = 3 in x + y === (let x = 2 [@@foo] and y = 3 in x + y)
-let[@foo] x = 2
-and[@bar] y = 3 in x + y === (let x = 2 [@@foo] and y = 3 [@@bar] in x + y)
-\end{verbatim}
-
-
-\subsection{ss:builtin-attributes}{Built-in attributes}
-
-Some attributes are understood by the type-checker:
-\begin{itemize}
-\item
- ``ocaml.warning'' or ``warning'', with a string literal payload.
- This can be used as floating attributes in a
- signature/structure/object/object type. The string is parsed and has
- the same effect as the "-w" command-line option, in the scope between
- the attribute and the end of the current
- signature/structure/object/object type. The attribute can also be
- attached to any kind of syntactic item which support attributes
- (such as an expression, or a type expression)
- in which case its scope is limited to that item.
- Note that it is not well-defined which scope is used for a specific
- warning. This is implementation dependent and can change between versions.
- Some warnings are even completely outside the control of ``ocaml.warning''
- (for instance, warnings 1, 2, 14, 29 and 50).
-
-\item
- ``ocaml.warnerror'' or ``warnerror'', with a string literal payload.
- Same as ``ocaml.warning'', for the "-warn-error" command-line option.
-
-\item
- ``ocaml.alert'' or ``alert'': see section~\ref{s:alerts}.
-
-\item
- ``ocaml.deprecated'' or ``deprecated'': alias for the
- ``deprecated'' alert, see section~\ref{s:alerts}.
-\item
- ``ocaml.deprecated_mutable'' or ``deprecated_mutable''.
- Can be applied to a mutable record label. If the label is later
- used to modify the field (with ``expr.l <- expr''), the ``deprecated'' alert
- will be triggered. If the payload of the attribute is a string literal,
- the alert message includes this text.
-\item
- ``ocaml.ppwarning'' or ``ppwarning'', in any context, with
- a string literal payload. The text is reported as warning (22)
- by the compiler (currently, the warning location is the location
- of the string payload). This is mostly useful for preprocessors which
- need to communicate warnings to the user. This could also be used
- to mark explicitly some code location for further inspection.
-\item
- ``ocaml.warn_on_literal_pattern'' or ``warn_on_literal_pattern'' annotate
- constructors in type definition. A warning (52) is then emitted when this
- constructor is pattern matched with a constant literal as argument. This
- attribute denotes constructors whose argument is purely informative and
- may change in the future. Therefore, pattern matching on this argument
- with a constant literal is unreliable. For instance, all built-in exception
- constructors are marked as ``warn_on_literal_pattern''.
- Note that, due to an implementation limitation, this warning (52) is only
- triggered for single argument constructor.
-\item
- ``ocaml.tailcall'' or ``tailcall'' can be applied to function
- application in order to check that the call is tailcall optimized.
- If it it not the case, a warning (51) is emitted.
-\item
- ``ocaml.inline'' or ``inline'' take either ``never'', ``always''
- or nothing as payload on a function or functor definition. If no payload
- is provided, the default value is ``always''. This payload controls when
- applications of the annotated functions should be inlined.
-\item
- ``ocaml.inlined'' or ``inlined'' can be applied to any function or functor
- application to check that the call is inlined by the compiler. If the call
- is not inlined, a warning (55) is emitted.
-\item
- ``ocaml.noalloc'', ``ocaml.unboxed''and ``ocaml.untagged'' or
- ``noalloc'', ``unboxed'' and ``untagged'' can be used on external
- definitions to obtain finer control over the C-to-OCaml interface. See
- \ref{s:C-cheaper-call} for more details.
-\item
- ``ocaml.immediate'' or ``immediate'' applied on an abstract type mark the type as
- having a non-pointer implementation (e.g. ``int'', ``bool'', ``char'' or
- enumerated types). Mutation of these immediate types does not activate the
- garbage collector's write barrier, which can significantly boost performance in
- programs relying heavily on mutable state.
-\item
- ``ocaml.immediate64'' or ``immediate64'' applied on an abstract type mark the
- type as having a non-pointer implementation on 64 bit platforms. No assumption
- is made on other platforms. In order to produce a type with the
- ``immediate64`` attribute, one must use ``Sys.Immediate64.Make`` functor.
-\item
- "ocaml.unboxed" or "unboxed" can be used on a type definition if the
- type is a single-field record or a concrete type with a single
- constructor that has a single argument. It tells the compiler to
- optimize the representation of the type by removing the block that
- represents the record or the constructor (i.e. a value of this type
- is physically equal to its argument). In the case of GADTs, an
- additional restriction applies: the argument must not be an
- existential variable, represented by an existential type variable,
- or an abstract type constructor applied to an existential type
- variable.
-\item
- "ocaml.boxed" or "boxed" can be used on type definitions to mean
- the opposite of "ocaml.unboxed": keep the unoptimized
- representation of the type. When there is no annotation, the
- default is currently "boxed" but it may change in the future.
- \item
- "ocaml.local" or "local" take either "never", "always", "maybe" or
- nothing as payload on a function definition. If no payload is
- provided, the default is "always". The attribute controls an
- optimization which consists in compiling a function into a static
- continuation. Contrary to inlining, this optimization does not
- duplicate the function's body. This is possible when all
- references to the function are full applications, all sharing the
- same continuation (for instance, the returned value of several
- branches of a pattern matching). "never" disables the optimization,
- "always" asserts that the optimization applies (otherwise a warning
- 55 is emitted) and "maybe" lets the optimization apply when
- possible (this is the default behavior when the attribute is not
- specified). The optimization is implicitly disabled when using the
- bytecode compiler in debug mode (-g), and for functions marked with
- an "ocaml.inline always" or "ocaml.unrolled" attribute which
- supersede "ocaml.local".
-\end{itemize}
-
-\begin{caml_example*}{verbatim}
-module X = struct
- [@@@warning "+9"] (* locally enable warning 9 in this structure *)
- [@@@ellipsis]
-end
-[@@deprecated "Please use module 'Y' instead."]
-
-let x = begin[@warning "+9"] [()[@ellipsis]] end
-
-type t = A | B
- [@@deprecated "Please use type 's' instead."]
-\end{caml_example*}
-
-\begin{caml_example*}{verbatim}[warning=22]
-let fires_warning_22 x =
- assert (x >= 0) [@ppwarning "TODO: remove this later"]
-\end{caml_example*}
-
-\begin{caml_example*}{verbatim}[warning=51]
-let rec is_a_tail_call = function
- | [] -> ()
- | _ :: q -> (is_a_tail_call[@tailcall]) q
-
-let rec not_a_tail_call = function
- | [] -> []
- | x :: q -> x :: (not_a_tail_call[@tailcall]) q
-\end{caml_example*}
-
-\begin{caml_example*}{verbatim}
-let f x = x [@@inline]
-
-let () = (f[@inlined]) ()
-\end{caml_example}
-
-\begin{caml_example*}{verbatim}
-type fragile =
- | Int of int [@warn_on_literal_pattern]
- | String of string [@warn_on_literal_pattern]
-\end{caml_example*}
-
-\begin{caml_example}{verbatim}[warning=52]
-let fragile_match_1 = function
-| Int 0 -> ()
-| _ -> ()
-\end{caml_example}
-
-\begin{caml_example}{verbatim}[warning=52]
-let fragile_match_2 = function
-| String "constant" -> ()
-| _ -> ()
-\end{caml_example}
-
-\begin{caml_example*}{verbatim}
-module Immediate: sig
- type t [@@immediate]
- val x: t ref
-end = struct
- type t = A | B
- let x = ref A
-end
-\end{caml_example*}
-
-\begin{caml_example*}{verbatim}
-module Int_or_int64 : sig
- type t [@@immediate64]
- val zero : t
- val one : t
- val add : t -> t -> t
-end = struct
-
- include Sys.Immediate64.Make(Int)(Int64)
-
- module type S = sig
- val zero : t
- val one : t
- val add : t -> t -> t
- end
-
- let impl : (module S) =
- match repr with
- | Immediate ->
- (module Int : S)
- | Non_immediate ->
- (module Int64 : S)
-
- include (val impl : S)
-end
-\end{caml_example*}
-
-\section{s:extension-nodes}{Extension nodes}
-%HEVEA\cutname{extensionnodes.html}
-
-(Introduced in OCaml 4.02,
-infix notations for constructs other than expressions added in 4.03,
-infix notation (e1 ;\%ext e2) added in 4.04.
-)
-
-Extension nodes are generic placeholders in the syntax tree. They are
-rejected by the type-checker and are intended to be ``expanded'' by external
-tools such as "-ppx" rewriters.
-
-Extension nodes share the same notion of identifier and payload as
-attributes~\ref{s:attributes}.
-
-The first form of extension node is used for ``algebraic'' categories:
-
-\begin{syntax}
-extension:
- '[%' attr-id attr-payload ']'
-;
-expr: ...
- | extension
-;
-typexpr: ...
- | extension
-;
-pattern: ...
- | extension
-;
-module-expr: ...
- | extension
-;
-module-type: ...
- | extension
-;
-class-expr: ...
- | extension
-;
-class-type: ...
- | extension
-;
-\end{syntax}
-
-A second form of extension node can be used in structures and
-signatures, both in the module and object languages:
-
-\begin{syntax}
-item-extension:
- '[%%' attr-id attr-payload ']'
-;
-definition: ...
- | item-extension
-;
-specification: ...
- | item-extension
-;
-class-field-spec: ...
- | item-extension
-;
-class-field: ...
- | item-extension
-;
-\end{syntax}
-
-An infix form is available for extension nodes when
-the payload is of the same kind
-(expression with expression, pattern with pattern ...).
-
-Examples:
-
-\begin{verbatim}
-let%foo x = 2 in x + 1 === [%foo let x = 2 in x + 1]
-begin%foo ... end === [%foo begin ... end]
-x ;%foo 2 === [%foo x; 2]
-module%foo M = .. === [%%foo module M = ... ]
-val%foo x : t === [%%foo: val x : t]
-\end{verbatim}
-
-When this form is used together with the infix syntax for attributes,
-the attributes are considered to apply to the payload:
-
-\begin{verbatim}
-fun%foo[@bar] x -> x + 1 === [%foo (fun x -> x + 1)[@bar ] ];
-\end{verbatim}
-
-Furthermore, quoted strings "{|...|}" can be combined with extension nodes
-to embed foreign syntax fragments. Those fragments can be interpreted
-by a preprocessor and turned into OCaml code without requiring escaping
-quotes. A syntax shortcut is available for them:
-
-\begin{verbatim}
-{%%foo|...|} === [%%foo{|...|}]
-let x = {%foo|...|} === let x = [%foo{|...|}]
-let y = {%foo bar|...|bar} === let y = [%foo{bar|...|bar}]
-\end{verbatim}
-
-For instance, you can use "{%sql|...|}" to
-represent arbitrary SQL statements -- assuming you have a ppx-rewriter
-that recognizes the "%sql" extension.
-
-Note that the word-delimited form, for example "{sql|...|sql}", should
-not be used for signaling that an extension is in use.
-Indeed, the user cannot see from the code whether this string literal has
-different semantics than they expect. Moreover, giving semantics to a
-specific delimiter limits the freedom to change the delimiter to avoid
-escaping issues.
-
-\subsection{ss:builtin-extension-nodes}{Built-in extension nodes}
-
-(Introduced in OCaml 4.03)
-
-Some extension nodes are understood by the compiler itself:
-\begin{itemize}
- \item
- ``ocaml.extension_constructor'' or ``extension_constructor''
- take as payload a constructor from an extensible variant type
- (see \ref{s:extensible-variants}) and return its extension
- constructor slot.
-\end{itemize}
-
-\begin{caml_example*}{verbatim}
-type t = ..
-type t += X of int | Y of string
-let x = [%extension_constructor X]
-let y = [%extension_constructor Y]
-\end{caml_example*}
-\begin{caml_example}{toplevel}
- x <> y;;
-\end{caml_example}
-
-\section{s:extensible-variants}{Extensible variant types}
-%HEVEA\cutname{extensiblevariants.html}
-
-(Introduced in OCaml 4.02)
-
-\begin{syntax}
-type-representation:
- ...
- | '=' '..'
-;
-specification:
- ...
- | 'type' [type-params] typeconstr type-extension-spec
-;
-definition:
- ...
- | 'type' [type-params] typeconstr type-extension-def
-;
-type-extension-spec: '+=' ['private'] ['|'] constr-decl { '|' constr-decl }
-;
-type-extension-def: '+=' ['private'] ['|'] constr-def { '|' constr-def }
-;
-constr-def:
- constr-decl
- | constr-name '=' constr
-;
-\end{syntax}
-
-Extensible variant types are variant types which can be extended with
-new variant constructors. Extensible variant types are defined using
-"..". New variant constructors are added using "+=".
-\begin{caml_example*}{verbatim}
-module Expr = struct
- type attr = ..
-
- type attr += Str of string
-
- type attr +=
- | Int of int
- | Float of float
-end
-\end{caml_example*}
-
-Pattern matching on an extensible variant type requires a default case
-to handle unknown variant constructors:
-\begin{caml_example*}{verbatim}
-let to_string = function
- | Expr.Str s -> s
- | Expr.Int i -> Int.to_string i
- | Expr.Float f -> string_of_float f
- | _ -> "?"
-\end{caml_example*}
-
-A preexisting example of an extensible variant type is the built-in
-"exn" type used for exceptions. Indeed, exception constructors can be
-declared using the type extension syntax:
-\begin{caml_example*}{verbatim}
-type exn += Exc of int
-\end{caml_example*}
-
-Extensible variant constructors can be rebound to a different name. This
-allows exporting variants from another module.
-\begin{caml_example}{toplevel}[error]
-let not_in_scope = Str "Foo";;
-\end{caml_example}
-\begin{caml_example*}{verbatim}
-type Expr.attr += Str = Expr.Str
-\end{caml_example*}
-\begin{caml_example}{toplevel}
-let now_works = Str "foo";;
-\end{caml_example}
-
-Extensible variant constructors can be declared "private". As with
-regular variants, this prevents them from being constructed directly by
-constructor application while still allowing them to be de-structured in
-pattern-matching.
-\begin{caml_example*}{verbatim}
-module B : sig
- type Expr.attr += private Bool of int
- val bool : bool -> Expr.attr
-end = struct
- type Expr.attr += Bool of int
- let bool p = if p then Bool 1 else Bool 0
-end
-\end{caml_example*}
-
-\begin{caml_example}{toplevel}
-let inspection_works = function
- | B.Bool p -> (p = 1)
- | _ -> true;;
-\end{caml_example}
-\begin{caml_example}{toplevel}[error]
-let construction_is_forbidden = B.Bool 1;;
-\end{caml_example}
-
-\subsection{ss:private-extensible}{Private extensible variant types}
-
-(Introduced in OCaml 4.06)
-
-\begin{syntax}
-type-representation:
- ...
- | '=' 'private' '..'
-;
-\end{syntax}
-
-Extensible variant types can be declared "private". This prevents new
-constructors from being declared directly, but allows extension
-constructors to be referred to in interfaces.
-\begin{caml_example*}{verbatim}
-module Msg : sig
- type t = private ..
- module MkConstr (X : sig type t end) : sig
- type t += C of X.t
- end
-end = struct
- type t = ..
- module MkConstr (X : sig type t end) = struct
- type t += C of X.t
- end
-end
-\end{caml_example*}
-
-\section{s:generative-functors}{Generative functors}
-%HEVEA\cutname{generativefunctors.html}
-
-(Introduced in OCaml 4.02)
-
-\begin{syntax}
-module-expr:
- ...
- | 'functor' '()' '->' module-expr
- | module-expr '()'
-;
-definition:
- ...
- | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
- [ ':' module-type ] \\ '=' module-expr
-;
-module-type:
- ...
- | 'functor' '()' '->' module-type
-;
-specification:
- ...
- | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
- ':' module-type
-;
-\end{syntax}
-
-A generative functor takes a unit "()" argument.
-In order to use it, one must necessarily apply it to this unit argument,
-ensuring that all type components in the result of the functor behave
-in a generative way, {\em i.e.} they are different from types obtained
-by other applications of the same functor.
-This is equivalent to taking an argument of signature "sig end", and always
-applying to "struct end", but not to some defined module (in the
-latter case, applying twice to the same module would return identical
-types).
-
-As a side-effect of this generativity, one is allowed to unpack
-first-class modules in the body of generative functors.
-
-\section{s:extension-syntax}{Extension-only syntax}
-%HEVEA\cutname{extensionsyntax.html}
-(Introduced in OCaml 4.02.2, extended in 4.03)
-
-Some syntactic constructions are accepted during parsing and rejected
-during type checking. These syntactic constructions can therefore not
-be used directly in vanilla OCaml. However, "-ppx" rewriters and other
-external tools can exploit this parser leniency to extend the language
-with these new syntactic constructions by rewriting them to
-vanilla constructions.
-\subsection{ss:extension-operators}{Extension operators} \label{s:ext-ops}
-(Introduced in OCaml 4.02.2)
-\begin{syntax}
-infix-symbol:
- ...
- | "#" {operator-chars} "#" {operator-char '|' "#"}
-;
-\end{syntax}
-
-Operator names starting with a "#" character and containing more than
-one "#" character are reserved for extensions.
-
-\subsection{ss:extension-literals}{Extension literals}
-(Introduced in OCaml 4.03)
-\begin{syntax}
-float-literal:
- ...
- | ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
- [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0x"||"0X")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }\\
- ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
- [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- ["g"\ldots"z"||"G"\ldots"Z"]
-;
-int-literal:
- ...
- | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
- | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
- ["g"\ldots"z"||"G"\ldots"Z"]
-;
-\end{syntax}
-Int and float literals followed by an one-letter identifier in the
-range @["g".."z"||"G".."Z"]@ are extension-only literals.
-
-\section{s:inline-records}{Inline records}
-%HEVEA\cutname{inlinerecords.html}
-(Introduced in OCaml 4.03)
-\begin{syntax}
- constr-args:
- ...
- | record-decl
-;
-\end{syntax}
-
-The arguments of sum-type constructors can now be defined using the
-same syntax as records. Mutable and polymorphic fields are allowed.
-GADT syntax is supported. Attributes can be specified on individual
-fields.
-
-Syntactically, building or matching constructors with such an inline
-record argument is similar to working with a unary constructor whose
-unique argument is a declared record type. A pattern can bind
-the inline record as a pseudo-value, but the record cannot escape the
-scope of the binding and can only be used with the dot-notation to
-extract or modify fields or to build new constructor values.
-
-\begin{caml_example*}{verbatim}
-type t =
- | Point of {width: int; mutable x: float; mutable y: float}
- | Other
-
-let v = Point {width = 10; x = 0.; y = 0.}
-
-let scale l = function
- | Point p -> Point {p with x = l *. p.x; y = l *. p.y}
- | Other -> Other
-
-let print = function
- | Point {x; y; _} -> Printf.printf "%f/%f" x y
- | Other -> ()
-
-let reset = function
- | Point p -> p.x <- 0.; p.y <- 0.
- | Other -> ()
-\end{caml_example*}
-
-\begin{caml_example}{verbatim}[error]
-let invalid = function
- | Point p -> p
-\end{caml_example}
-
-\section{s:doc-comments}{Documentation comments}
-%HEVEA\cutname{doccomments.html}
-(Introduced in OCaml 4.03)
-
-Comments which start with "**" are treated specially by the
-compiler. They are automatically converted during parsing into
-attributes (see \ref{s:attributes}) to allow tools to process them as
-documentation.
-
-Such comments can take three forms: {\em floating comments}, {\em item
-comments} and {\em label comments}. Any comment starting with "**" which
-does not match one of these forms will cause the compiler to emit
-warning 50.
-
-Comments which start with "**" are also used by the ocamldoc
-documentation generator (see \ref{c:ocamldoc}). The three comment forms
-recognised by the compiler are a subset of the forms accepted by
-ocamldoc (see \ref{s:ocamldoc-comments}).
-
-\subsection{ss:floating-comments}{Floating comments}
-
-Comments surrounded by blank lines that appear within structures,
-signatures, classes or class types are converted into
-@floating-attribute@s. For example:
-
-\begin{caml_example*}{verbatim}
-type t = T
-
-(** Now some definitions for [t] *)
-
-let mkT = T
-\end{caml_example*}
-
-will be converted to:
-
-\begin{caml_example*}{verbatim}
-type t = T
-
-[@@@ocaml.text " Now some definitions for [t] "]
-
-let mkT = T
-\end{caml_example*}
-
-\subsection{ss:item-comments}{Item comments}
-
-Comments which appear {\em immediately before} or {\em immediately
-after} a structure item, signature item, class item or class type item
-are converted into @item-attribute@s. Immediately before or immediately
-after means that there must be no blank lines, ";;", or other
-documentation comments between them. For example:
-
-\begin{caml_example*}{verbatim}
-type t = T
-(** A description of [t] *)
-
-\end{caml_example*}
-
-or
-
-\begin{caml_example*}{verbatim}
-
-(** A description of [t] *)
-type t = T
-\end{caml_example*}
-
-will be converted to:
-
-\begin{caml_example*}{verbatim}
-type t = T
-[@@ocaml.doc " A description of [t] "]
-\end{caml_example*}
-
-Note that, if a comment appears immediately next to multiple items,
-as in:
-
-\begin{caml_example*}{verbatim}
-type t = T
-(** An ambiguous comment *)
-type s = S
-\end{caml_example*}
-
-then it will be attached to both items:
-
-\begin{caml_example*}{verbatim}
-type t = T
-[@@ocaml.doc " An ambiguous comment "]
-type s = S
-[@@ocaml.doc " An ambiguous comment "]
-\end{caml_example*}
-
-and the compiler will emit warning 50.
-
-\subsection{ss:label-comments}{Label comments}
-
-Comments which appear {\em immediately after} a labelled argument,
-record field, variant constructor, object method or polymorphic variant
-constructor are are converted into @attribute@s. Immediately
-after means that there must be no blank lines or other documentation
-comments between them. For example:
-
-\begin{caml_example*}{verbatim}
-type t1 = lbl:int (** Labelled argument *) -> unit
-
-type t2 = {
- fld: int; (** Record field *)
- fld2: float;
-}
-
-type t3 =
- | Cstr of string (** Variant constructor *)
- | Cstr2 of string
-
-type t4 = < meth: int * int; (** Object method *) >
-
-type t5 = [
- `PCstr (** Polymorphic variant constructor *)
-]
-\end{caml_example*}
-
-will be converted to:
-
-\begin{caml_example*}{verbatim}
-type t1 = lbl:(int [@ocaml.doc " Labelled argument "]) -> unit
-
-type t2 = {
- fld: int [@ocaml.doc " Record field "];
- fld2: float;
-}
-
-type t3 =
- | Cstr of string [@ocaml.doc " Variant constructor "]
- | Cstr2 of string
-
-type t4 = < meth : int * int [@ocaml.doc " Object method "] >
-
-type t5 = [
- `PCstr [@ocaml.doc " Polymorphic variant constructor "]
-]
-\end{caml_example*}
-
-Note that label comments take precedence over item comments, so:
-
-\begin{caml_example*}{verbatim}
-type t = T of string
-(** Attaches to T not t *)
-\end{caml_example*}
-
-will be converted to:
-
-\begin{caml_example*}{verbatim}
-type t = T of string [@ocaml.doc " Attaches to T not t "]
-\end{caml_example*}
-
-whilst:
-
-\begin{caml_example*}{verbatim}
-type t = T of string
-(** Attaches to T not t *)
-(** Attaches to t *)
-\end{caml_example*}
-
-will be converted to:
-
-\begin{caml_example*}{verbatim}
-type t = T of string [@ocaml.doc " Attaches to T not t "]
-[@@ocaml.doc " Attaches to t "]
-\end{caml_example*}
-
-In the absence of meaningful comment on the last constructor of
-a type, an empty comment~"(**)" can be used instead:
-
-\begin{caml_example*}{verbatim}
-type t = T of string
-(**)
-(** Attaches to t *)
-\end{caml_example*}
-
-will be converted directly to
-
-\begin{caml_example*}{verbatim}
-type t = T of string
-[@@ocaml.doc " Attaches to t "]
-\end{caml_example*}
-
-\section{s:index-operators}{Extended indexing operators }
-%HEVEA\cutname{indexops.html}
-(Introduced in 4.06)
-
-\begin{syntax}
-
-dot-ext:
- | dot-operator-char { operator-char }
-;
-dot-operator-char:
- '!' || '?' || core-operator-char || '%' || ':'
-;
-expr:
- ...
- | expr '.' [module-path '.'] dot-ext ( '(' expr ')' || '[' expr ']' || '{' expr '}' ) [ '<-' expr ]
-;
-operator-name:
- ...
- | '.' dot-ext ('()' || '[]' || '{}') ['<-']
-;
-\end{syntax}
-
-
-This extension provides syntactic sugar for getting and setting elements
-for user-defined indexed types. For instance, we can define python-like
-dictionaries with
-\begin{caml_example*}{verbatim}
-module Dict = struct
-include Hashtbl
-let ( .%{} ) tabl index = find tabl index
-let ( .%{}<- ) tabl index value = add tabl index value
-end
-let dict =
- let dict = Dict.create 10 in
- let () =
- dict.Dict.%{"one"} <- 1;
- let open Dict in
- dict.%{"two"} <- 2 in
- dict
-\end{caml_example*}
-\begin{caml_example}{toplevel}
-dict.Dict.%{"one"};;
-let open Dict in dict.%{"two"};;
-\end{caml_example}
-
-\subsection{ss:multiindexing}{Multi-index notation}
-\begin{syntax}
-expr:
- ...
- | expr '.' [module-path '.'] dot-ext '(' expr {{';' expr }} ')' [ '<-' expr ]
- | expr '.' [module-path '.'] dot-ext '[' expr {{';' expr }} ']' [ '<-' expr ]
- | expr '.' [module-path '.'] dot-ext '{' expr {{';' expr }} '}' [ '<-' expr ]
-;
-operator-name:
- ...
- | '.' dot-ext ('(;..)' || '[;..]' || '{;..}') ['<-']
-;
-\end{syntax}
-
-Multi-index are also supported through a second variant of indexing operators
-
-\begin{caml_example*}{verbatim}
-let (.%[;..]) = Bigarray.Genarray.get
-let (.%{;..}) = Bigarray.Genarray.get
-let (.%(;..)) = Bigarray.Genarray.get
-\end{caml_example*}
-
-which is called when an index literals contain a semicolon separated list
-of expressions with two and more elements:
-
-\begin{caml_example*}{verbatim}
-let sum x y = x.%[1;2;3] + y.%[1;2]
-(* is equivalent to *)
-let sum x y = (.%[;..]) x [|1;2;3|] + (.%[;..]) y [|1;2|]
-\end{caml_example*}
-
-In particular this multi-index notation makes it possible to uniformly handle
-indexing Genarray and other implementations of multidimensional arrays.
-
-\begin{caml_example*}{verbatim}
-module A = Bigarray.Genarray
-let (.%{;..}) = A.get
-let (.%{;..}<- ) = A.set
-let (.%{ }) a k = A.get a [|k|]
-let (.%{ }<-) a k x = A.set a [|k|] x
-let syntax_compare vec mat t3 t4 =
- vec.%{0} = A.get vec [|0|]
- && mat.%{0;0} = A.get mat [|0;0|]
- && t3.%{0;0;0} = A.get t3 [|0;0;0|]
- && t4.%{0;0;0;0} = t4.{0,0,0,0}
-\end{caml_example*}
-
-Beware that the differentiation between the multi-index and single index
-operators is purely syntactic: multi-index operators are restricted to
-index expressions that contain one or more semicolons ";". For instance,
-\begin{caml_example*}{verbatim}
- let pair vec mat = vec.%{0}, mat.%{0;0}
-\end{caml_example*}
-is equivalent to
-\begin{caml_example*}{verbatim}
- let pair vec mat = (.%{ }) vec 0, (.%{;..}) mat [|0;0|]
-\end{caml_example*}
-Notice that in the "vec" case, we are calling the single index operator, "(.%{})", and
-not the multi-index variant, "(.{;..})".
-For this reason, it is expected that most users of multi-index operators will need
-to define conjointly a single index variant
-\begin{caml_example*}{verbatim}
-let (.%{;..}) = A.get
-let (.%{ }) a k = A.get a [|k|]
-\end{caml_example*}
-to handle both cases uniformly.
-
-\section{s:empty-variants}{Empty variant types}
-%HEVEA\cutname{emptyvariants.html}
-(Introduced in 4.07.0)
-
-\begin{syntax}
-type-representation:
- ...
- | '=' '|'
-\end{syntax}
-This extension allows user to define empty variants.
-Empty variant type can be eliminated by refutation case of pattern matching.
-\begin{caml_example*}{verbatim}
-type t = |
-let f (x: t) = match x with _ -> .
-\end{caml_example*}
-
-\section{s:alerts}{Alerts}
-%HEVEA\cutname{alerts.html}
-(Introduced in 4.08)
-
-Since OCaml 4.08, it is possible to mark components (such as value or
-type declarations) in signatures with ``alerts'' that will be reported
-when those components are referenced. This generalizes the notion of
-``deprecated'' components which were previously reported as warning 3.
-Those alerts can be used for instance to report usage of unsafe
-features, or of features which are only available on some platforms,
-etc.
-
-Alert categories are identified by a symbolic identifier (a lowercase
-identifier, following the usual lexical rules) and an optional
-message. The identifier is used to control which alerts are enabled,
-and which ones are turned into fatal errors. The message is reported
-to the user when the alert is triggered (i.e. when the marked
-component is referenced).
-
-The "ocaml.alert" or "alert" attribute serves two purposes: (i) to
-mark component with an alert to be triggered when the component is
-referenced, and (ii) to control which alert names are enabled. In the
-first form, the attribute takes an identifier possibly
-followed by a message. Here is an example of a value declaration marked
-with an alert:
-
-\begin{verbatim}
-module U: sig
- val fork: unit -> bool
- [@@alert unix "This function is only available under Unix."]
-end
-\end{verbatim}
-
-Here "unix" is the identifier for the alert. If this alert category
-is enabled, any reference to "U.fork" will produce a message at
-compile time, which can be turned or not into a fatal error.
-
-And here is another example as a floating attribute on top
-of an ``.mli'' file (i.e. before any other non-attribute item)
-or on top of an ``.ml'' file without a corresponding interface file,
-so that any reference to that unit will trigger the alert:
-
-\begin{verbatim}
-[@@@alert unsafe "This module is unsafe!"]
-\end{verbatim}
-
-
-Controlling which alerts are enabled and whether they are turned into
-fatal errors is done either through the compiler's command-line option
-"-alert <spec>" or locally in the code through the "alert" or
-"ocaml.alert" attribute taking a single string payload "<spec>". In
-both cases, the syntax for "<spec>" is a concatenation of items of the
-form:
-
-\begin{itemize}
-\item "+id" enables alert "id".
-\item "-id" disables alert "id".
-\item "++id" turns alert "id" into a fatal error.
-\item "--id" turns alert "id" into non-fatal mode.
-\item "\@id" equivalent to "++id+id" (enables "id" and turns it into a fatal-error)
-\end{itemize}
-
-As a special case, if "id" is "all", it stands for all alerts.
-
-Here are some examples:
-
-\begin{verbatim}
-
-(* Disable all alerts, reenables just unix (as a soft alert) and window
- (as a fatal-error), for the rest of the current structure *)
-
-[@@@alert "-all--all+unix@window"]
- ...
-
-let x =
- (* Locally disable the window alert *)
- begin[@alert "-window"]
- ...
- end
-\end{verbatim}
-
-Before OCaml 4.08, there was support for a single kind of deprecation
-alert. It is now known as the "deprecated" alert, but legacy
-attributes to trigger it and the legacy ways to control it as warning
-3 are still supported. For instance, passing "-w +3" on the
-command-line is equivant to "-alert +deprecated", and:
-
-\begin{verbatim}
-val x: int
- [@@@ocaml.deprecated "Please do something else"]
-\end{verbatim}
-
-is equivalent to:
-
-\begin{verbatim}
-val x: int
- [@@@ocaml.alert deprecated "Please do something else"]
-\end{verbatim}
-
-\section{s:generalized-open}{Generalized open statements}
-%HEVEA\cutname{generalizedopens.html}
-
-(Introduced in 4.08)
-
-\begin{syntax}
-definition:
- ...
- | 'open' module-expr
- | 'open!' module-expr
-;
-specification:
- ...
- | 'open' extended-module-path
- | 'open!' extended-module-path
-;
-expr:
- ...
- | 'let' 'open' module-expr 'in' expr
- | 'let' 'open!' module-expr 'in' expr
-;
-\end{syntax}
-
-
-This extension makes it possible to open any module expression in
-module structures and expressions. A similar mechanism is also available
-inside module types, but only for extended module paths (e.g. "F(X).G(Y)").
-
-For instance, a module can be constrained when opened with
-
-\begin{caml_example*}{verbatim}[error]
-module M = struct let x = 0 let hidden = 1 end
-open (M:sig val x: int end)
-let y = hidden
-\end{caml_example*}
-
-
-Another possibility is to immediately open the result of a functor application
-
-\begin{caml_example}{verbatim}
- let sort (type x) (x:x list) =
- let open Set.Make(struct type t = x let compare=compare end) in
- elements (of_list x)
-\end{caml_example}
-
-Going further, this construction can introduce local components inside a
-structure,
-
-\begin{caml_example}{verbatim}
-module M = struct
- let x = 0
- open! struct
- let x = 0
- let y = 1
- end
- let w = x + y
-end
-\end{caml_example}
-
-One important restriction is that types introduced by @'open' 'struct' ...
-'end'@ cannot appear in the signature of the enclosing structure, unless they
-are defined equal to some non-local type.
-So:
-
-\begin{caml_example}{verbatim}
-module M = struct
- open struct type 'a t = 'a option = None | Some of 'a end
- let x : int t = Some 1
-end
-\end{caml_example}
-is OK, but:
-
-\begin{caml_example}{verbatim}[error]
-module M = struct
- open struct type t = A end
- let x = A
-end
-\end{caml_example}
-is not because "x" cannot be given any type other than "t", which only exists
-locally. Although the above would be OK if "x" too was local:
-
-\begin{caml_example}{verbatim}
-module M: sig end = struct
- open struct
- type t = A
- end
- [@@@ellipsis]
- open struct let x = A end
- [@@@ellipsis]
-end
-\end{caml_example}
-
-Inside signatures, extended opens are limited to extended module paths,
-\begin{caml_example}{verbatim}
-module type S = sig
- module F: sig end -> sig type t end
- module X: sig end
- open F(X)
- val f: t
-end
-\end{caml_example}
-
-and not
-
-\begin{verbatim}
- open struct type t = int end
-\end{verbatim}
-
-In those situations, local substitutions(see \ref{ss:local-substitution})
-can be used instead.
-
-Beware that this extension is not available inside class definitions:
-
-\begin{verbatim}
-class c =
- let open Set.Make(Int) in
- ...
-\end{verbatim}
-
-\section{s:binding-operators}{Binding operators}
-%HEVEA\cutname{bindingops.html}
-(Introduced in 4.08.0)
-
-\begin{syntax}
-let-operator:
- | 'let' (core-operator-char || '<') { dot-operator-char }
-;
-and-operator:
- | 'and' (core-operator-char || '<') { dot-operator-char }
-;
-operator-name :
- ...
- | let-operator
- | and-operator
-;
-expr:
- ...
- | let-operator let-binding { and-operator let-binding } in expr
-;
-\end{syntax}
-
-Users can define {\em let operators}:
-
-\begin{caml_example}{verbatim}
-let ( let* ) o f =
- match o with
- | None -> None
- | Some x -> f x
-
-let return x = Some x
-\end{caml_example}
-
-and then apply them using this convenient syntax:
-
-\begin{caml_example}{verbatim}
-let find_and_sum tbl k1 k2 =
- let* x1 = Hashtbl.find_opt tbl k1 in
- let* x2 = Hashtbl.find_opt tbl k2 in
- return (x1 + x2)
-\end{caml_example}
-
-which is equivalent to this expanded form:
-
-\begin{caml_example}{verbatim}
-let find_and_sum tbl k1 k2 =
- ( let* ) (Hashtbl.find_opt tbl k1)
- (fun x1 ->
- ( let* ) (Hashtbl.find_opt tbl k2)
- (fun x2 -> return (x1 + x2)))
-\end{caml_example}
-
-Users can also define {\em and operators}:
-
-\begin{caml_example}{verbatim}
-module ZipSeq = struct
-
- type 'a t = 'a Seq.t
-
- open Seq
-
- let rec return x =
- fun () -> Cons(x, return x)
-
- let rec prod a b =
- fun () ->
- match a (), b () with
- | Nil, _ | _, Nil -> Nil
- | Cons(x, a), Cons(y, b) -> Cons((x, y), prod a b)
-
- let ( let+ ) f s = map s f
- let ( and+ ) a b = prod a b
-
-end
-\end{caml_example}
-
-to support the syntax:
-
-\begin{caml_example}{verbatim}
-open ZipSeq
-let sum3 z1 z2 z3 =
- let+ x1 = z1
- and+ x2 = z2
- and+ x3 = z3 in
- x1 + x2 + x3
-\end{caml_example}
-
-which is equivalent to this expanded form:
-
-\begin{caml_example}{verbatim}
-open ZipSeq
-let sum3 z1 z2 z3 =
- ( let+ ) (( and+ ) (( and+ ) z1 z2) z3)
- (fun ((x1, x2), x3) -> x1 + x2 + x3)
-\end{caml_example}
-
-\subsection{ss:letops-rationale}{Rationale}
-
-This extension is intended to provide a convenient syntax for working
-with monads and applicatives.
-
-An applicative should provide a module implementing the following
-interface:
-
-\begin{caml_example*}{verbatim}
-module type Applicative_syntax = sig
- type 'a t
- val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
- val ( and+ ): 'a t -> 'b t -> ('a * 'b) t
-end
-\end{caml_example*}
-
-where "(let+)" is bound to the "map" operation and "(and+)" is bound to
-the monoidal product operation.
-
-A monad should provide a module implementing the following interface:
-
-\begin{caml_example*}{verbatim}
-module type Monad_syntax = sig
- include Applicative_syntax
- val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
- val ( and* ): 'a t -> 'b t -> ('a * 'b) t
-end
-\end{caml_example*}
-
-where "(let*)" is bound to the "bind" operation, and "(and*)" is also
-bound to the monoidal product operation.
-
-%HEVEA\cutend
+++ /dev/null
-\section{s:lexical-conventions}{Lexical conventions}
-%HEVEA\cutname{lex.html}
-\subsubsection*{sss:lex:blanks}{Blanks}
-
-The following characters are considered as blanks: space,
-horizontal tabulation, carriage return, line feed and form feed. Blanks are
-ignored, but they separate adjacent identifiers, literals and
-keywords that would otherwise be confused as one single identifier,
-literal or keyword.
-
-\subsubsection*{sss:lex:comments}{Comments}
-
-Comments are introduced by the two characters @"(*"@, with no
-intervening blanks, and terminated by the characters @"*)"@, with
-no intervening blanks. Comments are treated as blank characters.
-Comments do not occur inside string or character literals. Nested
-comments are handled correctly.
-
-\subsubsection*{sss:lex:identifiers}{Identifiers}
-
-\begin{syntax}
-ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ;
-capitalized-ident: ("A" \ldots "Z") { letter || "0" \ldots "9" || "_" || "'" } ;
-lowercase-ident:
- ("a" \ldots "z" || "_") { letter || "0" \ldots "9" || "_" || "'" } ;
-letter: "A" \ldots "Z" || "a" \ldots "z"
-\end{syntax}
-
-Identifiers are sequences of letters, digits, "_" (the underscore
-character), and "'" (the single quote), starting with a
-letter or an underscore.
-Letters contain at least the 52 lowercase and uppercase
-letters from the ASCII set. The current implementation
-also recognizes as letters some characters from the ISO
-8859-1 set (characters 192--214 and 216--222 as uppercase letters;
-characters 223--246 and 248--255 as lowercase letters). This
-feature is deprecated and should be avoided for future compatibility.
-
-All characters in an identifier are
-meaningful. The current implementation accepts identifiers up to
-16000000 characters in length.
-
-In many places, OCaml makes a distinction between capitalized
-identifiers and identifiers that begin with a lowercase letter. The
-underscore character is considered a lowercase letter for this
-purpose.
-
-\subsubsection*{sss:integer-literals}{Integer literals}
-
-\begin{syntax}
-integer-literal:
- ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }
- | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
- | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
- | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
-;
-int32-literal: integer-literal 'l'
-;
-int64-literal: integer-literal 'L'
-;
-nativeint-literal: integer-literal 'n'
-\end{syntax}
-
-An integer literal is a sequence of one or more digits, optionally
-preceded by a minus sign. By default, integer literals are in decimal
-(radix 10). The following prefixes select a different radix:
-\begin{tableau}{|l|l|}{Prefix}{Radix}
-\entree{"0x", "0X"}{hexadecimal (radix 16)}
-\entree{"0o", "0O"}{octal (radix 8)}
-\entree{"0b", "0B"}{binary (radix 2)}
-\end{tableau}
-(The initial @"0"@ is the digit zero; the @"O"@ for octal is the letter O.)
-An integer literal can be followed by one of the letters "l", "L" or "n"
-to indicate that this integer has type "int32", "int64" or "nativeint"
-respectively, instead of the default type "int" for integer literals.
-The interpretation of integer literals that fall outside the range of
-representable integer values is undefined.
-
-For convenience and readability, underscore characters (@"_"@) are accepted
-(and ignored) within integer literals.
-
-\subsubsection*{sss:floating-point-literals}{Floating-point literals}
-
-\begin{syntax}
-float-literal:
- ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
- [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
- | ["-"] ("0x"||"0X")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" } \\
- ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
- [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
-\end{syntax}
-
-Floating-point decimal literals consist in an integer part, a
-fractional part and
-an exponent part. The integer part is a sequence of one or more
-digits, optionally preceded by a minus sign. The fractional part is a
-decimal point followed by zero, one or more digits.
-The exponent part is the character @"e"@ or @"E"@ followed by an
-optional @"+"@ or @"-"@ sign, followed by one or more digits. It is
-interpreted as a power of 10.
-The fractional part or the exponent part can be omitted but not both, to
-avoid ambiguity with integer literals.
-The interpretation of floating-point literals that fall outside the
-range of representable floating-point values is undefined.
-
-Floating-point hexadecimal literals are denoted with the @"0x"@ or @"0X"@
-prefix. The syntax is similar to that of floating-point decimal
-literals, with the following differences.
-The integer part and the fractional part use hexadecimal
-digits. The exponent part starts with the character @"p"@ or @"P"@.
-It is written in decimal and interpreted as a power of 2.
-
-For convenience and readability, underscore characters (@"_"@) are accepted
-(and ignored) within floating-point literals.
-
-\subsubsection*{sss:character-literals}{Character literals}
-\label{s:characterliteral}
-
-\begin{syntax}
-char-literal:
- "'" regular-char "'"
- | "'" escape-sequence "'"
-;
-escape-sequence:
- "\" ( "\" || '"' || "'" || "n" || "t" || "b" || "r" || space )
- | "\" ("0"\ldots"9") ("0"\ldots"9") ("0"\ldots"9")
- | "\x" ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
- | "\o" ("0"\ldots"3") ("0"\ldots"7") ("0"\ldots"7")
-\end{syntax}
-
-Character literals are delimited by @"'"@ (single quote) characters.
-The two single quotes enclose either one character different from
-@"'"@ and @'\'@, or one of the escape sequences below:
-\begin{tableau}{|l|l|}{Sequence}{Character denoted}
-\entree{"\\\\"}{backslash ("\\")}
-\entree{"\\\""}{double quote ("\"")}
-\entree{"\\'"}{single quote ("'")}
-\entree{"\\n"}{linefeed (LF)}
-\entree{"\\r"}{carriage return (CR)}
-\entree{"\\t"}{horizontal tabulation (TAB)}
-\entree{"\\b"}{backspace (BS)}
-\entree{"\\"\var{space}}{space (SPC)}
-\entree{"\\"\var{ddd}}{the character with ASCII code \var{ddd} in decimal}
-\entree{"\\x"\var{hh}}{the character with ASCII code \var{hh} in hexadecimal}
-\entree{"\\o"\var{ooo}}{the character with ASCII code \var{ooo} in octal}
-\end{tableau}
-
-\subsubsection*{sss:stringliterals}{String literals}
-
-\begin{syntax}
-string-literal:
- '"' { string-character } '"'
- | '{' quoted-string-id '|' { any-char } '|' quoted-string-id '}'
-;
-quoted-string-id:
- { 'a'...'z' || '_' }
-;
-;
-string-character:
- regular-string-char
- | escape-sequence
- | "\u{" {{ "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f" }} "}"
- | '\' newline { space || tab }
-\end{syntax}
-
-String literals are delimited by @'"'@ (double quote) characters.
-The two double quotes enclose a sequence of either characters
-different from @'"'@ and @'\'@, or escape sequences from the
-table given above for character literals, or a Unicode character
-escape sequence.
-
-A Unicode character escape sequence is substituted by the UTF-8
-encoding of the specified Unicode scalar value. The Unicode scalar
-value, an integer in the ranges 0x0000...0xD7FF or 0xE000...0x10FFFF,
-is defined using 1 to 6 hexadecimal digits; leading zeros are allowed.
-
-To allow splitting long string literals across lines, the sequence
-"\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line
-followed by any number of spaces and horizontal tabulations at the
-beginning of the next line) is ignored inside string literals.
-
-Quoted string literals provide an alternative lexical syntax for
-string literals. They are useful to represent strings of arbitrary content
-without escaping. Quoted strings are delimited by a matching pair
-of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with
-the same @quoted-string-id@ on both sides. Quoted strings do not interpret
-any character in a special way but requires that the
-sequence @'|' quoted-string-id '}'@ does not occur in the string itself.
-The identifier @quoted-string-id@ is a (possibly empty) sequence of
-lowercase letters and underscores that can be freely chosen to avoid
-such issue (e.g. "{|hello|}", "{ext|hello {|world|}|ext}", ...).
-
-
-The current implementation places practically no restrictions on the
-length of string literals.
-
-\subsubsection*{sss:labelname}{Naming labels}
-
-To avoid ambiguities, naming labels in expressions cannot just be defined
-syntactically as the sequence of the three tokens "~", @ident@ and
-":", and have to be defined at the lexical level.
-
-\begin{syntax}
-label-name: lowercase-ident
-;
-label: "~" label-name ":"
-;
-optlabel: "?" label-name ":"
-\end{syntax}
-
-Naming labels come in two flavours: @label@ for normal arguments and
-@optlabel@ for optional ones. They are simply distinguished by their
-first character, either "~" or "?".
-
-Despite @label@ and @optlabel@ being lexical entities in expressions,
-their expansions @'~' label-name ':'@ and @'?' label-name ':'@ will be
-used in grammars, for the sake of readability. Note also that inside
-type expressions, this expansion can be taken literally, {\em i.e.}
-there are really 3 tokens, with optional blanks between them.
-
-\subsubsection*{sss:lex-ops-symbols}{Prefix and infix symbols}
-
-%% || '`' lowercase-ident '`'
-
-\begin{syntax}
-infix-symbol:
- ( core-operator-char || '%' || '<' ) { operator-char }
- | "#" {{ operator-char }}
-;
-prefix-symbol:
- '!' { operator-char }
- | ('?' || '~') {{ operator-char }}
-;
-operator-char:
- '~' || '!' || '?' || core-operator-char || '%' || '<' || ':' || '.'
-;
-core-operator-char:
- '$' || '&' || '*' || '+' || '-' || '/' || '=' || '>' || '@' || '^' || '|'
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:ext-ops]{extension operators},
-\hyperref[s:index-operators]{extended indexing operators},
-and \hyperref[s:binding-operators]{binding operators}.
-
-Sequences of ``operator characters'', such as "<=>" or "!!",
-are read as a single token from the @infix-symbol@ or @prefix-symbol@
-class. These symbols are parsed as prefix and infix operators inside
-expressions, but otherwise behave like normal identifiers.
-%% Identifiers starting with a lowercase letter and enclosed
-%% between backquote characters @'`' lowercase-ident '`'@ are also parsed
-%% as infix operators.
-
-\subsubsection*{sss:keywords}{Keywords}
-
-The identifiers below are reserved as keywords, and cannot be employed
-otherwise:
-\begin{verbatim}
- and as assert asr begin class
- constraint do done downto else end
- exception external false for fun function
- functor if in include inherit initializer
- land lazy let lor lsl lsr
- lxor match method mod module mutable
- new nonrec object of open or
- private rec sig struct then to
- true try type val virtual when
- while with
-\end{verbatim}
-%
-\goodbreak%
-%
-The following character sequences are also keywords:
-%
-%% FIXME the token >] is not used anywhere in the syntax
-%
-\begin{alltt}
-" != # & && ' ( ) * + , -"
-" -. -> . .. .~ : :: := :> ; ;;"
-" < <- = > >] >} ? [ [< [> [|"
-" ] _ ` { {< | |] || } ~"
-\end{alltt}
-%
-Note that the following identifiers are keywords of the now unmaintained Camlp4
-system and should be avoided for backwards compatibility reasons.
-%
-\begin{verbatim}
- parser value $ $$ $: <: << >> ??
-\end{verbatim}
-
-\subsubsection*{sss:lex-ambiguities}{Ambiguities}
-
-Lexical ambiguities are resolved according to the ``longest match''
-rule: when a character sequence can be decomposed into two tokens in
-several different ways, the decomposition retained is the one with the
-longest first token.
-
-\subsubsection*{sss:lex-linedir}{Line number directives}
-
-\begin{syntax}
-linenum-directive:
- '#' {{"0" \ldots "9"}}
- | '#' {{"0" \ldots "9"}} '"' { string-character } '"'
-\end{syntax}
-
-Preprocessors that generate OCaml source code can insert line number
-directives in their output so that error messages produced by the
-compiler contain line numbers and file names referring to the source
-file before preprocessing, instead of after preprocessing.
-A line number directive is composed of a @"#"@ (sharp sign), followed by
-a positive integer (the source line number), optionally followed by a
-character string (the source file name).
-Line number directives are treated as blanks during lexical
-analysis.
-
-% FIXME spaces and tabs are allowed before and after the number
-% FIXME ``string-character'' is inaccurate: everything is allowed except
-% CR, LF, and doublequote; moreover, backslash escapes are not
-% interpreted (especially backslash-doublequote)
-% FIXME any number of random characters are allowed (and ignored) at the
-% end of the line, except CR and LF.
+++ /dev/null
-\section{s:modtypes}{Module types (module specifications)}
-%HEVEA\cutname{modtypes.html}
-
-Module types are the module-level equivalent of type expressions: they
-specify the general shape and type properties of modules.
-
-\ikwd{sig\@\texttt{sig}}
-\ikwd{end\@\texttt{end}}
-\ikwd{functor\@\texttt{functor}}
-\ikwd{with\@\texttt{with}}
-\ikwd{and\@\texttt{and}}
-\ikwd{val\@\texttt{val}}
-\ikwd{external\@\texttt{external}}
-\ikwd{type\@\texttt{type}}
-\ikwd{exception\@\texttt{exception}}
-\ikwd{class\@\texttt{class}}
-\ikwd{module\@\texttt{module}}
-\ikwd{open\@\texttt{open}}
-\ikwd{include\@\texttt{include}}
-
-\begin{syntax}
-module-type:
- modtype-path
- | 'sig' { specification [';;'] } 'end'
- | 'functor' '(' module-name ':' module-type ')' '->' module-type
- | module-type '->' module-type
- | module-type 'with' mod-constraint { 'and' mod-constraint }
- | '(' module-type ')'
-;
-mod-constraint:
- 'type' [type-params] typeconstr type-equation { type-constraint }
- | 'module' module-path '=' extended-module-path
-;
-%BEGIN LATEX
-\end{syntax}
-\begin{syntax}
-%END LATEX
-specification:
- 'val' value-name ':' typexpr
- | 'external' value-name ':' typexpr '=' external-declaration
- | type-definition
- | 'exception' constr-decl
- | class-specification
- | classtype-definition
- | 'module' module-name ':' module-type
- | 'module' module-name { '(' module-name ':' module-type ')' }
- ':' module-type
- | 'module' 'type' modtype-name
- | 'module' 'type' modtype-name '=' module-type
- | 'open' module-path
- | 'include' module-type
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:module-type-of]{recovering the type of a module},
-\hyperref[s:signature-substitution]{substitution inside a signature},
-\hyperref[s:module-alias]{type-level module aliases},
-\hyperref[s:attributes]{attributes},
-\hyperref[s:extension-nodes]{extension nodes} and
-\hyperref[s:generative-functors]{generative functors}.
-
-\subsection{ss:mty-simple}{Simple module types}
-
-The expression @modtype-path@ is equivalent to the module type bound
-to the name @modtype-path@.
-The expression @'(' module-type ')'@ denotes the same type as
-@module-type@.
-
-\subsection{ss:mty-signatures}{Signatures}
-
-\ikwd{sig\@\texttt{sig}}
-\ikwd{end\@\texttt{end}}
-
-Signatures are type specifications for structures. Signatures
-@'sig' \ldots 'end'@ are collections of type specifications for value
-names, type names, exceptions, module names and module type names. A
-structure will match a signature if the structure provides definitions
-(implementations) for all the names specified in the signature (and
-possibly more), and these definitions meet the type requirements given
-in the signature.
-
-An optional @";;"@ is allowed after each specification in a
-signature. It serves as a syntactic separator with no semantic
-meaning.
-
-\subsubsection*{sss:mty-values}{Value specifications}
-
-\ikwd{val\@\texttt{val}}
-
-A specification of a value component in a signature is written
-@'val' value-name ':' typexpr@, where @value-name@ is the name of the
-value and @typexpr@ its expected type.
-
-\ikwd{external\@\texttt{external}}
-
-The form @'external' value-name ':' typexpr '=' external-declaration@
-is similar, except that it requires in addition the name to be
-implemented as the external function specified in @external-declaration@
-(see chapter~\ref{c:intf-c}).
-
-\subsubsection*{sss:mty-type}{Type specifications}
-
-\ikwd{type\@\texttt{type}}
-
-A specification of one or several type components in a signature is
-written @'type' typedef { 'and' typedef }@ and consists of a sequence
-of mutually recursive definitions of type names.
-
-Each type definition in the signature specifies an optional type
-equation @'=' typexpr@ and an optional type representation
-@'=' constr-decl \ldots@ or @'=' '{' field-decl \ldots '}'@.
-The implementation of the type name in a matching structure must
-be compatible with the type expression specified in the equation (if
-given), and have the specified representation (if given). Conversely,
-users of that signature will be able to rely on the type equation
-or type representation, if given. More precisely, we have the
-following four situations:
-
-\begin{description}
-\item[Abstract type: no equation, no representation.] ~ \\
-Names that are defined as abstract types in a signature can be
-implemented in a matching structure by any kind of type definition
-(provided it has the same number of type parameters). The exact
-implementation of the type will be hidden to the users of the
-structure. In particular, if the type is implemented as a variant type
-or record type, the associated constructors and fields will not be
-accessible to the users; if the type is implemented as an
-abbreviation, the type equality between the type name and the
-right-hand side of the abbreviation will be hidden from the users of the
-structure. Users of the structure consider that type as incompatible
-with any other type: a fresh type has been generated.
-
-\item[Type abbreviation: an equation @'=' typexpr@, no representation.] ~ \\
-The type name must be implemented by a type compatible with @typexpr@.
-All users of the structure know that the type name is
-compatible with @typexpr@.
-
-\item[New variant type or record type: no equation, a representation.] ~ \\
-The type name must be implemented by a variant type or record type
-with exactly the constructors or fields specified. All users of the
-structure have access to the constructors or fields, and can use them
-to create or inspect values of that type. However, users of the
-structure consider that type as incompatible with any other type: a
-fresh type has been generated.
-
-\item[Re-exported variant type or record type: an equation,
-a representation.] ~ \\
-This case combines the previous two: the representation of the type is
-made visible to all users, and no fresh type is generated.
-\end{description}
-
-\subsubsection*{sss:mty-exn}{Exception specification}
-
-\ikwd{exception\@\texttt{exception}}
-
-The specification @'exception' constr-decl@ in a signature requires the
-matching structure to provide an exception with the name and arguments
-specified in the definition, and makes the exception available to all
-users of the structure.
-
-\subsubsection*{sss:mty-class}{Class specifications}
-
-\ikwd{class\@\texttt{class}}
-
-A specification of one or several classes in a signature is written
-@'class' class-spec { 'and' class-spec }@ and consists of a sequence
-of mutually recursive definitions of class names.
-
-Class specifications are described more precisely in
-section~\ref{ss:class-spec}.
-
-\subsubsection*{sss:mty-classtype}{Class type specifications}
-
-\ikwd{class\@\texttt{class}}
-\ikwd{type\@\texttt{type}}
-
-A specification of one or several classe types in a signature is
-written @'class' 'type' classtype-def@ @{ 'and' classtype-def }@ and
-consists of a sequence of mutually recursive definitions of class type
-names. Class type specifications are described more precisely in
-section~\ref{ss:classtype}.
-
-\subsubsection*{sss:mty-module}{Module specifications}
-
-\ikwd{module\@\texttt{module}}
-
-A specification of a module component in a signature is written
-@'module' module-name ':' module-type@, where @module-name@ is the
-name of the module component and @module-type@ its expected type.
-Modules can be nested arbitrarily; in particular, functors can appear
-as components of structures and functor types as components of
-signatures.
-
-For specifying a module component that is a functor, one may write
-\begin{center}
-@'module' module-name '(' name_1 ':' module-type_1 ')'
- \ldots '(' name_n ':' module-type_n ')'
- ':' module-type@
-\end{center}
-instead of
-\begin{center}
-@'module' module-name ':'
- 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
- '->' module-type@
-\end{center}
-
-\subsubsection*{sss:mty-mty}{Module type specifications}
-
-\ikwd{type\@\texttt{type}}
-\ikwd{module\@\texttt{module}}
-
-A module type component of a signature can be specified either as a
-manifest module type or as an abstract module type.
-
-An abstract module type specification
-@'module' 'type' modtype-name@ allows the name @modtype-name@ to be
-implemented by any module type in a matching signature, but hides the
-implementation of the module type to all users of the signature.
-
-A manifest module type specification
-@'module' 'type' modtype-name '=' module-type@
-requires the name @modtype-name@ to be implemented by the module type
-@module-type@ in a matching signature, but makes the equality between
-@modtype-name@ and @module-type@ apparent to all users of the signature.
-
-\subsubsection{sss:mty-open}{Opening a module path}
-
-\ikwd{open\@\texttt{open}}
-
-The expression @'open' module-path@ in a signature does not specify
-any components. It simply affects the parsing of the following items
-of the signature, allowing components of the module denoted by
-@module-path@ to be referred to by their simple names @name@ instead of
-path accesses @module-path '.' name@. The scope of the @"open"@
-stops at the end of the signature expression.
-
-\subsubsection{sss:mty-include}{Including a signature}
-
-\ikwd{include\@\texttt{include}}
-
-The expression @'include' module-type@ in a signature performs textual
-inclusion of the components of the signature denoted by @module-type@.
-It behaves as if the components of the included signature were copied
-at the location of the @'include'@. The @module-type@ argument must
-refer to a module type that is a signature, not a functor type.
-
-\subsection{ss:mty-functors}{Functor types}
-
-\ikwd{functor\@\texttt{functor}}
-
-The module type expression
-@'functor' '(' module-name ':' module-type_1 ')' '->' module-type_2@
-is the type of functors (functions from modules to modules) that take
-as argument a module of type @module-type_1@ and return as result a
-module of type @module-type_2@. The module type @module-type_2@ can
-use the name @module-name@ to refer to type components of the actual
-argument of the functor. If the type @module-type_2@ does not
-depend on type components of @module-name@, the module type expression
-can be simplified with the alternative short syntax
-@ module-type_1 '->' module-type_2 @.
-No restrictions are placed on the type of the functor argument; in
-particular, a functor may take another functor as argument
-(``higher-order'' functor).
-
-\subsection{ss:mty-with}{The "with" operator}
-
-\ikwd{with\@\texttt{with}}
-
-Assuming @module-type@ denotes a signature, the expression
-@module-type 'with' mod-constraint@ @{ 'and' mod-constraint }@ denotes
-the same signature where type equations have been added to some of the
-type specifications, as described by the constraints following the
-"with" keyword. The constraint @'type' [type-parameters] typeconstr
-'=' typexpr@ adds the type equation @'=' typexpr@ to the specification
-of the type component named @typeconstr@ of the constrained signature.
-The constraint @'module' module-path '=' extended-module-path@ adds
-type equations to all type components of the sub-structure denoted by
-@module-path@, making them equivalent to the corresponding type
-components of the structure denoted by @extended-module-path@.
-
-For instance, if the module type name "S" is bound to the signature
-\begin{verbatim}
- sig type t module M: (sig type u end) end
-\end{verbatim}
-then "S with type t=int" denotes the signature
-\begin{verbatim}
- sig type t=int module M: (sig type u end) end
-\end{verbatim}
-and "S with module M = N" denotes the signature
-\begin{verbatim}
- sig type t module M: (sig type u=N.u end) end
-\end{verbatim}
-A functor taking two arguments of type "S" that share their "t" component
-is written
-\begin{verbatim}
- functor (A: S) (B: S with type t = A.t) ...
-\end{verbatim}
-
-Constraints are added left to right. After each constraint has been
-applied, the resulting signature must be a subtype of the signature
-before the constraint was applied. Thus, the @'with'@ operator can
-only add information on the type components of a signature, but never
-remove information.
+++ /dev/null
-\section{s:module-expr}{Module expressions (module implementations)}
-%HEVEA\cutname{modules.html}
-
-Module expressions are the module-level equivalent of value
-expressions: they evaluate to modules, thus providing implementations
-for the specifications expressed in module types.
-
-\ikwd{struct\@\texttt{struct}}
-\ikwd{end\@\texttt{end}}
-\ikwd{functor\@\texttt{functor}}
-\ikwd{let\@\texttt{let}}
-\ikwd{and\@\texttt{and}}
-\ikwd{external\@\texttt{external}}
-\ikwd{type\@\texttt{type}}
-\ikwd{exception\@\texttt{exception}}
-\ikwd{class\@\texttt{class}}
-\ikwd{module\@\texttt{module}}
-\ikwd{open\@\texttt{open}}
-\ikwd{include\@\texttt{include}}
-
-\begin{syntax}
-module-expr:
- module-path
- | 'struct' [ module-items ] 'end'
- | 'functor' '(' module-name ':' module-type ')' '->' module-expr
- | module-expr '(' module-expr ')'
- | '(' module-expr ')'
- | '(' module-expr ':' module-type ')'
-;
-module-items:
- {';;'} ( definition || expr ) { {';;'} ( definition || ';;' expr) } {';;'}
-;
-%\end{syntax} \begin{syntax}
-definition:
- 'let' ['rec'] let-binding { 'and' let-binding }
- | 'external' value-name ':' typexpr '=' external-declaration
- | type-definition
- | exception-definition
- | class-definition
- | classtype-definition
- | 'module' module-name { '(' module-name ':' module-type ')' }
- [ ':' module-type ] \\ '=' module-expr
- | 'module' 'type' modtype-name '=' module-type
- | 'open' module-path
- | 'include' module-expr
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:recursive-modules]{recursive modules},
-\hyperref[s:first-class-modules]{first-class modules},
-\hyperref[s:explicit-overriding-open]{overriding in open statements},
-\hyperref[s:attributes]{attributes},
-\hyperref[s:extension-nodes]{extension nodes} and
-\hyperref[s:generative-functors]{generative functors}.
-
-\subsection{ss:mexpr-simple}{Simple module expressions}
-
-The expression @module-path@ evaluates to the module bound to the name
-@module-path@.
-
-The expression @'(' module-expr ')'@ evaluates to the same module as
-@module-expr@.
-
-The expression @'(' module-expr ':' module-type ')'@ checks that the
-type of @module-expr@ is a subtype of @module-type@, that is, that all
-components specified in @module-type@ are implemented in
-@module-expr@, and their implementation meets the requirements given
-in @module-type@. In other terms, it checks that the implementation
-@module-expr@ meets the type specification @module-type@. The whole
-expression evaluates to the same module as @module-expr@, except that
-all components not specified in @module-type@ are hidden and can no
-longer be accessed.
-
-\subsection{ss:mexpr-structures}{Structures}
-
-\ikwd{struct\@\texttt{struct}}
-\ikwd{end\@\texttt{end}}
-
-Structures @'struct' \ldots 'end'@ are collections of definitions for
-value names, type names, exceptions, module names and module type
-names. The definitions are evaluated in the order in which they appear
-in the structure. The scopes of the bindings performed by the
-definitions extend to the end of the structure. As a consequence, a
-definition may refer to names bound by earlier definitions in the same
-structure.
-
-For compatibility with toplevel phrases (chapter~\ref{c:camllight}),
-optional @";;"@ are allowed after and before each definition in a structure. These
-@";;"@ have no semantic meanings. Similarly, an @expr@ preceded by ";;" is allowed as
-a component of a structure. It is equivalent to @'let' '_' '=' expr@, i.e. @expr@ is
-evaluated for its side-effects but is not bound to any identifier. If @expr@ is
-the first component of a structure, the preceding ";;" can be omitted.
-
-\subsubsection*{sss:mexpr-value-defs}{Value definitions}
-
-\ikwd{let\@\texttt{let}}
-
-A value definition @'let' ['rec'] let-binding { 'and' let-binding }@
-bind value names in the same way as a @'let' \ldots 'in' \ldots@ expression
-(see section~\ref{sss:expr-localdef}). The value names appearing in the
-left-hand sides of the bindings are bound to the corresponding values
-in the right-hand sides.
-
-\ikwd{external\@\texttt{external}}
-
-A value definition @'external' value-name ':' typexpr '=' external-declaration@
-implements @value-name@ as the external function specified in
-@external-declaration@ (see chapter~\ref{c:intf-c}).
-
-\subsubsection*{sss:mexpr-type-defs}{Type definitions}
-
-\ikwd{type\@\texttt{type}}
-
-A definition of one or several type components is written
-@'type' typedef { 'and' typedef }@ and consists of a sequence
-of mutually recursive definitions of type names.
-
-\subsubsection*{sss:mexpr-exn-defs}{Exception definitions}
-
-\ikwd{exception\@\texttt{exception}}
-
-Exceptions are defined with the syntax @'exception' constr-decl@
-or @'exception' constr-name '=' constr@.
-
-\subsubsection*{sss:mexpr-class-defs}{Class definitions}
-
-\ikwd{class\@\texttt{class}}
-
-A definition of one or several classes is written @'class'
-class-binding { 'and' class-binding }@ and consists of a sequence of
-mutually recursive definitions of class names. Class definitions are
-described more precisely in section~\ref{ss:class-def}.
-
-\subsubsection*{sss:mexpr-classtype-defs}{Class type definitions}
-
-\ikwd{class\@\texttt{class}}
-\ikwd{type\@\texttt{type}}
-
-A definition of one or several classes is written
-@'class' 'type' classtype-def { 'and' classtype-def }@ and consists of
-a sequence of mutually recursive definitions of class type names.
-Class type definitions are described more precisely in
-section~\ref{ss:classtype}.
-
-\subsubsection*{sss:mexpr-module-defs}{Module definitions}
-
-\ikwd{module\@\texttt{module}}
-
-The basic form for defining a module component is
-@'module' module-name '=' module-expr@, which evaluates @module-expr@ and binds
-the result to the name @module-name@.
-
-One can write
-\begin{center}
-@'module' module-name ':' module-type '=' module-expr@
-\end{center}
-instead of
-\begin{center}
-@'module' module-name '=' '(' module-expr ':' module-type ')'@.
-\end{center}
-Another derived form is
-\begin{center}
-@'module' module-name '(' name_1 ':' module-type_1 ')' \ldots
- '(' name_n ':' module-type_n ')' '=' module-expr@
-\end{center}
-which is equivalent to
-\begin{center}
-@'module' module-name '='
- 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
- '->' module-expr@
-\end{center}
-
-\subsubsection*{sss:mexpr-modtype-defs}{Module type definitions}
-
-\ikwd{type\@\texttt{type}}
-\ikwd{module\@\texttt{module}}
-
-A definition for a module type is written
-@'module' 'type' modtype-name '=' module-type@.
-It binds the name @modtype-name@ to the module type denoted by the
-expression @module-type@.
-
-\subsubsection*{sss:mexpr-open}{Opening a module path}
-
-\ikwd{open\@\texttt{open}}
-
-The expression @'open' module-path@ in a structure does not define any
-components nor perform any bindings. It simply affects the parsing of
-the following items of the structure, allowing components of the
-module denoted by @module-path@ to be referred to by their simple names
-@name@ instead of path accesses @module-path '.' name@. The scope of
-the @"open"@ stops at the end of the structure expression.
-
-\subsubsection*{sss:mexpr-include}{Including the components of another structure}
-
-\ikwd{include\@\texttt{include}}
-
-The expression @'include' module-expr@ in a structure re-exports in
-the current structure all definitions of the structure denoted by
-@module-expr@. For instance, if you define a module "S" as below
-\begin{caml_example*}{verbatim}
-module S = struct type t = int let x = 2 end
-\end{caml_example}
-defining the module "B" as
-\begin{caml_example*}{verbatim}
-module B = struct include S let y = (x + 1 : t) end
-\end{caml_example}
-is equivalent to defining it as
-\begin{caml_example*}{verbatim}
-module B = struct type t = S.t let x = S.x let y = (x + 1 : t) end
-\end{caml_example}
-The difference between @'open'@ and @'include'@ is that @'open'@
-simply provides short names for the components of the opened
-structure, without defining any components of the current structure,
-while @'include'@ also adds definitions for the components of the
-included structure.
-
-\subsection{ss:mexpr-functors}{Functors}
-
-\subsubsection*{sss:mexpr-functor-defs}{Functor definition}
-
-\ikwd{functor\@\texttt{functor}}
-
-The expression @'functor' '(' module-name ':' module-type ')' '->'
-module-expr@ evaluates to a functor that takes as argument modules of
-the type @module-type_1@, binds @module-name@ to these modules,
-evaluates @module-expr@ in the extended environment, and returns the
-resulting modules as results. No restrictions are placed on the type of the
-functor argument; in particular, a functor may take another functor as
-argument (``higher-order'' functor).
-
-\subsubsection*{sss:mexpr-functor-app}{Functor application}
-
-The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates
-@module-expr_1@ to a functor and @module-expr_2@ to a module, and
-applies the former to the latter. The type of @module-expr_2@ must
-match the type expected for the arguments of the functor @module-expr_1@.
-
+++ /dev/null
-\section{s:names}{Names}
-%HEVEA\cutname{names.html}
-
-Identifiers are used to give names to several classes of language
-objects and refer to these objects by name later:
-\begin{itemize}
-\item value names (syntactic class @value-name@),
-\item value constructors and exception constructors (class @constr-name@),
-\item labels (@label-name@, defined in section~\ref{sss:labelname}),
-\item polymorphic variant tags (@tag-name@),
-\item type constructors (@typeconstr-name@),
-\item record fields (@field-name@),
-\item class names (@class-name@),
-\item method names (@method-name@),
-\item instance variable names (@inst-var-name@),
-\item module names (@module-name@),
-\item module type names (@modtype-name@).
-\end{itemize}
-These eleven name spaces are distinguished both by the context and by the
-capitalization of the identifier: whether the first letter of the
-identifier is in lowercase (written @lowercase-ident@ below) or in
-uppercase (written @capitalized-ident@). Underscore is considered a
-lowercase letter for this purpose.
-
-\subsubsection*{sss:naming-objects}{Naming objects}
-\ikwd{mod\@\texttt{mod}}
-\ikwd{land\@\texttt{land}}
-\ikwd{lor\@\texttt{lor}}
-\ikwd{lxor\@\texttt{lxor}}
-\ikwd{lsl\@\texttt{lsl}}
-\ikwd{lsr\@\texttt{lsr}}
-\ikwd{asr\@\texttt{asr}}
-
-\begin{syntax}
-value-name:
- lowercase-ident
- | '(' operator-name ')'
-;
-operator-name:
- prefix-symbol || infix-op
-;
-infix-op:
- infix-symbol
- | '*' || '+' || '-' || '-.' || '=' || '!=' || '<' || '>' || 'or' || '||'
- || '&' || '&&' || ':='
- | 'mod' || 'land' || 'lor' || 'lxor' || 'lsl' || 'lsr' || 'asr'
-;
-constr-name:
- capitalized-ident
-;
-tag-name:
- capitalized-ident
-;
-typeconstr-name:
- lowercase-ident
-;
-field-name:
- lowercase-ident
-;
-module-name:
- capitalized-ident
-;
-modtype-name:
- ident
-;
-class-name:
- lowercase-ident
-;
-inst-var-name:
- lowercase-ident
-;
-method-name:
- lowercase-ident
-\end{syntax}
-See also the following language extension:
-\hyperref[s:index-operators]{extended indexing operators}.
-
-As shown above, prefix and infix symbols as well as some keywords can
-be used as value names, provided they are written between parentheses.
-The capitalization rules are summarized in the table below.
-
-\begin{tableau}{|l|l|}{Name space}{Case of first letter}
-\entree{Values}{lowercase}
-\entree{Constructors}{uppercase}
-\entree{Labels}{lowercase}
-\entree{Polymorphic variant tags}{uppercase}
-\entree{Exceptions}{uppercase}
-\entree{Type constructors}{lowercase}
-\entree{Record fields}{lowercase}
-\entree{Classes}{lowercase}
-\entree{Instance variables}{lowercase}
-\entree{Methods}{lowercase}
-\entree{Modules}{uppercase}
-\entree{Module types}{any}
-\end{tableau}
-
-{\it Note on polymorphic variant tags:\/} the current implementation accepts
-lowercase variant tags in addition to capitalized variant tags, but we
-suggest you avoid lowercase variant tags for portability and
-compatibility with future OCaml versions.
-
-\subsubsection*{sss:refer-named}{Referring to named objects}
-
-\begin{syntax}
-value-path:
- [ module-path '.' ] value-name
-;
-constr:
- [ module-path '.' ] constr-name
-;
-typeconstr:
- [ extended-module-path '.' ] typeconstr-name
-;
-field:
- [ module-path '.' ] field-name
-;
-modtype-path:
- [ extended-module-path '.' ] modtype-name
-;
-class-path:
- [ module-path '.' ] class-name
-;
-classtype-path:
- [ extended-module-path '.' ] class-name
-;
-module-path:
- module-name { '.' module-name }
-;
-extended-module-path:
- extended-module-name { '.' extended-module-name }
-;
-extended-module-name:
- module-name { '(' extended-module-path ')' }
-\end{syntax}
-
-A named object can be referred to either by its name (following the
-usual static scoping rules for names) or by an access path @prefix '.' name@,
-where @prefix@ designates a module and @name@ is the name of an object
-defined in that module. The first component of the path, @prefix@, is
-either a simple module name or an access path @name_1 '.' name_2 \ldots@,
-in case the defining module is itself nested inside other modules.
-For referring to type constructors, module types, or class types,
-the @prefix@ can
-also contain simple functor applications (as in the syntactic class
-@extended-module-path@ above) in case the defining module is the
-result of a functor application.
-
-Label names, tag names, method names and instance variable names need
-not be qualified: the former three are global labels, while the latter
-are local to a class.
+++ /dev/null
-\section{s:patterns}{Patterns}
-\ikwd{as\@\texttt{as}}
-%HEVEA\cutname{patterns.html}
-\begin{syntax}
-pattern:
- value-name
- | '_'
- | constant
- | pattern 'as' value-name
- | '(' pattern ')'
- | '(' pattern ':' typexpr ')'
- | pattern '|' pattern
- | constr pattern
- | "`"tag-name pattern
- | "#"typeconstr
- | pattern {{ ',' pattern }}
- | '{' field [':' typexpr] ['=' pattern]%
- { ';' field [':' typexpr] ['=' pattern] } [';' '_' ] [ ';' ] '}'
- | '[' pattern { ';' pattern } [ ';' ] ']'
- | pattern '::' pattern
- | '[|' pattern { ';' pattern } [ ';' ] '|]'
- | char-literal '..' char-literal
- | 'lazy' pattern
- | 'exception' pattern
- | module-path '.(' pattern ')'
- | module-path '.[' pattern ']'
- | module-path '.[|' pattern '|]'
- | module-path '.{' pattern '}'
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:first-class-modules]{first-class modules},
-\hyperref[s:attributes]{attributes} and
-\hyperref[s:extension-nodes]{extension nodes}.
-
-The table below shows the relative precedences and associativity of
-operators and non-closed pattern constructions. The constructions with
-higher precedences come first.
-\ikwd{as\@\texttt{as}}
-\begin{tableau}{|l|l|}{Operator}{Associativity}
-\entree{".."}{--}
-\entree{"lazy" (see section~\ref{sss:pat-lazy})}{--}
-\entree{Constructor application, Tag application}{right}
-\entree{"::"}{right}
-\entree{","}{--}
-\entree{"|"}{left}
-\entree{"as"}{--}
-\end{tableau}
-
-Patterns are templates that allow selecting data structures of a
-given shape, and binding identifiers to components of the data
-structure. This selection operation is called pattern matching; its
-outcome is either ``this value does not match this pattern'', or
-``this value matches this pattern, resulting in the following bindings
-of names to values''.
-
-\subsubsection*{sss:pat-variable}{Variable patterns}
-
-A pattern that consists in a value name matches any value,
-binding the name to the value. The pattern @"_"@ also matches
-any value, but does not bind any name.
-
-Patterns are {\em linear\/}: a variable cannot be bound several times by
-a given pattern. In particular, there is no way to test for equality
-between two parts of a data structure using only a pattern (but
-@"when"@ guards can be used for this purpose).
-
-\subsubsection*{sss:pat-const}{Constant patterns}
-
-A pattern consisting in a constant matches the values that
-are equal to this constant.
-
-%% FIXME for negative numbers, blanks are allowed between the minus
-%% sign and the first digit.
-
-\subsubsection*{sss:pat-alias}{Alias patterns}
-\ikwd{as\@\texttt{as}}
-
-The pattern @pattern_1 "as" value-name@ matches the same values as
-@pattern_1@. If the matching against @pattern_1@ is successful,
-the name @value-name@ is bound to the matched value, in addition to the
-bindings performed by the matching against @pattern_1@.
-
-\subsubsection*{sss:pat-parenthesized}{Parenthesized patterns}
-
-The pattern @"(" pattern_1 ")"@ matches the same values as
-@pattern_1@. A type constraint can appear in a
-parenthesized pattern, as in @"(" pattern_1 ":" typexpr ")"@. This
-constraint forces the type of @pattern_1@ to be compatible with
-@typexpr@.
-
-\subsubsection*{sss:pat-or}{``Or'' patterns}
-
-The pattern @pattern_1 "|" pattern_2@ represents the logical ``or'' of
-the two patterns @pattern_1@ and @pattern_2@. A value matches
-@pattern_1 "|" pattern_2@ if it matches @pattern_1@ or
-@pattern_2@. The two sub-patterns @pattern_1@ and @pattern_2@
-must bind exactly the same identifiers to values having the same types.
-Matching is performed from left to right.
-More precisely,
-in case some value~$v$ matches @pattern_1 "|" pattern_2@, the bindings
-performed are those of @pattern_1@ when $v$ matches @pattern_1@.
-Otherwise, value~$v$ matches @pattern_2@ whose bindings are performed.
-
-
-\subsubsection*{sss:pat-variant}{Variant patterns}
-
-The pattern @constr '(' pattern_1 ',' \ldots ',' pattern_n ')'@ matches
-all variants whose
-constructor is equal to @constr@, and whose arguments match
-@pattern_1 \ldots pattern_n@. It is a type error if $n$ is not the
-number of arguments expected by the constructor.
-
-The pattern @constr '_'@ matches all variants whose constructor is
-@constr@.
-
-The pattern @pattern_1 "::" pattern_2@ matches non-empty lists whose
-heads match @pattern_1@, and whose tails match @pattern_2@.
-
-The pattern @"[" pattern_1 ";" \ldots ";" pattern_n "]"@ matches lists
-of length $n$ whose elements match @pattern_1@ \ldots @pattern_n@,
-respectively. This pattern behaves like
-@pattern_1 "::" \ldots "::" pattern_n "::" "[]"@.
-
-\subsubsection*{sss:pat-polyvar}{Polymorphic variant patterns}
-
-The pattern @"`"tag-name pattern_1@ matches all polymorphic variants
-whose tag is equal to @tag-name@, and whose argument matches
-@pattern_1@.
-
-\subsubsection*{sss:pat-polyvar-abbrev}{Polymorphic variant abbreviation patterns}
-
-If the type @["('a,'b,"\ldots")"] typeconstr = "[" "`"tag-name_1 typexpr_1 "|"
-\ldots "|" "`"tag-name_n typexpr_n"]"@ is defined, then the pattern @"#"typeconstr@
-is a shorthand for the following or-pattern:
-@"(" "`"tag-name_1"(_" ":" typexpr_1")" "|" \ldots "|" "`"tag-name_n"(_"
-":" typexpr_n"))"@. It matches all values of type @"[<" typeconstr "]"@.
-
-\subsubsection*{sss:pat-tuple}{Tuple patterns}
-
-The pattern @pattern_1 "," \ldots "," pattern_n@ matches $n$-tuples
-whose components match the patterns @pattern_1@ through @pattern_n@. That
-is, the pattern matches the tuple values $(v_1, \ldots, v_n)$ such that
-@pattern_i@ matches $v_i$ for \fromoneto{i}{n}.
-
-\subsubsection*{sss:pat-record}{Record patterns}
-
-The pattern @"{" field_1 ["=" pattern_1] ";" \ldots ";" field_n ["="
-pattern_n] "}"@ matches records that define at least the fields
-@field_1@ through @field_n@, and such that the value associated to
-@field_i@ matches the pattern @pattern_i@, for \fromoneto{i}{n}.
-A single identifier @field_k@ stands for @field_k '=' field_k @,
-and a single qualified identifier @module-path '.' field_k@ stands
-for @module-path '.' field_k '=' field_k @.
-The record value can define more fields than @field_1@ \ldots
-@field_n@; the values associated to these extra fields are not taken
-into account for matching. Optionally, a record pattern can be terminated
-by @';' '_'@ to convey the fact that not all fields of the record type are
-listed in the record pattern and that it is intentional.
-Optional type constraints can be added field by field with
-@"{" field_1 ":" typexpr_1 "=" pattern_1 ";"%
-\ldots ";"field_n ":" typexpr_n "=" pattern_n "}"@ to force the type
-of @field_k@ to be compatible with @typexpr_k@.
-
-
-\subsubsection*{sss:pat-array}{Array patterns}
-
-The pattern @"[|" pattern_1 ";" \ldots ";" pattern_n "|]"@
-matches arrays of length $n$ such that the $i$-th array element
-matches the pattern @pattern_i@, for \fromoneto{i}{n}.
-
-\subsubsection*{sss:pat-range}{Range patterns}
-
-The pattern
-@"'" @c@ "'" ".." "'" @d@ "'"@ is a shorthand for the pattern
-\begin{center}
-@"'" @c@ "'" "|" "'" @c@_1 "'" "|" "'" @c@_2 "'" "|" \ldots
- "|" "'" @c@_n "'" "|" "'" @d@ "'"@
-\end{center}
-where \nth{c}{1}, \nth{c}{2}, \ldots, \nth{c}{n} are the characters
-that occur between \var{c} and \var{d} in the ASCII character set. For
-instance, the pattern "'0'"@'..'@"'9'" matches all characters that are digits.
-
-\subsubsection{sss:pat-lazy}{Lazy patterns}
-
-\ikwd{lazy\@\texttt{lazy}}
-
-(Introduced in Objective Caml 3.11)
-
-\begin{syntax}
-pattern: ...
-\end{syntax}
-
-The pattern @"lazy" pattern@ matches a value \var{v} of type "Lazy.t",
-provided @pattern@ matches the result of forcing \var{v} with
-"Lazy.force". A successful match of a pattern containing @"lazy"@
-sub-patterns forces the corresponding parts of the value being matched, even
-those that imply no test such as @"lazy" value-name@ or @"lazy" "_"@.
-Matching a value with a @pattern-matching@ where some patterns
-contain @"lazy"@ sub-patterns may imply forcing parts of the value,
-even when the pattern selected in the end has no @"lazy"@ sub-pattern.
-
-For more information, see the description of module "Lazy" in the
-standard library (module \stdmoduleref{Lazy}).
-%
-\index{Lazy (module)\@\verb`Lazy` (module)}%
-\index{force\@\verb`force`}%
-
-\subsubsection*{sss:exception-match}{Exception patterns}
-(Introduced in OCaml 4.02)
-
-A new form of exception pattern, @ 'exception' pattern @, is allowed
-only as a toplevel pattern or inside a toplevel or-pattern under
-a "match"..."with" pattern-matching
-(other occurrences are rejected by the type-checker).
-
-Cases with such a toplevel pattern are called ``exception cases'',
-as opposed to regular ``value cases''. Exception cases are applied
-when the evaluation of the matched expression raises an exception.
-The exception value is then matched against all the exception cases
-and re-raised if none of them accept the exception (as with a
-"try"..."with" block). Since the bodies of all exception and value
-cases are outside the scope of the exception handler, they are all
-considered to be in tail-position: if the "match"..."with" block
-itself is in tail position in the current function, any function call
-in tail position in one of the case bodies results in an actual tail
-call.
-
-A pattern match must contain at least one value case. It is an error if
-all cases are exceptions, because there would be no code to handle
-the return of a value.
-
-\subsubsection*{sss:pat-open}{Local opens for patterns}
-\ikwd{open\@\texttt{open}}
-(Introduced in OCaml 4.04)
-
-For patterns, local opens are limited to the
-@module-path'.('pattern')'@ construction. This
-construction locally opens the module referred to by the module path
-@module-path@ in the scope of the pattern @pattern@.
-
-When the body of a local open pattern is delimited by
-@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
-For example, @module-path'.['pattern']'@ is equivalent to
-@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is
-equivalent to @module-path'.([|' pattern '|])'@.
+++ /dev/null
-\chapter{The OCaml language} \label{c:refman}
-%HEVEA\cutname{language.html}
-
-%better html output that way, sniff.
-%HEVEA\subsection*{ss:foreword}{Foreword}
-%BEGIN LATEX
-\section*{s:foreword}{Foreword}
-%END LATEX
-
-This document is intended as a reference manual for the OCaml
-language. It lists the language constructs, and gives their precise
-syntax and informal semantics. It is by no means a tutorial
-introduction to the language: there is not a single example. A good
-working knowledge of OCaml is assumed.
-
-No attempt has been made at mathematical rigor: words are employed
-with their intuitive meaning, without further definition. As a
-consequence, the typing rules have been left out, by lack of the
-mathematical framework required to express them, while they are
-definitely part of a full formal definition of the language.
-
-
-\subsection*{ss:notations}{Notations}
-
-The syntax of the language is given in BNF-like notation. Terminal
-symbols are set in typewriter font (@'like' 'this'@).
-Non-terminal symbols are set in italic font (@like that@).
-Square brackets @[\ldots]@ denote optional components. Curly brackets
-@{\ldots}@ denotes zero, one or several repetitions of the enclosed
-components. Curly brackets with a trailing plus sign @{{\ldots}}@
-denote one or several repetitions of the enclosed components.
-Parentheses @(\ldots)@ denote grouping.
-
-%HEVEA\cutdef{section}
-\input{lex}
-\input{values}
-\input{names}
-\input{types}
-\input{const}
-\input{patterns}
-\input{expr}
-\input{typedecl}
-\input{classes}
-\input{modtypes}
-\input{modules}
-\input{compunit}
-%HEVEA\cutend
+++ /dev/null
-\section{s:tydef}{Type and exception definitions}
-%HEVEA\cutname{typedecl.html}%
-
-\subsection{ss:typedefs}{Type definitions}
-
-Type definitions bind type constructors to data types: either
-variant types, record types, type abbreviations, or abstract data
-types. They also bind the value constructors and record fields
-associated with the definition.
-
-\ikwd{type\@\texttt{type}}
-\ikwd{and\@\texttt{and}}
-\ikwd{nonrec\@\texttt{nonrec}}
-\ikwd{of\@\texttt{of}}
-
-\begin{syntax}
-type-definition:
- 'type' ['nonrec'] typedef { 'and' typedef }
-;
-typedef:
- [type-params] typeconstr-name type-information
-;
-type-information:
- [type-equation] [type-representation] { type-constraint }
-;
-type-equation:
- '=' typexpr
-;
-type-representation:
- '=' ['|'] constr-decl { '|' constr-decl }
- | '=' record-decl
- | '=' '|'
-;
-type-params:
- type-param
- | '(' type-param { "," type-param } ')'
-;
-type-param:
- [ext-variance] "'" ident
-;
-ext-variance:
- variance [injectivity]
- | injectivity [variance]
-;
-variance:
- '+'
- | '-'
-;
-injectivity: '!'
-;
-record-decl:
- '{' field-decl { ';' field-decl } [';'] '}'
-;
-constr-decl:
- (constr-name || '[]' || '(::)') [ 'of' constr-args ]
-;
-constr-args:
- typexpr { '*' typexpr }
-;
-field-decl:
- ['mutable'] field-name ':' poly-typexpr
-;
-type-constraint:
- 'constraint' typexpr '=' typexpr
-\end{syntax}
-\ikwd{mutable\@\texttt{mutable}}
-\ikwd{constraint\@\texttt{constraint}}
-See also the following language extensions:
-\hyperref[s:private-types]{private types},
-\hyperref[s:gadts]{generalized algebraic datatypes},
-\hyperref[s:attributes]{attributes},
-\hyperref[s:extension-nodes]{extension nodes},
-\hyperref[s:extensible-variants]{extensible variant types} and
-\hyperref[s:inline-records]{inline records}.
-
-Type definitions are introduced by the "type" keyword, and
-consist in one or several simple definitions, possibly mutually
-recursive, separated by the "and" keyword. Each simple definition
-defines one type constructor.
-
-A simple definition consists in a lowercase identifier, possibly
-preceded by one or several type parameters, and followed by an
-optional type equation, then an optional type representation, and then
-a constraint clause. The identifier is the name of the type
-constructor being defined.
-
-In the right-hand side of type definitions, references to one of the
-type constructor name being defined are considered as recursive,
-unless "type" is followed by "nonrec". The "nonrec" keyword was
-introduced in OCaml 4.02.2.
-
-The optional type parameters are either one type variable @"'" ident@,
-for type constructors with one parameter, or a list of type variables
-@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
-parameters. Each type parameter may be prefixed by a variance
-constraint @"+"@ (resp. @"-"@) indicating that the parameter is
-covariant (resp. contravariant), and an injectivity annotation @"!"@
-indicating that the parameter can be deduced from the whole type.
-These type parameters can appear in
-the type expressions of the right-hand side of the definition,
-optionally restricted by a variance constraint ; {\em i.e.\/} a
-covariant parameter may only appear on the right side of a functional
-arrow (more precisely, follow the left branch of an even number of
-arrows), and a contravariant parameter only the left side (left branch of
-an odd number of arrows). If the type has a representation or
-an equation, and the parameter is free ({\em i.e.\/} not bound via a
-type constraint to a constructed type), its variance constraint is
-checked but subtyping {\em etc.\/} will use the inferred variance of the
-parameter, which may be less restrictive; otherwise ({\em i.e.\/} for abstract
-types or non-free parameters), the variance must be given explicitly,
-and the parameter is invariant if no variance is given.
-
-The optional type equation @'=' typexpr@ makes the defined type
-equivalent to the type expression @typexpr@:
-one can be substituted for the other during typing.
-If no type equation is given, a new type is generated: the defined type
-is incompatible with any other type.
-
-The optional type representation describes the data structure
-representing the defined type, by giving the list of associated
-constructors (if it is a variant type) or associated fields (if it is
-a record type). If no type representation is given, nothing is
-assumed on the structure of the type besides what is stated in the
-optional type equation.
-
-The type representation @'=' ['|'] constr-decl { '|' constr-decl }@
-describes a variant type. The constructor declarations
-@constr-decl_1, \ldots, constr-decl_n@ describe the constructors
-associated to this variant type. The constructor
-declaration @constr-name 'of' typexpr_1 '*' \ldots '*' typexpr_n@
-declares the name @constr-name@ as a non-constant constructor, whose
-arguments have types @typexpr_1@ \ldots @typexpr_n@.
-The constructor declaration @constr-name@
-declares the name @constr-name@ as a constant
-constructor. Constructor names must be capitalized.
-
-The type representation @'=' '{' field-decl { ';' field-decl } [';'] '}'@
-describes a record type. The field declarations @field-decl_1, \ldots,
-field-decl_n@ describe the fields associated to this record type.
-The field declaration @field-name ':' poly-typexpr@ declares
-@field-name@ as a field whose argument has type @poly-typexpr@.
-The field declaration @'mutable' field-name ':' poly-typexpr@
-\ikwd{mutable\@\texttt{mutable}}
-behaves similarly; in addition, it allows physical modification of
-this field.
-Immutable fields are covariant, mutable fields are non-variant.
-Both mutable and immutable fields may have explicitly polymorphic
-types. The polymorphism of the contents is statically checked whenever
-a record value is created or modified. Extracted values may have their
-types instantiated.
-
-The two components of a type definition, the optional equation and the
-optional representation, can be combined independently, giving
-rise to four typical situations:
-
-\begin{description}
-\item[Abstract type: no equation, no representation.] ~\\
-When appearing in a module signature, this definition specifies
-nothing on the type constructor, besides its number of parameters:
-its representation is hidden and it is assumed incompatible with any
-other type.
-
-\item[Type abbreviation: an equation, no representation.] ~\\
-This defines the type constructor as an abbreviation for the type
-expression on the right of the @'='@ sign.
-
-\item[New variant type or record type: no equation, a representation.] ~\\
-This generates a new type constructor and defines associated
-constructors or fields, through which values of that type can be
-directly built or inspected.
-
-\item[Re-exported variant type or record type: an equation,
-a representation.] ~\\
-In this case, the type constructor is defined as an abbreviation for
-the type expression given in the equation, but in addition the
-constructors or fields given in the representation remain attached to
-the defined type constructor. The type expression in the equation part
-must agree with the representation: it must be of the same kind
-(record or variant) and have exactly the same constructors or fields,
-in the same order, with the same arguments. Moreover, the new type
-constructor must have the same arity and the same type constraints as the
-original type constructor.
-\end{description}
-
-The type variables appearing as type parameters can optionally be
-prefixed by "+" or "-" to indicate that the type constructor is
-covariant or contravariant with respect to this parameter. This
-variance information is used to decide subtyping relations when
-checking the validity of @":>"@ coercions
-(see section \ref{ss:expr-coercions}).
-
-For instance, "type +'a t" declares "t" as an abstract type that is
-covariant in its parameter; this means that if the type $\tau$ is a
-subtype of the type $\sigma$, then $\tau " t"$ is a subtype of $\sigma
-" t"$. Similarly, "type -'a t" declares that the abstract type "t" is
-contravariant in its parameter: if $\tau$ is a subtype of $\sigma$, then
-$\sigma " t"$ is a subtype of $\tau " t"$. If no "+" or "-" variance
-annotation is given, the type constructor is assumed non-variant in the
-corresponding parameter. For instance, the abstract type declaration
-"type 'a t" means that $\tau " t"$ is neither a subtype nor a
-supertype of $\sigma " t"$ if $\tau$ is subtype of $\sigma$.
-
-The variance indicated by the "+" and "-" annotations on parameters
-is enforced only for abstract and private types, or when there are
-type constraints.
-Otherwise, for abbreviations, variant and record types without type
-constraints, the variance properties of the type constructor
-are inferred from its definition, and the variance annotations are
-only checked for conformance with the definition.
-
-Injectivity annotations are only necessary for abstract types and
-private row types, since they can otherwise be deduced from the type
-declaration: all parameters are injective for record and variant type
-declarations (including extensible types); for type abbreviations a
-parameter is injective if it has an injective occurrence in its
-defining equation (be it private or not). For constrained type
-parameters in type abbreviations, they are injective if either they
-appear at an injective position in the body, or if all their type
-variables are injective; in particular, if a constrained type
-parameter contains a variable that doesn't appear in the body, it
-cannot be injective.
-
-\ikwd{constraint\@\texttt{constraint}}
-The construct @ 'constraint' "'" ident '=' typexpr @ allows the
-specification of
-type parameters. Any actual type argument corresponding to the type
-parameter @ident@ has to be an instance of @typexpr@ (more precisely,
-@ident@ and @typexpr@ are unified). Type variables of @typexpr@ can
-appear in the type equation and the type declaration.
-
-\subsection{ss:exndef}{Exception definitions}
-\ikwd{exception\@\texttt{exception}}
-
-\begin{syntax}
-exception-definition:
- 'exception' constr-decl
- | 'exception' constr-name '=' constr
-\end{syntax}
-
-Exception definitions add new constructors to the built-in variant
-type \verb"exn" of exception values. The constructors are declared as
-for a definition of a variant type.
-
-The form @'exception' constr-decl@
-generates a new exception, distinct from all other exceptions in the system.
-The form @'exception' constr-name '=' constr@
-gives an alternate name to an existing exception.
+++ /dev/null
-\section{s:typexpr}{Type expressions}
-%HEVEA\cutname{types.html}
-\ikwd{as\@\texttt{as}}
-
-\begin{syntax}
-typexpr:
- "'" ident
- | "_"
- | '(' typexpr ')'
- | [['?']label-name':'] typexpr '->' typexpr
- | typexpr {{ '*' typexpr }}
- | typeconstr
- | typexpr typeconstr
- | '(' typexpr { ',' typexpr } ')' typeconstr
- | typexpr 'as' "'" ident
- | polymorphic-variant-type
- | '<' ['..'] '>'
- | '<' method-type { ';' method-type } [';' || ';' '..'] '>'
- | '#' classtype-path
- | typexpr '#' class-path
- | '(' typexpr { ',' typexpr } ')' '#' class-path
-;
-poly-typexpr:
- typexpr
- | {{ "'" ident }} '.' typexpr
-;
-method-type:
- method-name ':' poly-typexpr
-\end{syntax}
-See also the following language extensions:
-\hyperref[s:first-class-modules]{first-class modules},
-\hyperref[s:attributes]{attributes} and
-\hyperref[s:extension-nodes]{extension nodes}.
-
-The table below shows the relative precedences and associativity of
-operators and non-closed type constructions. The constructions with
-higher precedences come first.
-\ikwd{as\@\texttt{as}}
-\begin{tableau}{|l|l|}{Operator}{Associativity}
-\entree{Type constructor application}{--}
-\entree{"#"}{--}
-\entree{"*"}{--}
-\entree{"->"}{right}
-\entree{"as"}{--}
-\end{tableau}
-
-Type expressions denote types in definitions of data types as well as
-in type constraints over patterns and expressions.
-
-\subsubsection*{sss:typexpr-variables}{Type variables}
-
-The type expression @"'" ident@ stands for the type variable named
-@ident@. The type expression @"_"@ stands for either an anonymous type
-variable or anonymous type parameters. In data type definitions, type
-variables are names for the data type parameters. In type constraints,
-they represent unspecified types that can be instantiated by any type
-to satisfy the type constraint. In general the scope of a named type
-variable is the whole top-level phrase where it appears, and it can
-only be generalized when leaving this scope. Anonymous variables have
-no such restriction. In the following cases, the scope of named type
-variables is restricted to the type expression where they appear:
-1) for universal (explicitly polymorphic) type variables;
-2) for type variables that only appear in public method specifications
-(as those variables will be made universal, as described in
-section~\ref{sss:clty-meth});
-3) for variables used as aliases, when the type they are aliased to
-would be invalid in the scope of the enclosing definition ({\it i.e.}
-when it contains free universal type variables, or locally
-defined types.)
-
-\subsubsection*{sss:typexr:parenthesized}{Parenthesized types}
-
-The type expression @"(" typexpr ")"@ denotes the same type as
-@typexpr@.
-
-\subsubsection*{sss:typexr-fun}{Function types}
-
-The type expression @typexpr_1 '->' typexpr_2@ denotes the type of
-functions mapping arguments of type @typexpr_1@ to results of type
-@typexpr_2@.
-
-@label-name ':' typexpr_1 '->' typexpr_2@ denotes the same function type, but
-the argument is labeled @label@.
-
-@'?' label-name ':' typexpr_1 '->' typexpr_2@ denotes the type of functions
-mapping an optional labeled argument of type @typexpr_1@ to results of
-type @typexpr_2@. That is, the physical type of the function will be
-@typexpr_1 "option" '->' typexpr_2@.
-
-\subsubsection*{sss:typexpr-tuple}{Tuple types}
-
-The type expression @typexpr_1 '*' \ldots '*' typexpr_n@
-denotes the type of tuples whose elements belong to types @typexpr_1,
-\ldots typexpr_n@ respectively.
-
-\subsubsection*{sss:typexpr-constructed}{Constructed types}
-
-Type constructors with no parameter, as in @typeconstr@, are type
-expressions.
-
-The type expression @typexpr typeconstr@, where @typeconstr@ is a type
-constructor with one parameter, denotes the application of the unary type
-constructor @typeconstr@ to the type @typexpr@.
-
-The type expression @(typexpr_1,\ldots,typexpr_n) typeconstr@, where
-@typeconstr@ is a type constructor with $n$ parameters, denotes the
-application of the $n$-ary type constructor @typeconstr@ to the types
-@typexpr_1@ through @typexpr_n@.
-
-In the type expression @ "_" typeconstr @, the anonymous type expression
-@ "_" @ stands in for anonymous type parameters and is equivalent to
-@ ("_", \ldots,"_") @ with as many repetitions of "_" as the arity of
-@typeconstr@.
-
-\subsubsection*{sss:typexpr-aliased-recursive}{Aliased and recursive types}
-
-\ikwd{as\@\texttt{as}}
-
-The type expression @typexpr 'as' "'" ident@ denotes the same type as
-@typexpr@, and also binds the type variable @ident@ to type @typexpr@ both
-in @typexpr@ and in other types. In general the scope of an alias is
-the same as for a named type variable, and covers the whole enclosing
-definition. If the type variable
-@ident@ actually occurs in @typexpr@, a recursive type is created. Recursive
-types for which there exists a recursive path that does not contain
-an object or polymorphic variant type constructor are rejected, except
-when the "-rectypes" mode is selected.
-
-If @"'" ident@ denotes an explicit polymorphic variable, and @typexpr@
-denotes either an object or polymorphic variant type, the row variable
-of @typexpr@ is captured by @"'" ident@, and quantified upon.
-
-\subsubsection*{sss:typexpr-polyvar}{Polymorphic variant types}
-\ikwd{of\@\texttt{of}}
-
-\begin{syntax}
-polymorphic-variant-type:
- '[' tag-spec-first { '|' tag-spec } ']'
- | '[>' [ tag-spec ] { '|' tag-spec } ']'
- | '[<' ['|'] tag-spec-full { '|' tag-spec-full }
- [ '>' {{ '`'tag-name }} ] ']'
-;
-%\end{syntax} \begin{syntax}
-tag-spec-first:
- '`'tag-name [ 'of' typexpr ]
- | [ typexpr ] '|' tag-spec
-;
-tag-spec:
- '`'tag-name [ 'of' typexpr ]
- | typexpr
-;
-tag-spec-full:
- '`'tag-name [ 'of' ['&'] typexpr { '&' typexpr } ]
- | typexpr
-\end{syntax}
-
-Polymorphic variant types describe the values a polymorphic variant
-may take.
-
-The first case is an exact variant type: all possible tags are
-known, with their associated types, and they can all be present.
-Its structure is fully known.
-
-The second case is an open variant type, describing a polymorphic
-variant value: it gives the list of all tags the value could take,
-with their associated types. This type is still compatible with a
-variant type containing more tags. A special case is the unknown
-type, which does not define any tag, and is compatible with any
-variant type.
-
-The third case is a closed variant type. It gives information about
-all the possible tags and their associated types, and which tags are
-known to potentially appear in values. The exact variant type (first
-case) is
-just an abbreviation for a closed variant type where all possible tags
-are also potentially present.
-
-In all three cases, tags may be either specified directly in the
-@'`'tag-name ["of" typexpr]@ form, or indirectly through a type
-expression, which must expand to an
-exact variant type, whose tag specifications are inserted in its
-place.
-
-Full specifications of variant tags are only used for non-exact closed
-types. They can be understood as a conjunctive type for the argument:
-it is intended to have all the types enumerated in the
-specification.
-
-Such conjunctive constraints may be unsatisfiable. In such a case the
-corresponding tag may not be used in a value of this type. This
-does not mean that the whole type is not valid: one can still use
-other available tags.
-Conjunctive constraints are mainly intended as output from the type
-checker. When they are used in source programs, unsolvable constraints
-may cause early failures.
-
-\subsubsection*{sss:typexpr-obj}{Object types}
-
-An object type
-@'<' [method-type { ';' method-type }] '>'@
-is a record of method types.
-
-Each method may have an explicit polymorphic type: @{{ "'" ident }}
-'.' typexpr@. Explicit polymorphic variables have a local scope, and
-an explicit polymorphic type can only be unified to an
-equivalent one, where only the order and names of polymorphic
-variables may change.
-
-The type @'<' {method-type ';'} '..' '>'@ is the
-type of an object whose method names and types are described by
-@method-type_1, \ldots, method-type_n@, and possibly some other
-methods represented by the ellipsis. This ellipsis actually is
-a special kind of type variable (called {\em row variable} in the
-literature) that stands for any number of extra method types.
-
-\subsubsection*{sss:typexpr-sharp-types}{\#-types}
-
-The type @'#' classtype-path@ is a special kind of abbreviation. This
-abbreviation unifies with the type of any object belonging to a subclass
-of the class type @classtype-path@.
-%
-It is handled in a special way as it usually hides a type variable (an
-ellipsis, representing the methods that may be added in a subclass).
-In particular, it vanishes when the ellipsis gets instantiated.
-%
-Each type expression @'#' classtype-path@ defines a new type variable, so
-type @'#' classtype-path '->' '#' classtype-path@ is usually not the same as
-type @('#' classtype-path 'as' "'" ident) '->' "'" ident@.
-%
-
-Use of \#-types to abbreviate polymorphic variant types is deprecated.
-If @@t@@ is an exact variant type then @"#"@t@@ translates to @"[<" @t@"]"@,
-and @"#"@t@"[>" "`"tag_1 \dots"`"tag_k"]"@ translates to
-@"[<" @t@ ">" "`"tag_1 \dots"`"tag_k"]"@
-
-\subsubsection*{sss:typexpr-variant-record}{Variant and record types}
-
-There are no type expressions describing (defined) variant types nor
-record types, since those are always named, i.e. defined before use
-and referred to by name. Type definitions are described in
-section~\ref{ss:typedefs}.
+++ /dev/null
-\section{s:values}{Values}
-%HEVEA\cutname{values.html}
-
-This section describes the kinds of values that are manipulated by
-OCaml programs.
-
-\subsection{ss:values:base}{Base values}
-
-\subsubsection*{sss:values:integer}{Integer numbers}
-
-Integer values are integer numbers from $-2^{30}$ to $2^{30}-1$, that
-is $-1073741824$ to $1073741823$. The implementation may support a
-wider range of integer values: on 64-bit platforms, the current
-implementation supports integers ranging from $-2^{62}$ to $2^{62}-1$.
-
-\subsubsection*{sss:values:float}{Floating-point numbers}
-
-Floating-point values are numbers in floating-point representation.
-The current implementation uses double-precision floating-point
-numbers conforming to the IEEE 754 standard, with 53 bits of mantissa
-and an exponent ranging from $-1022$ to $1023$.
-
-\subsubsection*{sss:values:char}{Characters}
-
-Character values are represented as 8-bit integers between 0 and 255.
-Character codes between 0 and 127 are interpreted following the ASCII
-standard. The current implementation interprets character codes
-between 128 and 255 following the ISO 8859-1 standard.
-
-\subsubsection*{sss:values:string}{Character strings}
-
-String values are finite sequences of characters. The current
-implementation supports strings containing up to $2^{24} - 5$
-characters (16777211 characters); on 64-bit platforms, the limit is
-$2^{57} - 9$.
-
-\subsection{ss:values:tuple}{Tuples}
-
-Tuples of values are written @'('@v@_1',' \ldots',' @v@_n')'@, standing for the
-$n$-tuple of values @@v@_1@ to @@v@_n@. The current implementation
-supports tuple of up to $2^{22} - 1$ elements (4194303 elements).
-
-\subsection{ss:values:records}{Records}
-
-Record values are labeled tuples of values. The record value written
-@'{' field_1 '=' @v@_1';' \ldots';' field_n '=' @v@_n '}'@ associates the value
-@@v@_i@ to the record field @field_i@, for $i = 1 \ldots n$. The current
-implementation supports records with up to $2^{22} - 1$ fields
-(4194303 fields).
-
-\subsection{ss:values:array}{Arrays}
-
-Arrays are finite, variable-sized sequences of values of the same
-type. The current implementation supports arrays containing up to
-$2^{22} - 1$ elements (4194303 elements) unless the elements are
-floating-point numbers (2097151 elements in this case); on 64-bit
-platforms, the limit is $2^{54} - 1$ for all arrays.
-
-\subsection{ss:values:variant}{Variant values}
-
-Variant values are either a constant constructor, or a non-constant
-constructor applied to a number of values. The former case is written
-@constr@; the latter case is written @constr '('@v@_1',' ... ',' @v@_n
-')'@, where the @@v@_i@ are said to be the arguments of the non-constant
-constructor @constr@. The parentheses may be omitted if there is only
-one argument.
-
-The following constants are treated like built-in constant
-constructors:
-\begin{tableau}{|l|l|}{Constant}{Constructor}
-\entree{"false"}{the boolean false}
-\entree{"true"}{the boolean true}
-\entree{"()"}{the ``unit'' value}
-\entree{"[]"}{the empty list}
-\end{tableau}
-
-The current implementation limits each variant type to have at most
-246 non-constant constructors and $2^{30}-1$ constant constructors.
-
-\subsection{ss:values:polyvars}{Polymorphic variants}
-
-Polymorphic variants are an alternate form of variant values, not
-belonging explicitly to a predefined variant type, and following
-specific typing rules. They can be either constant, written
-@"`"tag-name@, or non-constant, written @"`"tag-name'('@v@')'@.
-
-\subsection{ss:values:fun}{Functions}
-
-Functional values are mappings from values to values.
-
-\subsection{ss:values:obj}{Objects}
-
-Objects are composed of a hidden internal state which is a
-record of instance variables, and a set of methods for accessing and
-modifying these variables. The structure of an object is described by
-the toplevel class that created it.
+++ /dev/null
-/* fira-sans-regular - latin */
-@font-face {
- font-family: 'Fira Sans';
- font-style: normal;
- font-weight: 400;
- src: url('../fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
- src: local('Fira Sans Regular'), local('FiraSans-Regular'),
- url('../fonts/fira-sans-v8-latin-regular.eot?#iefix') format('embedded-opentype'), /* IE6-IE8 */
- url('../fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
- url('../fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
- url('../fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
- url('../fonts/fira-sans-v8-latin-regular.svg#FiraSans') format('svg'); /* Legacy iOS */
-}
-
-
-a:visited {color : #416DFF; text-decoration : none; }
-a:link {color : #416DFF; text-decoration : none; }
-a:hover {color : Black; text-decoration : underline; }
-a:active {color : Black; text-decoration : underline; }
-.keyword { font-weight : bold ; color : Red }
-.keywordsign { color : #C04600 }
-.comment { color : Green }
-.constructor { color : Blue }
-.type { color : #5C6585 }
-.string { color : Maroon }
-.warning { color : Red ; font-weight : bold }
-.info { margin-left : 3em; margin-right : 3em }
-.code { color : #465F91 ; }
-h1 { font-size : 2rem ; text-align: center; }
-
-h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
- font-size: 1.75rem;
- border: 1px solid #000;
- margin-top: 20px;
- margin-bottom: 2px;
- text-align: center;
- padding: 8px;
- font-family: "Fira Sans", sans-serif;
- font-weight: normal;
-}
-h1 {
- font-family: "Fira Sans", sans-serif;
- padding: 10px;
-}
-
-h2 { background-color: #90BDFF; }
-h3 { background-color: #90DDFF; }
-h4 { background-color: #90EDFF; }
-h5 { background-color: #90FDFF; }
-h6 { background-color: #90BDFF; }
-div.h7 { background-color: #90DDFF; }
-div.h8 { background-color: #F0FFFF; }
-div.h9 { background-color: #FFFFFF; }
-
-.typetable { border-style : hidden }
-.indextable { border-style : hidden }
-.paramstable { border-style : hidden ; padding: 5pt 5pt}
-body {
- background-color : #f7f7f7;
- font-size: 1rem;
- max-width: 800px;
- width: 85%;
- margin: auto;
- padding-bottom: 30px;
-}
-td {
- font-size: 1rem;
-}
-.navbar { /* previous - up - next */
- position: absolute;
- left: 10px;
- top: 10px;
-}
-tr { background-color : #f7f7f7 }
-td.typefieldcomment { background-color : #f7f7f7 }
-pre { margin-bottom: 4px; white-space: pre-wrap; }
-div.sig_block {margin-left: 2em}
-ul.info-attributes { list-style: none; margin: 0; padding: 0; }
-div.info > p:first-child{ margin-top:0; }
-div.info-desc > p:first-child { margin-top:0; margin-bottom:0; }
+++ /dev/null
-*.aux
-*.dvi
-*.idx
-*.ilg
-*.ind
-*.log
-*.toc
-*.ipr
-*.txt
-*.pdf
-*.ps
-manual.out
-manual.out
+++ /dev/null
-manual.txt
-manual.hmanual.kwd
-*.haux
-*.hind
-*.htoc
+++ /dev/null
-*.tex
-*.htex
+++ /dev/null
-TOPDIR = ../../..
-include $(TOPDIR)/Makefile.tools
-
-LD_PATH = "$(TOPDIR)/otherlibs/str:$(TOPDIR)/otherlibs/unix"
-
-TOOLS = ../../tools
-CAMLLATEX = $(SET_LD_PATH) \
- $(OCAMLRUN) $(TOPDIR)/tools/caml-tex \
- -repo-root $(TOPDIR) -n 80 -v false
-TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
-TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
-
-
-FILES = coreexamples.tex lablexamples.tex objectexamples.tex \
- moduleexamples.tex advexamples.tex polymorphism.tex
-
-
-etex-files: $(FILES)
-all: $(FILES)
-
-
-%.gen.tex: %.etex
- $(CAMLLATEX) $< -o $@
-
-%.tex: %.gen.tex
- $(TEXQUOTE) < $< > $*.texquote_error.tex
- mv $*.texquote_error.tex $@
-
-
-.PHONY: clean
-clean:
- rm -f *.tex
+++ /dev/null
-\chapter{Advanced examples with classes and modules}
-%HEVEA\cutname{advexamples.html}
-\label{c:advexamples}
-
-{\it (Chapter written by Didier Rémy)}
-
-\bigskip
-
-\noindent
-
-In this chapter, we show some larger examples using objects, classes
-and modules. We review many of the object features simultaneously on
-the example of a bank account. We show how modules taken from the
-standard library can be expressed as classes. Lastly, we describe a
-programming pattern known as {\em virtual types} through the example
-of window managers.
-
-\section{s:extended-bank-accounts}{Extended example: bank accounts}
-
-In this section, we illustrate most aspects of Object and inheritance
-by refining, debugging, and specializing the following
-initial naive definition of a simple bank account. (We reuse the
-module "Euro" defined at the end of chapter~\ref{c:objectexamples}.)
-\begin{caml_eval}
-module type MONEY =
- sig
- type t
- class c : float ->
- object ('a)
- val repr : t
- method value : t
- method print : unit
- method times : float -> 'a
- method leq : 'a -> bool
- method plus : 'a -> 'a
- end
- end;;
-module Euro : MONEY =
- struct
- type t = float
- class c x =
- object (self : 'a)
- val repr = x
- method value = repr
- method print = print_float repr
- method times k = {< repr = k *. x >}
- method leq (p : 'a) = repr <= p#value
- method plus (p : 'a) = {< repr = x +. p#value >}
- end
- end;;
-\end{caml_eval}
-\begin{caml_example}{toplevel}
-let euro = new Euro.c;;
-let zero = euro 0.;;
-let neg x = x#times (-1.);;
-class account =
- object
- val mutable balance = zero
- method balance = balance
- method deposit x = balance <- balance # plus x
- method withdraw x =
- if x#leq balance then (balance <- balance # plus (neg x); x) else zero
- end;;
-let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);;
-\end{caml_example}
-We now refine this definition with a method to compute interest.
-\begin{caml_example}{toplevel}
-class account_with_interests =
- object (self)
- inherit account
- method private interest = self # deposit (self # balance # times 0.03)
- end;;
-\end{caml_example}
-We make the method "interest" private, since clearly it should not be
-called freely from the outside. Here, it is only made accessible to subclasses
-that will manage monthly or yearly updates of the account.
-
-We should soon fix a bug in the current definition: the deposit method can
-be used for withdrawing money by depositing negative amounts. We can
-fix this directly:
-\begin{caml_example}{toplevel}
-class safe_account =
- object
- inherit account
- method deposit x = if zero#leq x then balance <- balance#plus x
- end;;
-\end{caml_example}
-However, the bug might be fixed more safely by the following definition:
-\begin{caml_example}{toplevel}
-class safe_account =
- object
- inherit account as unsafe
- method deposit x =
- if zero#leq x then unsafe # deposit x
- else raise (Invalid_argument "deposit")
- end;;
-\end{caml_example}
-In particular, this does not require the knowledge of the implementation of
-the method "deposit".
-
-To keep track of operations, we extend the class with a mutable field
-"history" and a private method "trace" to add an operation in the
-log. Then each method to be traced is redefined.
-\begin{caml_example}{toplevel}
-type 'a operation = Deposit of 'a | Retrieval of 'a;;
-class account_with_history =
- object (self)
- inherit safe_account as super
- val mutable history = []
- method private trace x = history <- x :: history
- method deposit x = self#trace (Deposit x); super#deposit x
- method withdraw x = self#trace (Retrieval x); super#withdraw x
- method history = List.rev history
- end;;
-\end{caml_example}
-%% \label{ss:bank:initializer}
-One may wish to open an account and simultaneously deposit some initial
-amount. Although the initial implementation did not address this
-requirement, it can be achieved by using an initializer.
-\begin{caml_example}{toplevel}
-class account_with_deposit x =
- object
- inherit account_with_history
- initializer balance <- x
- end;;
-\end{caml_example}
-A better alternative is:
-\begin{caml_example}{toplevel}
-class account_with_deposit x =
- object (self)
- inherit account_with_history
- initializer self#deposit x
- end;;
-\end{caml_example}
-Indeed, the latter is safer since the call to "deposit" will automatically
-benefit from safety checks and from the trace.
-Let's test it:
-\begin{caml_example}{toplevel}
-let ccp = new account_with_deposit (euro 100.) in
-let _balance = ccp#withdraw (euro 50.) in
-ccp#history;;
-\end{caml_example}
-Closing an account can be done with the following polymorphic function:
-\begin{caml_example}{toplevel}
-let close c = c#withdraw c#balance;;
-\end{caml_example}
-Of course, this applies to all sorts of accounts.
-
-Finally, we gather several versions of the account into a module "Account"
-abstracted over some currency.
-\begin{caml_example*}{toplevel}
-let today () = (01,01,2000) (* an approximation *)
-module Account (M:MONEY) =
- struct
- type m = M.c
- let m = new M.c
- let zero = m 0.
-
- class bank =
- object (self)
- val mutable balance = zero
- method balance = balance
- val mutable history = []
- method private trace x = history <- x::history
- method deposit x =
- self#trace (Deposit x);
- if zero#leq x then balance <- balance # plus x
- else raise (Invalid_argument "deposit")
- method withdraw x =
- if x#leq balance then
- (balance <- balance # plus (neg x); self#trace (Retrieval x); x)
- else zero
- method history = List.rev history
- end
-
- class type client_view =
- object
- method deposit : m -> unit
- method history : m operation list
- method withdraw : m -> m
- method balance : m
- end
-
- class virtual check_client x =
- let y = if (m 100.)#leq x then x
- else raise (Failure "Insufficient initial deposit") in
- object (self)
- initializer self#deposit y
- method virtual deposit: m -> unit
- end
-
- module Client (B : sig class bank : client_view end) =
- struct
- class account x : client_view =
- object
- inherit B.bank
- inherit check_client x
- end
-
- let discount x =
- let c = new account x in
- if today() < (1998,10,30) then c # deposit (m 100.); c
- end
- end;;
-\end{caml_example*}
-This shows the use of modules to group several class definitions that can in
-fact be thought of as a single unit. This unit would be provided by a bank
-for both internal and external uses.
-This is implemented as a functor that abstracts over the currency so that
-the same code can be used to provide accounts in different currencies.
-
-The class "bank" is the {\em real} implementation of the bank account (it
-could have been inlined). This is the one that will be used for further
-extensions, refinements, etc. Conversely, the client will only be given the client view.
-\begin{caml_example*}{toplevel}
-module Euro_account = Account(Euro);;
-module Client = Euro_account.Client (Euro_account);;
-new Client.account (new Euro.c 100.);;
-\end{caml_example*}
-Hence, the clients do not have direct access to the "balance", nor the
-"history" of their own accounts. Their only way to change their balance is
-to deposit or withdraw money. It is important to give the clients
-a class and not just the ability to create accounts (such as the
-promotional "discount" account), so that they can
-personalize their account.
-For instance, a client may refine the "deposit" and "withdraw" methods
-so as to do his own financial bookkeeping, automatically. On the
-other hand, the function "discount" is given as such, with no
-possibility for further personalization.
-
-It is important to provide the client's view as a functor
-"Client" so that client accounts can still be built after a possible
-specialization of the "bank".
-The functor "Client" may remain unchanged and be passed
-the new definition to initialize a client's view of the extended account.
-\begin{caml_example*}{toplevel}
-module Investment_account (M : MONEY) =
- struct
- type m = M.c
- module A = Account(M)
-
- class bank =
- object
- inherit A.bank as super
- method deposit x =
- if (new M.c 1000.)#leq x then
- print_string "Would you like to invest?";
- super#deposit x
- end
-
- module Client = A.Client
- end;;
-\end{caml_example*}
-\begin{caml_eval}
-module Euro_account = Investment_account (Euro);;
-module Client = Euro_account.Client (Euro_account);;
-new Client.account (new Euro.c 100.);;
-\end{caml_eval}
-The functor "Client" may also be redefined when some new features of the
-account can be given to the client.
-\begin{caml_example*}{toplevel}
-module Internet_account (M : MONEY) =
- struct
- type m = M.c
- module A = Account(M)
-
- class bank =
- object
- inherit A.bank
- method mail s = print_string s
- end
-
- class type client_view =
- object
- method deposit : m -> unit
- method history : m operation list
- method withdraw : m -> m
- method balance : m
- method mail : string -> unit
- end
-
- module Client (B : sig class bank : client_view end) =
- struct
- class account x : client_view =
- object
- inherit B.bank
- inherit A.check_client x
- end
- end
- end;;
-\end{caml_example*}
-\begin{caml_eval}
-module Euro_account = Internet_account (Euro);;
-module Client = Euro_account.Client (Euro_account);;
-new Client.account (new Euro.c 100.);;
-\end{caml_eval}
-
-
-\section{s:modules-as-classes}{Simple modules as classes}
-
-One may wonder whether it is possible to treat primitive types such as
-integers and strings as objects. Although this is usually uninteresting
-for integers or strings, there may be some situations where
-this is desirable. The class "money" above is such an example.
-We show here how to do it for strings.
-
-\subsection{ss:string-as-class}{Strings}
-
-A naive definition of strings as objects could be:
-\begin{caml_example}{toplevel}
-class ostring s =
- object
- method get n = String.get s n
- method print = print_string s
- method escaped = new ostring (String.escaped s)
- end;;
-\end{caml_example}
-However, the method "escaped" returns an object of the class "ostring",
-and not an object of the current class. Hence, if the class is further
-extended, the method "escaped" will only return an object of the parent
-class.
-\begin{caml_example}{toplevel}
-class sub_string s =
- object
- inherit ostring s
- method sub start len = new sub_string (String.sub s start len)
- end;;
-\end{caml_example}
-As seen in section~\ref{s:binary-methods}, the solution is to use
-functional update instead. We need to create an instance variable
-containing the representation "s" of the string.
-\begin{caml_example}{toplevel}
-class better_string s =
- object
- val repr = s
- method get n = String.get repr n
- method print = print_string repr
- method escaped = {< repr = String.escaped repr >}
- method sub start len = {< repr = String.sub s start len >}
- end;;
-\end{caml_example}
-As shown in the inferred type, the methods "escaped" and "sub" now return
-objects of the same type as the one of the class.
-
-Another difficulty is the implementation of the method "concat".
-In order to concatenate a string with another string of the same class,
-one must be able to access the instance variable externally. Thus, a method
-"repr" returning s must be defined. Here is the correct definition of
-strings:
-\begin{caml_example}{toplevel}
-class ostring s =
- object (self : 'mytype)
- val repr = s
- method repr = repr
- method get n = String.get repr n
- method print = print_string repr
- method escaped = {< repr = String.escaped repr >}
- method sub start len = {< repr = String.sub s start len >}
- method concat (t : 'mytype) = {< repr = repr ^ t#repr >}
- end;;
-\end{caml_example}
-Another constructor of the class string can be defined to return a new
-string of a given length:
-\begin{caml_example}{toplevel}
-class cstring n = ostring (String.make n ' ');;
-\end{caml_example}
-Here, exposing the representation of strings is probably harmless. We do
-could also hide the representation of strings as we hid the currency in the
-class "money" of section~\ref{s:friends}.
-
-\subsubsection{sss:stack-as-class}{Stacks}
-
-There is sometimes an alternative between using modules or classes for
-parametric data types.
-Indeed, there are situations when the two approaches are quite similar.
-For instance, a stack can be straightforwardly implemented as a class:
-\begin{caml_example}{toplevel}
-exception Empty;;
-class ['a] stack =
- object
- val mutable l = ([] : 'a list)
- method push x = l <- x::l
- method pop = match l with [] -> raise Empty | a::l' -> l <- l'; a
- method clear = l <- []
- method length = List.length l
- end;;
-\end{caml_example}
-However, writing a method for iterating over a stack is more
-problematic. A method "fold" would have type
-"('b -> 'a -> 'b) -> 'b -> 'b". Here "'a" is the parameter of the stack.
-The parameter "'b" is not related to the class "'a stack" but to the
-argument that will be passed to the method "fold".
-%The intuition is that method "fold" should be polymorphic, i.e. of type
-%"All ('a) ('b -> 'a -> 'b) -> 'b -> 'b".
-A naive approach is to make "'b" an extra parameter of class "stack":
-\begin{caml_example}{toplevel}
-class ['a, 'b] stack2 =
- object
- inherit ['a] stack
- method fold f (x : 'b) = List.fold_left f x l
- end;;
-\end{caml_example}
-However, the method "fold" of a given object can only be
-applied to functions that all have the same type:
-\begin{caml_example}{toplevel}
-let s = new stack2;;
-s#fold ( + ) 0;;
-s;;
-\end{caml_example}
-A better solution is to use polymorphic methods, which were
-introduced in OCaml version 3.05. Polymorphic methods makes
-it possible to treat the type variable "'b" in the type of "fold" as
-universally quantified, giving "fold" the polymorphic type
-"Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b".
-An explicit type declaration on the method "fold" is required, since
-the type checker cannot infer the polymorphic type by itself.
-\begin{caml_example}{toplevel}
-class ['a] stack3 =
- object
- inherit ['a] stack
- method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b
- = fun f x -> List.fold_left f x l
- end;;
-\end{caml_example}
-
-% However, the nice correspondence between the implementations of stacks as
-% modules or classes is a very particular case.
-
-% XXX Maps
-
-\subsection{ss:hashtbl-as-class}{Hashtbl}
-
-A simplified version of object-oriented hash tables should have the
-following class type.
-\begin{caml_example}{toplevel}
-class type ['a, 'b] hash_table =
- object
- method find : 'a -> 'b
- method add : 'a -> 'b -> unit
- end;;
-\end{caml_example}
-A simple implementation, which is quite reasonable for small hash tables is
-to use an association list:
-\begin{caml_example}{toplevel}
-class ['a, 'b] small_hashtbl : ['a, 'b] hash_table =
- object
- val mutable table = []
- method find key = List.assoc key table
- method add key value = table <- (key, value) :: table
- end;;
-\end{caml_example}
-A better implementation, and one that scales up better, is to use a
-true hash table\ldots\ whose elements are small hash tables!
-\begin{caml_example}{toplevel}
-class ['a, 'b] hashtbl size : ['a, 'b] hash_table =
- object (self)
- val table = Array.init size (fun i -> new small_hashtbl)
- method private hash key =
- (Hashtbl.hash key) mod (Array.length table)
- method find key = table.(self#hash key) # find key
- method add key = table.(self#hash key) # add key
- end;;
-\end{caml_example}
-
-% problem
-
-% solution
-
-\subsection{ss:set-as-class}{Sets}
-
-Implementing sets leads to another difficulty. Indeed, the method
-"union" needs to be able to access the internal representation of
-another object of the same class.
-
-This is another instance of friend functions as seen in
-section~\ref{s:friends}. Indeed, this is the same mechanism used in the module
-"Set" in the absence of objects.
-
-In the object-oriented version of sets, we only need to add an additional
-method "tag" to return the representation of a set. Since sets are
-parametric in the type of elements, the method "tag" has a parametric type
-"'a tag", concrete within
-the module definition but abstract in its signature.
-From outside, it will then be guaranteed that two objects with a method "tag"
-of the same type will share the same representation.
-\begin{caml_example*}{toplevel}
-module type SET =
- sig
- type 'a tag
- class ['a] c :
- object ('b)
- method is_empty : bool
- method mem : 'a -> bool
- method add : 'a -> 'b
- method union : 'b -> 'b
- method iter : ('a -> unit) -> unit
- method tag : 'a tag
- end
- end;;
-module Set : SET =
- struct
- let rec merge l1 l2 =
- match l1 with
- [] -> l2
- | h1 :: t1 ->
- match l2 with
- [] -> l1
- | h2 :: t2 ->
- if h1 < h2 then h1 :: merge t1 l2
- else if h1 > h2 then h2 :: merge l1 t2
- else merge t1 l2
- type 'a tag = 'a list
- class ['a] c =
- object (_ : 'b)
- val repr = ([] : 'a list)
- method is_empty = (repr = [])
- method mem x = List.exists (( = ) x) repr
- method add x = {< repr = merge [x] repr >}
- method union (s : 'b) = {< repr = merge repr s#tag >}
- method iter (f : 'a -> unit) = List.iter f repr
- method tag = repr
- end
- end;;
-\end{caml_example*}
-
-\section{s:subject-observer}{The subject/observer pattern}
-
-The following example, known as the subject/observer pattern, is often
-presented in the literature as a difficult inheritance problem with
-inter-connected classes.
-The general pattern amounts to the definition a pair of two
-classes that recursively interact with one another.
-
-The class "observer" has a distinguished method "notify" that requires
-two arguments, a subject and an event to execute an action.
-\begin{caml_example}{toplevel}
-class virtual ['subject, 'event] observer =
- object
- method virtual notify : 'subject -> 'event -> unit
- end;;
-\end{caml_example}
-The class "subject" remembers a list of observers in an instance variable,
-and has a distinguished method "notify_observers" to broadcast the message
-"notify" to all observers with a particular event "e".
-\begin{caml_example}{toplevel}
-class ['observer, 'event] subject =
- object (self)
- val mutable observers = ([]:'observer list)
- method add_observer obs = observers <- (obs :: observers)
- method notify_observers (e : 'event) =
- List.iter (fun x -> x#notify self e) observers
- end;;
-\end{caml_example}
-The difficulty usually lies in defining instances of the pattern above
-by inheritance. This can be done in a natural and obvious manner in
-OCaml, as shown on the following example manipulating windows.
-\begin{caml_example}{toplevel}
-type event = Raise | Resize | Move;;
-let string_of_event = function
- Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";;
-let count = ref 0;;
-class ['observer] window_subject =
- let id = count := succ !count; !count in
- object (self)
- inherit ['observer, event] subject
- val mutable position = 0
- method identity = id
- method move x = position <- position + x; self#notify_observers Move
- method draw = Printf.printf "{Position = %d}\n" position;
- end;;
-class ['subject] window_observer =
- object
- inherit ['subject, event] observer
- method notify s e = s#draw
- end;;
-\end{caml_example}
-As can be expected, the type of "window" is recursive.
-\begin{caml_example}{toplevel}
-let window = new window_subject;;
-\end{caml_example}
-However, the two classes of "window_subject" and "window_observer" are not
-mutually recursive.
-\begin{caml_example}{toplevel}
-let window_observer = new window_observer;;
-window#add_observer window_observer;;
-window#move 1;;
-\end{caml_example}
-
-Classes "window_observer" and "window_subject" can still be extended by
-inheritance. For instance, one may enrich the "subject" with new
-behaviors and refine the behavior of the observer.
-\begin{caml_example}{toplevel}
-class ['observer] richer_window_subject =
- object (self)
- inherit ['observer] window_subject
- val mutable size = 1
- method resize x = size <- size + x; self#notify_observers Resize
- val mutable top = false
- method raise = top <- true; self#notify_observers Raise
- method draw = Printf.printf "{Position = %d; Size = %d}\n" position size;
- end;;
-class ['subject] richer_window_observer =
- object
- inherit ['subject] window_observer as super
- method notify s e = if e <> Raise then s#raise; super#notify s e
- end;;
-\end{caml_example}
-We can also create a different kind of observer:
-\begin{caml_example}{toplevel}
-class ['subject] trace_observer =
- object
- inherit ['subject, event] observer
- method notify s e =
- Printf.printf
- "<Window %d <== %s>\n" s#identity (string_of_event e)
- end;;
-\end{caml_example}
-and attach several observers to the same object:
-\begin{caml_example}{toplevel}
-let window = new richer_window_subject;;
-window#add_observer (new richer_window_observer);;
-window#add_observer (new trace_observer);;
-window#move 1; window#resize 2;;
-\end{caml_example}
-
-%\subsection{ss:Classes used as modules with inheritance}
-%
-% to be filled for next release...
-%
-% an example of stateless objects used to provide inheritance in modules
-%
-
-
-% LocalWords: objectexamples bsection init caml val int Oo succ incr ref
-% LocalWords: typecheck leq bool cp eval sig struct ABSPOINT Abspoint iter neg
-% LocalWords: accu mem rec repr Euro euro ccp inlined ostring len concat OCaml
+++ /dev/null
-\chapter{The core language} \label{c:core-xamples}
-%HEVEA\cutname{coreexamples.html}
-
-This part of the manual is a tutorial introduction to the OCaml language. A
-good familiarity with programming in a conventional languages (say, C or Java)
-is assumed, but no prior exposure to functional languages is required. The
-present chapter introduces the core language. Chapter~\ref{c:moduleexamples}
-deals with the module system, chapter~\ref{c:objectexamples} with the
-object-oriented features, chapter~\ref{c:labl-examples} with extensions to the
-core language (labeled arguments and polymorphic variants),
-chapter~\ref{c:polymorphism} with the limitations of polymorphism, and
-chapter~\ref{c:advexamples} gives some advanced examples.
-
-\section{s:basics}{Basics}
-
-For this overview of OCaml, we use the interactive system, which is started by
-running "ocaml" from the Unix shell or Windows command prompt. This tutorial is
-presented as the transcript of a session with the interactive system: lines
-starting with "#" represent user input; the system responses are printed below,
-without a leading "#".
-
-Under the interactive system, the user types OCaml phrases terminated
-by ";;" in response to the "#" prompt, and the system compiles them
-on the fly, executes them, and prints the outcome of evaluation.
-Phrases are either simple expressions, or "let" definitions of
-identifiers (either values or functions).
-\begin{caml_example}{toplevel}
-1 + 2 * 3;;
-let pi = 4.0 *. atan 1.0;;
-let square x = x *. x;;
-square (sin pi) +. square (cos pi);;
-\end{caml_example}
-The OCaml system computes both the value and the type for
-each phrase. Even function parameters need no explicit type declaration:
-the system infers their types from their usage in the
-function. Notice also that integers and floating-point numbers are
-distinct types, with distinct operators: "+" and "*" operate on
-integers, but "+." and "*." operate on floats.
-\begin{caml_example}{toplevel}[error]
-1.0 * 2;;
-\end{caml_example}
-
-Recursive functions are defined with the "let rec" binding:
-\begin{caml_example}{toplevel}
-let rec fib n =
- if n < 2 then n else fib (n - 1) + fib (n - 2);;
-fib 10;;
-\end{caml_example}
-
-\section{s:datatypes}{Data types}
-
-In addition to integers and floating-point numbers, OCaml offers the
-usual basic data types:
-\begin{itemize}%
-\item booleans
-\begin{caml_example}{toplevel}
-(1 < 2) = false;;
-let one = if true then 1 else 2;;
-\end{caml_example}
-\item characters
-\begin{caml_example}{toplevel}
- 'a';;
- int_of_char '\n';;
-\end{caml_example}
-\item immutable character strings
-\begin{caml_example}{toplevel}
-"Hello" ^ " " ^ "world";;
-{|This is a quoted string, here, neither \ nor " are special characters|};;
-{|"\\"|}="\"\\\\\"";;
- {delimiter|the end of this|}quoted string is here|delimiter}
-= "the end of this|}quoted string is here";;
-\end{caml_example}
-\end{itemize}
-
-Predefined data structures include tuples, arrays, and lists. There are also
-general mechanisms for defining your own data structures, such as records and
-variants, which will be covered in more detail later; for now, we concentrate
-on lists. Lists are either given in extension as a bracketed list of
-semicolon-separated elements, or built from the empty list "[]"
-(pronounce ``nil'') by adding elements in front using the "::"
-(``cons'') operator.
-\begin{caml_example}{toplevel}
-let l = ["is"; "a"; "tale"; "told"; "etc."];;
-"Life" :: l;;
-\end{caml_example}
-As with all other OCaml data structures, lists do not need to be
-explicitly allocated and deallocated from memory: all memory
-management is entirely automatic in OCaml. Similarly, there is no
-explicit handling of pointers: the OCaml compiler silently introduces
-pointers where necessary.
-
-As with most OCaml data structures, inspecting and destructuring lists
-is performed by pattern-matching. List patterns have exactly the same
-form as list expressions, with identifiers representing unspecified
-parts of the list. As an example, here is insertion sort on a list:
-\begin{caml_example}{toplevel}
-let rec sort lst =
- match lst with
- [] -> []
- | head :: tail -> insert head (sort tail)
-and insert elt lst =
- match lst with
- [] -> [elt]
- | head :: tail -> if elt <= head then elt :: lst else head :: insert elt tail
-;;
-sort l;;
-\end{caml_example}
-
-The type inferred for "sort", "'a list -> 'a list", means that "sort"
-can actually apply to lists of any type, and returns a list of the
-same type. The type "'a" is a {\em type variable}, and stands for any
-given type. The reason why "sort" can apply to lists of any type is
-that the comparisons ("=", "<=", etc.) are {\em polymorphic} in OCaml:
-they operate between any two values of the same type. This makes
-"sort" itself polymorphic over all list types.
-\begin{caml_example}{toplevel}
-sort [6; 2; 5; 3];;
-sort [3.14; 2.718];;
-\end{caml_example}
-
-The "sort" function above does not modify its input list: it builds
-and returns a new list containing the same elements as the input list,
-in ascending order. There is actually no way in OCaml to modify
-a list in-place once it is built: we say that lists are {\em immutable}
-data structures. Most OCaml data structures are immutable, but a few
-(most notably arrays) are {\em mutable}, meaning that they can be
-modified in-place at any time.
-
-The OCaml notation for the type of a function with multiple arguments is \\
-"arg1_type -> arg2_type -> ... -> return_type". For example,
-the type inferred for "insert", "'a -> 'a list -> 'a list", means that "insert"
-takes two arguments, an element of any type "'a" and a list with elements of
-the same type "'a" and returns a list of the same type.
-\section{s:functions-as-values}{Functions as values}
-
-OCaml is a functional language: functions in the full mathematical
-sense are supported and can be passed around freely just as any other
-piece of data. For instance, here is a "deriv" function that takes any
-float function as argument and returns an approximation of its
-derivative function:
-\begin{caml_example}{toplevel}
-let deriv f dx = function x -> (f (x +. dx) -. f x) /. dx;;
-let sin' = deriv sin 1e-6;;
-sin' pi;;
-\end{caml_example}
-Even function composition is definable:
-\begin{caml_example}{toplevel}
-let compose f g = function x -> f (g x);;
-let cos2 = compose square cos;;
-\end{caml_example}
-
-Functions that take other functions as arguments are called
-``functionals'', or ``higher-order functions''. Functionals are
-especially useful to provide iterators or similar generic operations
-over a data structure. For instance, the standard OCaml library
-provides a "List.map" functional that applies a given function to each
-element of a list, and returns the list of the results:
-\begin{caml_example}{toplevel}
-List.map (function n -> n * 2 + 1) [0;1;2;3;4];;
-\end{caml_example}
-This functional, along with a number of other list and array
-functionals, is predefined because it is often useful, but there is
-nothing magic with it: it can easily be defined as follows.
-\begin{caml_example}{toplevel}
-let rec map f l =
- match l with
- [] -> []
- | hd :: tl -> f hd :: map f tl;;
-\end{caml_example}
-
-\section{s:tut-recvariants}{Records and variants}
-
-User-defined data structures include records and variants. Both are
-defined with the "type" declaration. Here, we declare a record type to
-represent rational numbers.
-\begin{caml_example}{toplevel}
-type ratio = {num: int; denom: int};;
-let add_ratio r1 r2 =
- {num = r1.num * r2.denom + r2.num * r1.denom;
- denom = r1.denom * r2.denom};;
-add_ratio {num=1; denom=3} {num=2; denom=5};;
-\end{caml_example}
-Record fields can also be accessed through pattern-matching:
-\begin{caml_example}{toplevel}
-let integer_part r =
- match r with
- {num=num; denom=denom} -> num / denom;;
-\end{caml_example}
-Since there is only one case in this pattern matching, it
-is safe to expand directly the argument "r" in a record pattern:
-\begin{caml_example}{toplevel}
-let integer_part {num=num; denom=denom} = num / denom;;
-\end{caml_example}
-Unneeded fields can be omitted:
-\begin{caml_example}{toplevel}
-let get_denom {denom=denom} = denom;;
-\end{caml_example}
-Optionally, missing fields can be made explicit by ending the list of
-fields with a trailing wildcard "_"::
-\begin{caml_example}{toplevel}
-let get_num {num=num; _ } = num;;
-\end{caml_example}
-When both sides of the "=" sign are the same, it is possible to avoid
-repeating the field name by eliding the "=field" part:
-\begin{caml_example}{toplevel}
-let integer_part {num; denom} = num / denom;;
-\end{caml_example}
-This short notation for fields also works when constructing records:
-\begin{caml_example}{toplevel}
-let ratio num denom = {num; denom};;
-\end{caml_example}
-At last, it is possible to update few fields of a record at once:
-\begin{caml_example}{toplevel}
-let integer_product integer ratio = { ratio with num = integer * ratio.num };;
-\end{caml_example}
-With this functional update notation, the record on the left-hand side
-of "with" is copied except for the fields on the right-hand side which
-are updated.
-
-The declaration of a variant type lists all possible forms for values
-of that type. Each case is identified by a name, called a constructor,
-which serves both for constructing values of the variant type and
-inspecting them by pattern-matching. Constructor names are capitalized
-to distinguish them from variable names (which must start with a
-lowercase letter). For instance, here is a variant
-type for doing mixed arithmetic (integers and floats):
-\begin{caml_example}{toplevel}
-type number = Int of int | Float of float | Error;;
-\end{caml_example}
-This declaration expresses that a value of type "number" is either an
-integer, a floating-point number, or the constant "Error" representing
-the result of an invalid operation (e.g. a division by zero).
-
-Enumerated types are a special case of variant types, where all
-alternatives are constants:
-\begin{caml_example}{toplevel}
-type sign = Positive | Negative;;
-let sign_int n = if n >= 0 then Positive else Negative;;
-\end{caml_example}
-
-To define arithmetic operations for the "number" type, we use
-pattern-matching on the two numbers involved:
-\begin{caml_example}{toplevel}
-let add_num n1 n2 =
- match (n1, n2) with
- (Int i1, Int i2) ->
- (* Check for overflow of integer addition *)
- if sign_int i1 = sign_int i2 && sign_int (i1 + i2) <> sign_int i1
- then Float(float i1 +. float i2)
- else Int(i1 + i2)
- | (Int i1, Float f2) -> Float(float i1 +. f2)
- | (Float f1, Int i2) -> Float(f1 +. float i2)
- | (Float f1, Float f2) -> Float(f1 +. f2)
- | (Error, _) -> Error
- | (_, Error) -> Error;;
-add_num (Int 123) (Float 3.14159);;
-\end{caml_example}
-
-Another interesting example of variant type is the built-in
-"'a option" type which represents either a value of type "'a" or an
-absence of value:
-\begin{caml_example}{toplevel}
-type 'a option = Some of 'a | None;;
-\end{caml_example}
-This type is particularly useful when defining function that can
-fail in common situations, for instance
-\begin{caml_example}{toplevel}
-let safe_square_root x = if x > 0. then Some(sqrt x) else None;;
-\end{caml_example}
-
-The most common usage of variant types is to describe recursive data
-structures. Consider for example the type of binary trees:
-\begin{caml_example}{toplevel}
-type 'a btree = Empty | Node of 'a * 'a btree * 'a btree;;
-\end{caml_example}
-This definition reads as follows: a binary tree containing values of
-type "'a" (an arbitrary type) is either empty, or is a node containing
-one value of type "'a" and two subtrees also containing values of type
-"'a", that is, two "'a btree".
-
-Operations on binary trees are naturally expressed as recursive functions
-following the same structure as the type definition itself. For
-instance, here are functions performing lookup and insertion in
-ordered binary trees (elements increase from left to right):
-\begin{caml_example}{toplevel}
-let rec member x btree =
- match btree with
- Empty -> false
- | Node(y, left, right) ->
- if x = y then true else
- if x < y then member x left else member x right;;
-let rec insert x btree =
- match btree with
- Empty -> Node(x, Empty, Empty)
- | Node(y, left, right) ->
- if x <= y then Node(y, insert x left, right)
- else Node(y, left, insert x right);;
-\end{caml_example}
-
-
-\subsection{ss:record-and-variant-disambiguation}{Record and variant disambiguation}
-( This subsection can be skipped on the first reading )
-
-Astute readers may have wondered what happens when two or more record
-fields or constructors share the same name
-
-\begin{caml_example*}{toplevel}
-type first_record = { x:int; y:int; z:int }
-type middle_record = { x:int; z:int }
-type last_record = { x:int };;
-type first_variant = A | B | C
-type last_variant = A;;
-\end{caml_example*}
-
-The answer is that when confronted with multiple options, OCaml tries to
-use locally available information to disambiguate between the various fields
-and constructors. First, if the type of the record or variant is known,
-OCaml can pick unambiguously the corresponding field or constructor.
-For instance:
-
-\begin{caml_example}{toplevel}
-let look_at_x_then_z (r:first_record) =
- let x = r.x in
- x + r.z;;
-let permute (x:first_variant) = match x with
- | A -> (B:first_variant)
- | B -> A
- | C -> C;;
-type wrapped = First of first_record
-let f (First r) = r, r.x;;
-\end{caml_example}
-
-In the first example, "(r:first_record)" is an explicit annotation
-telling OCaml that the type of "r" is "first_record". With this
-annotation, Ocaml knows that "r.x" refers to the "x" field of the first
-record type. Similarly, the type annotation in the second example makes
-it clear to OCaml that the constructors "A", "B" and "C" come from the
-first variant type. Contrarily, in the last example, OCaml has inferred
-by itself that the type of "r" can only be "first_record" and there are
-no needs for explicit type annotations.
-
-Those explicit type annotations can in fact be used anywhere.
-Most of the time they are unnecessary, but they are useful to guide
-disambiguation, to debug unexpected type errors, or combined with some
-of the more advanced features of OCaml described in later chapters.
-
-Secondly, for records, OCaml can also deduce the right record type by
-looking at the whole set of fields used in a expression or pattern:
-\begin{caml_example}{toplevel}
-let project_and_rotate {x; y; _} = { x= - y; y = x; z = 0} ;;
-\end{caml_example}
-Since the fields "x" and "y" can only appear simultaneously in the first
-record type, OCaml infers that the type of "project_and_rotate" is
-"first_record -> first_record".
-
-In last resort, if there is not enough information to disambiguate between
-different fields or constructors, Ocaml picks the last defined type
-amongst all locally valid choices:
-
-\begin{caml_example}{toplevel}
-let look_at_xz {x; z} = x;;
-\end{caml_example}
-
-Here, OCaml has inferred that the possible choices for the type of
-"{x;z}" are "first_record" and "middle_record", since the type
-"last_record" has no field "z". Ocaml then picks the type "middle_record"
-as the last defined type between the two possibilities.
-
-Beware that this last resort disambiguation is local: once Ocaml has
-chosen a disambiguation, it sticks to this choice, even if it leads to
-an ulterior type error:
-
-\begin{caml_example}{toplevel}[error]
-let look_at_x_then_y r =
- let x = r.x in (* Ocaml deduces [r: last_record] *)
- x + r.y;;
-let is_a_or_b x = match x with
- | A -> true (* OCaml infers [x: last_variant] *)
- | B -> true;;
-\end{caml_example}
-
-Moreover, being the last defined type is a quite unstable position that
-may change surreptitiously after adding or moving around a type
-definition, or after opening a module (see chapter \ref{c:moduleexamples}).
-Consequently, adding explicit type annotations to guide disambiguation is
-more robust than relying on the last defined type disambiguation.
-
-\section{s:imperative-features}{Imperative features}
-
-Though all examples so far were written in purely applicative style,
-OCaml is also equipped with full imperative features. This includes the
-usual "while" and "for" loops, as well as mutable data structures such
-as arrays. Arrays are either created by listing semicolon-separated element
-values between "[|" and "|]" brackets, or allocated and initialized with the
-"Array.make" function, then filled up later by assignments. For instance, the
-function below sums two vectors (represented as float arrays) componentwise.
-\begin{caml_example}{toplevel}
-let add_vect v1 v2 =
- let len = min (Array.length v1) (Array.length v2) in
- let res = Array.make len 0.0 in
- for i = 0 to len - 1 do
- res.(i) <- v1.(i) +. v2.(i)
- done;
- res;;
-add_vect [| 1.0; 2.0 |] [| 3.0; 4.0 |];;
-\end{caml_example}
-
-Record fields can also be modified by assignment, provided they are
-declared "mutable" in the definition of the record type:
-\begin{caml_example}{toplevel}
-type mutable_point = { mutable x: float; mutable y: float };;
-let translate p dx dy =
- p.x <- p.x +. dx; p.y <- p.y +. dy;;
-let mypoint = { x = 0.0; y = 0.0 };;
-translate mypoint 1.0 2.0;;
-mypoint;;
-\end{caml_example}
-
-OCaml has no built-in notion of variable -- identifiers whose current
-value can be changed by assignment. (The "let" binding is not an
-assignment, it introduces a new identifier with a new scope.)
-However, the standard library provides references, which are mutable
-indirection cells, with operators "!" to fetch
-the current contents of the reference and ":=" to assign the contents.
-Variables can then be emulated by "let"-binding a reference. For
-instance, here is an in-place insertion sort over arrays:
-\begin{caml_example}{toplevel}
-let insertion_sort a =
- for i = 1 to Array.length a - 1 do
- let val_i = a.(i) in
- let j = ref i in
- while !j > 0 && val_i < a.(!j - 1) do
- a.(!j) <- a.(!j - 1);
- j := !j - 1
- done;
- a.(!j) <- val_i
- done;;
-\end{caml_example}
-
-References are also useful to write functions that maintain a current
-state between two calls to the function. For instance, the following
-pseudo-random number generator keeps the last returned number in a
-reference:
-\begin{caml_example}{toplevel}
-let current_rand = ref 0;;
-let random () =
- current_rand := !current_rand * 25713 + 1345;
- !current_rand;;
-\end{caml_example}
-
-Again, there is nothing magical with references: they are implemented as
-a single-field mutable record, as follows.
-\begin{caml_example}{toplevel}
-type 'a ref = { mutable contents: 'a };;
-let ( ! ) r = r.contents;;
-let ( := ) r newval = r.contents <- newval;;
-\end{caml_example}
-
-In some special cases, you may need to store a polymorphic function in
-a data structure, keeping its polymorphism. Doing this requires
-user-provided type annotations, since polymorphism is only introduced
-automatically for global definitions. However, you can explicitly give
-polymorphic types to record fields.
-\begin{caml_example}{toplevel}
-type idref = { mutable id: 'a. 'a -> 'a };;
-let r = {id = fun x -> x};;
-let g s = (s.id 1, s.id true);;
-r.id <- (fun x -> print_string "called id\n"; x);;
-g r;;
-\end{caml_example}
-
-\section{s:exceptions}{Exceptions}
-
-OCaml provides exceptions for signalling and handling exceptional
-conditions. Exceptions can also be used as a general-purpose non-local
-control structure, although this should not be overused since it can
-make the code harder to understand. Exceptions are declared with the
-"exception" construct, and signalled with the "raise" operator. For instance,
-the function below for taking the head of a list uses an exception to
-signal the case where an empty list is given.
-\begin{caml_example}{toplevel}
-exception Empty_list;;
-let head l =
- match l with
- [] -> raise Empty_list
- | hd :: tl -> hd;;
-head [1; 2];;
-head [];;
-\end{caml_example}
-
-Exceptions are used throughout the standard library to signal cases
-where the library functions cannot complete normally. For instance,
-the "List.assoc" function, which returns the data associated with a
-given key in a list of (key, data) pairs, raises the predefined
-exception "Not_found" when the key does not appear in the list:
-\begin{caml_example}{toplevel}
-List.assoc 1 [(0, "zero"); (1, "one")];;
-List.assoc 2 [(0, "zero"); (1, "one")];;
-\end{caml_example}
-
-Exceptions can be trapped with the "try"\ldots"with" construct:
-\begin{caml_example}{toplevel}
-let name_of_binary_digit digit =
- try
- List.assoc digit [0, "zero"; 1, "one"]
- with Not_found ->
- "not a binary digit";;
-name_of_binary_digit 0;;
-name_of_binary_digit (-1);;
-\end{caml_example}
-
-The "with" part does pattern matching on the
-exception value with the same syntax and behavior as "match". Thus,
-several exceptions can be caught by one
-"try"\ldots"with" construct:
-\begin{caml_example}{toplevel}
-let rec first_named_value values names =
- try
- List.assoc (head values) names
- with
- | Empty_list -> "no named value"
- | Not_found -> first_named_value (List.tl values) names;;
-first_named_value [0; 10] [1, "one"; 10, "ten"];;
-\end{caml_example}
-
-Also, finalization can be performed by
-trapping all exceptions, performing the finalization, then re-raising
-the exception:
-\begin{caml_example}{toplevel}
-let temporarily_set_reference ref newval funct =
- let oldval = !ref in
- try
- ref := newval;
- let res = funct () in
- ref := oldval;
- res
- with x ->
- ref := oldval;
- raise x;;
-\end{caml_example}
-
-An alternative to "try"\ldots"with" is to catch the exception while
-pattern matching:
-\begin{caml_example}{toplevel}
-let assoc_may_map f x l =
- match List.assoc x l with
- | exception Not_found -> None
- | y -> f y;;
-\end{caml_example}
-Note that this construction is only useful if the exception is raised
-between "match"\ldots"with". Exception patterns can be combined
-with ordinary patterns at the toplevel,
-\begin{caml_example}{toplevel}
-let flat_assoc_opt x l =
- match List.assoc x l with
- | None | exception Not_found -> None
- | Some _ as v -> v;;
-\end{caml_example}
-but they cannot be nested inside other patterns. For instance,
-the pattern "Some (exception A)" is invalid.
-
-When exceptions are used as a control structure, it can be useful to make
-them as local as possible by using a locally defined exception.
-For instance, with
-\begin{caml_eval}
- let ref x: _ ref = {contents=x};;
-\end{caml_eval}
-\begin{caml_example}{toplevel}
-let fixpoint f x =
- let exception Done in
- let x = ref x in
- try while true do
- let y = f !x in
- if !x = y then raise Done else x := y
- done; assert false
- with Done -> !x;;
-\end{caml_example}
-the function "f" cannot raise a "Done" exception, which removes an
-entire class of misbehaving functions.
-
-\section{s:lazy-expr}{Lazy expressions}
-
-OCaml allows us to defer some computation until later when we need the result of
- that computation.
-
-We use "lazy (expr)" to delay the evaluation of some expression "expr". For
-example, we can defer the computation of "1+1" until we need the result of that
-expression, "2". Let us see how we initialize a lazy expression.
-
-\begin{caml_example}{toplevel}
-let lazy_two = lazy (print_endline "lazy_two evaluation"; 1 + 1);;
-\end{caml_example}
-
-We added "print_endline \"lazy_two evaluation\"" to see when the lazy
- expression is being evaluated.
-
-The value of "lazy_two" is displayed as "<lazy>", which means the expression
-has not been evaluated yet, and its final value is unknown.
-
-Note that "lazy_two" has type "int lazy_t". However, the type "'a lazy_t" is an
-internal type name, so the type "'a Lazy.t" should be preferred when possible.
-
-When we finally need the result of a lazy expression, we can call "Lazy.force"
-on that expression to force its evaluation. The function "force" comes from
-standard-library module \stdmoduleref{Lazy}.
-
-\begin{caml_example}{toplevel}
-Lazy.force lazy_two;;
-\end{caml_example}
-
-Notice that our function call above prints ``lazy_two evaluation'' and then
-returns the plain value of the computation.
-
-Now if we look at the value of "lazy_two", we see that it is not displayed as
-"<lazy>" anymore but as "lazy 2".
-
-\begin{caml_example}{toplevel}
-lazy_two;;
-\end{caml_example}
-
-This is because "Lazy.force" memoizes the result of the forced expression. In other
-words, every subsequent call of "Lazy.force" on that expression returns the
-result of the first computation without recomputing the lazy expression. Let us
-force "lazy_two" once again.
-
-\begin{caml_example}{toplevel}
-Lazy.force lazy_two;;
-\end{caml_example}
-
-The expression is not evaluated this time; notice that ``lazy_two evaluation'' is
-not printed. The result of the initial computation is simply returned.
-
-Lazy patterns provide another way to force a lazy expression.
-
-\begin{caml_example}{toplevel}
-let lazy_l = lazy ([1; 2] @ [3; 4]);;
-let lazy l = lazy_l;;
-\end{caml_example}
-
-We can also use lazy patterns in pattern matching.
-
-\begin{caml_example}{toplevel}
-let maybe_eval lazy_guard lazy_expr =
- match lazy_guard, lazy_expr with
- | lazy false, _ -> "matches if (Lazy.force lazy_guard = false); lazy_expr not forced"
- | lazy true, lazy _ -> "matches if (Lazy.force lazy_guard = true); lazy_expr forced";;
-\end{caml_example}
-
-The lazy expression "lazy_expr" is forced only if the "lazy_guard" value yields
-"true" once computed. Indeed, a simple wildcard pattern (not lazy) never forces
-the lazy expression's evaluation. However, a pattern with keyword "lazy", even
-if it is wildcard, always forces the evaluation of the deferred computation.
-
-\section{s:symb-expr}{Symbolic processing of expressions}
-
-We finish this introduction with a more complete example
-representative of the use of OCaml for symbolic processing: formal
-manipulations of arithmetic expressions containing variables. The
-following variant type describes the expressions we shall manipulate:
-\begin{caml_example}{toplevel}
-type expression =
- Const of float
- | Var of string
- | Sum of expression * expression (* e1 + e2 *)
- | Diff of expression * expression (* e1 - e2 *)
- | Prod of expression * expression (* e1 * e2 *)
- | Quot of expression * expression (* e1 / e2 *)
-;;
-\end{caml_example}
-
-We first define a function to evaluate an expression given an
-environment that maps variable names to their values. For simplicity,
-the environment is represented as an association list.
-\begin{caml_example}{toplevel}
-exception Unbound_variable of string;;
-let rec eval env exp =
- match exp with
- Const c -> c
- | Var v ->
- (try List.assoc v env with Not_found -> raise (Unbound_variable v))
- | Sum(f, g) -> eval env f +. eval env g
- | Diff(f, g) -> eval env f -. eval env g
- | Prod(f, g) -> eval env f *. eval env g
- | Quot(f, g) -> eval env f /. eval env g;;
-eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "x", Const 2.0), Var "y"));;
-\end{caml_example}
-
-Now for a real symbolic processing, we define the derivative of an
-expression with respect to a variable "dv":
-\begin{caml_example}{toplevel}
-let rec deriv exp dv =
- match exp with
- Const c -> Const 0.0
- | Var v -> if v = dv then Const 1.0 else Const 0.0
- | Sum(f, g) -> Sum(deriv f dv, deriv g dv)
- | Diff(f, g) -> Diff(deriv f dv, deriv g dv)
- | Prod(f, g) -> Sum(Prod(f, deriv g dv), Prod(deriv f dv, g))
- | Quot(f, g) -> Quot(Diff(Prod(deriv f dv, g), Prod(f, deriv g dv)),
- Prod(g, g))
-;;
-deriv (Quot(Const 1.0, Var "x")) "x";;
-\end{caml_example}
-
-\section{s:pretty-printing}{Pretty-printing}
-
-As shown in the examples above, the internal representation (also
-called {\em abstract syntax\/}) of expressions quickly becomes hard to
-read and write as the expressions get larger. We need a printer and a
-parser to go back and forth between the abstract syntax and the {\em
-concrete syntax}, which in the case of expressions is the familiar
-algebraic notation (e.g. "2*x+1").
-
-For the printing function, we take into account the usual precedence
-rules (i.e. "*" binds tighter than "+") to avoid printing unnecessary
-parentheses. To this end, we maintain the current operator precedence
-and print parentheses around an operator only if its precedence is
-less than the current precedence.
-\begin{caml_example}{toplevel}
-let print_expr exp =
- (* Local function definitions *)
- let open_paren prec op_prec =
- if prec > op_prec then print_string "(" in
- let close_paren prec op_prec =
- if prec > op_prec then print_string ")" in
- let rec print prec exp = (* prec is the current precedence *)
- match exp with
- Const c -> print_float c
- | Var v -> print_string v
- | Sum(f, g) ->
- open_paren prec 0;
- print 0 f; print_string " + "; print 0 g;
- close_paren prec 0
- | Diff(f, g) ->
- open_paren prec 0;
- print 0 f; print_string " - "; print 1 g;
- close_paren prec 0
- | Prod(f, g) ->
- open_paren prec 2;
- print 2 f; print_string " * "; print 2 g;
- close_paren prec 2
- | Quot(f, g) ->
- open_paren prec 2;
- print 2 f; print_string " / "; print 3 g;
- close_paren prec 2
- in print 0 exp;;
-let e = Sum(Prod(Const 2.0, Var "x"), Const 1.0);;
-print_expr e; print_newline ();;
-print_expr (deriv e "x"); print_newline ();;
-\end{caml_example}
-
-\section{s:printf}{Printf formats}
-
-There is a "printf" function in the \stdmoduleref{Printf} module
-(see chapter~\ref{c:moduleexamples}) that allows you to make formatted
-output more concisely.
-It follows the behavior of the "printf" function from the C standard library.
-The "printf" function takes a format string that describes the desired output
-as a text interspersed with specifiers (for instance "%d", "%f").
-Next, the specifiers are substituted by the following arguments in their order
-of apparition in the format string:
-\begin{caml_example}{toplevel}
-Printf.printf "%i + %i is an integer value, %F * %F is a float, %S\n"
-3 2 4.5 1. "this is a string";;
-\end{caml_example}
-The OCaml type system checks that the type of the arguments and the specifiers are
-compatible. If you pass it an argument of a type that does not correspond to
-the format specifier, the compiler will display an error message:
-\begin{caml_example}{toplevel}[error]
-Printf.printf "Float value: %F" 42;;
-\end{caml_example}
-The "fprintf" function is like "printf" except that it takes an output channel as
-the first argument. The "%a" specifier can be useful to define custom printer
-(for custom types). For instance, we can create a printing template that converts
-an integer argument to signed decimal:
-\begin{caml_example}{toplevel}
-let pp_int ppf n = Printf.fprintf ppf "%d" n;;
-Printf.printf "Outputting an integer using a custom printer: %a " pp_int 42;;
-\end{caml_example}
-The advantage of those printers based on the "%a" specifier is that they can be
-composed together to create more complex printers step by step.
-We can define a combinator that can turn a printer for "'a" type into a printer
-for "'a optional":
-\begin{caml_example}{toplevel}
-let pp_option printer ppf = function
- | None -> Printf.fprintf ppf "None"
- | Some v -> Printf.fprintf ppf "Some(%a)" printer v;;
-Printf.fprintf stdout
- "The current setting is %a. \nThere is only %a\n"
- (pp_option pp_int) (Some 3)
- (pp_option pp_int) None
-;;
-\end{caml_example}
-If the value of its argument its "None", the printer returned by pp_option
-printer prints "None" otherwise it uses the provided printer to print "Some ".
-
-Here is how to rewrite the pretty-printer using "fprintf":
-\begin{caml_example}{toplevel}
-let pp_expr ppf expr =
- let open_paren prec op_prec output =
- if prec > op_prec then Printf.fprintf output "%s" "(" in
- let close_paren prec op_prec output =
- if prec > op_prec then Printf.fprintf output "%s" ")" in
- let rec print prec ppf expr =
- match expr with
- | Const c -> Printf.fprintf ppf "%F" c
- | Var v -> Printf.fprintf ppf "%s" v
- | Sum(f, g) ->
- open_paren prec 0 ppf;
- Printf.fprintf ppf "%a + %a" (print 0) f (print 0) g;
- close_paren prec 0 ppf
- | Diff(f, g) ->
- open_paren prec 0 ppf;
- Printf.fprintf ppf "%a - %a" (print 0) f (print 1) g;
- close_paren prec 0 ppf
- | Prod(f, g) ->
- open_paren prec 2 ppf;
- Printf.fprintf ppf "%a * %a" (print 2) f (print 2) g;
- close_paren prec 2 ppf
- | Quot(f, g) ->
- open_paren prec 2 ppf;
- Printf.fprintf ppf "%a / %a" (print 2) f (print 3) g;
- close_paren prec 2 ppf
- in print 0 ppf expr;;
-pp_expr stdout e; print_newline ();;
-pp_expr stdout (deriv e "x"); print_newline ();;
-\end{caml_example}
-
-Due to the way that format string are build, storing a format string requires
-an explicit type annotation:
-\begin{caml_example*}{toplevel}
-let str : _ format =
- "%i is an integer value, %F is a float, %S\n";;
-\end{caml_example*}
-\begin{caml_example}{toplevel}
-Printf.printf str 3 4.5 "string value";;
-\end{caml_example}
-
-\section{s:standalone-programs}{Standalone OCaml programs}
-
-All examples given so far were executed under the interactive system.
-OCaml code can also be compiled separately and executed
-non-interactively using the batch compilers "ocamlc" and "ocamlopt".
-The source code must be put in a file with extension ".ml". It
-consists of a sequence of phrases, which will be evaluated at runtime
-in their order of appearance in the source file. Unlike in interactive
-mode, types and values are not printed automatically; the program must
-call printing functions explicitly to produce some output. The ";;" used
-in the interactive examples is not required in
-source files created for use with OCaml compilers, but can be helpful
-to mark the end of a top-level expression unambiguously even when
-there are syntax errors.
-Here is a
-sample standalone program to print the greatest common divisor
-(gcd) of two numbers:
-\begin{verbatim}
-(* File gcd.ml *)
-let rec gcd a b =
- if b = 0 then a
- else gcd b (a mod b);;
-
-let main () =
- let a = int_of_string Sys.argv.(1) in
- let b = int_of_string Sys.argv.(2) in
- Printf.printf "%d\n" (gcd a b);
- exit 0;;
-main ();;
-\end{verbatim}
-"Sys.argv" is an array of strings containing the command-line
-parameters. "Sys.argv.(1)" is thus the first command-line parameter.
-The program above is compiled and executed with the following shell
-commands:
-\begin{verbatim}
-$ ocamlc -o gcd gcd.ml
-$ ./gcd 6 9
-3
-$ ./gcd 7 11
-1
-\end{verbatim}
-
-More complex standalone OCaml programs are typically composed of
-multiple source files, and can link with precompiled libraries.
-Chapters~\ref{c:camlc} and~\ref{c:nativecomp} explain how to use the
-batch compilers "ocamlc" and "ocamlopt". Recompilation of
-multi-file OCaml projects can be automated using third-party
-build systems, such as \href{https://github.com/ocaml/dune}{dune}.
+++ /dev/null
-\chapter{Labels and variants} \label{c:labl-examples}
-%HEVEA\cutname{lablexamples.html}
-{\it (Chapter written by Jacques Garrigue)}
-
-\bigskip
-
-\noindent This chapter gives an overview of the new features in
-OCaml 3: labels, and polymorphic variants.
-
-\section{s:labels}{Labels}
-
-If you have a look at modules ending in "Labels" in the standard
-library, you will see that function types have annotations you did not
-have in the functions you defined yourself.
-
-\begin{caml_example}{toplevel}
-ListLabels.map;;
-StringLabels.sub;;
-\end{caml_example}
-
-Such annotations of the form "name:" are called {\em labels}. They are
-meant to document the code, allow more checking, and give more
-flexibility to function application.
-You can give such names to arguments in your programs, by prefixing them
-with a tilde "~".
-
-\begin{caml_example}{toplevel}
-let f ~x ~y = x - y;;
-let x = 3 and y = 2 in f ~x ~y;;
-\end{caml_example}
-
-When you want to use distinct names for the variable and the label
-appearing in the type, you can use a naming label of the form
-"~name:". This also applies when the argument is not a variable.
-
-\begin{caml_example}{toplevel}
-let f ~x:x1 ~y:y1 = x1 - y1;;
-f ~x:3 ~y:2;;
-\end{caml_example}
-
-Labels obey the same rules as other identifiers in OCaml, that is you
-cannot use a reserved keyword (like "in" or "to") as label.
-
-Formal parameters and arguments are matched according to their
-respective labels\footnote{This corresponds to the commuting label mode
-of Objective Caml 3.00 through 3.02, with some additional flexibility
-on total applications. The so-called classic mode ("-nolabels"
-options) is now deprecated for normal use.}, the absence of label
-being interpreted as the empty label.
-%
-This allows commuting arguments in applications. One can also
-partially apply a function on any argument, creating a new function of
-the remaining parameters.
-
-\begin{caml_example}{toplevel}
-let f ~x ~y = x - y;;
-f ~y:2 ~x:3;;
-ListLabels.fold_left;;
-ListLabels.fold_left [1;2;3] ~init:0 ~f:( + );;
-ListLabels.fold_left ~init:0;;
-\end{caml_example}
-
-If several arguments of a function bear the same label (or no label),
-they will not commute among themselves, and order matters. But they
-can still commute with other arguments.
-
-\begin{caml_example}{toplevel}
-let hline ~x:x1 ~x:x2 ~y = (x1, x2, y);;
-hline ~x:3 ~y:2 ~x:5;;
-\end{caml_example}
-
-As an exception to the above parameter matching rules, if an
-application is total (omitting all optional arguments), labels may be
-omitted.
-In practice, many applications are total, so that labels can often be
-omitted.
-\begin{caml_example}{toplevel}
-f 3 2;;
-ListLabels.map succ [1;2;3];;
-\end{caml_example}
-But beware that functions like "ListLabels.fold_left" whose result
-type is a type variable will never be considered as totally applied.
-\begin{caml_example}{toplevel}[error]
-ListLabels.fold_left ( + ) 0 [1;2;3];;
-\end{caml_example}
-
-When a function is passed as an argument to a higher-order function,
-labels must match in both types. Neither adding nor removing labels
-are allowed.
-\begin{caml_example}{toplevel}
-let h g = g ~x:3 ~y:2;;
-h f;;
-h ( + ) [@@expect error];;
-\end{caml_example}
-Note that when you don't need an argument, you can still use a wildcard
-pattern, but you must prefix it with the label.
-\begin{caml_example}{toplevel}
-h (fun ~x:_ ~y -> y+1);;
-\end{caml_example}
-
-\subsection{ss:optional-arguments}{Optional arguments}
-
-An interesting feature of labeled arguments is that they can be made
-optional. For optional parameters, the question mark "?" replaces the
-tilde "~" of non-optional ones, and the label is also prefixed by "?"
-in the function type.
-Default values may be given for such optional parameters.
-
-\begin{caml_example}{toplevel}
-let bump ?(step = 1) x = x + step;;
-bump 2;;
-bump ~step:3 2;;
-\end{caml_example}
-
-A function taking some optional arguments must also take at least one
-non-optional argument. The criterion for deciding whether an optional
-argument has been omitted is the non-labeled application of an
-argument appearing after this optional argument in the function type.
-Note that if that argument is labeled, you will only be able to
-eliminate optional arguments by totally applying the function,
-omitting all optional arguments and omitting all labels for all
-remaining arguments.
-
-\begin{caml_example}{toplevel}
-let test ?(x = 0) ?(y = 0) () ?(z = 0) () = (x, y, z);;
-test ();;
-test ~x:2 () ~z:3 ();;
-\end{caml_example}
-
-Optional parameters may also commute with non-optional or unlabeled
-ones, as long as they are applied simultaneously. By nature, optional
-arguments do not commute with unlabeled arguments applied
-independently.
-\begin{caml_example}{toplevel}
-test ~y:2 ~x:3 () ();;
-test () () ~z:1 ~y:2 ~x:3;;
-(test () ()) ~z:1 [@@expect error];;
-\end{caml_example}
-Here "(test () ())" is already "(0,0,0)" and cannot be further
-applied.
-
-Optional arguments are actually implemented as option types. If
-you do not give a default value, you have access to their internal
-representation, "type 'a option = None | Some of 'a". You can then
-provide different behaviors when an argument is present or not.
-
-\begin{caml_example}{toplevel}
-let bump ?step x =
- match step with
- | None -> x * 2
- | Some y -> x + y
-;;
-\end{caml_example}
-
-It may also be useful to relay an optional argument from a function
-call to another. This can be done by prefixing the applied argument
-with "?". This question mark disables the wrapping of optional
-argument in an option type.
-
-\begin{caml_example}{toplevel}
-let test2 ?x ?y () = test ?x ?y () ();;
-test2 ?x:None;;
-\end{caml_example}
-
-\subsection{ss:label-inference}{Labels and type inference}
-
-While they provide an increased comfort for writing function
-applications, labels and optional arguments have the pitfall that they
-cannot be inferred as completely as the rest of the language.
-
-You can see it in the following two examples.
-\begin{caml_example}{toplevel}
-let h' g = g ~y:2 ~x:3;;
-h' f [@@expect error];;
-let bump_it bump x =
- bump ~step:2 x;;
-bump_it bump 1 [@@expect error];;
-\end{caml_example}
-The first case is simple: "g" is passed "~y" and then "~x", but "f"
-expects "~x" and then "~y". This is correctly handled if we know the
-type of "g" to be "x:int -> y:int -> int" in advance, but otherwise
-this causes the above type clash. The simplest workaround is to apply
-formal parameters in a standard order.
-
-The second example is more subtle: while we intended the argument
-"bump" to be of type "?step:int -> int -> int", it is inferred as
-"step:int -> int -> 'a".
-%
-These two types being incompatible (internally normal and optional
-arguments are different), a type error occurs when applying "bump_it"
-to the real "bump".
-
-We will not try here to explain in detail how type inference works.
-One must just understand that there is not enough information in the
-above program to deduce the correct type of "g" or "bump". That is,
-there is no way to know whether an argument is optional or not, or
-which is the correct order, by looking only at how a function is
-applied. The strategy used by the compiler is to assume that there are
-no optional arguments, and that applications are done in the right
-order.
-
-The right way to solve this problem for optional parameters is to add
-a type annotation to the argument "bump".
-\begin{caml_example}{toplevel}
-let bump_it (bump : ?step:int -> int -> int) x =
- bump ~step:2 x;;
-bump_it bump 1;;
-\end{caml_example}
-In practice, such problems appear mostly when using objects whose
-methods have optional arguments, so that writing the type of object
-arguments is often a good idea.
-
-Normally the compiler generates a type error if you attempt to pass to
-a function a parameter whose type is different from the expected one.
-However, in the specific case where the expected type is a non-labeled
-function type, and the argument is a function expecting optional
-parameters, the compiler will attempt to transform the argument to
-have it match the expected type, by passing "None" for all optional
-parameters.
-
-\begin{caml_example}{toplevel}
-let twice f (x : int) = f(f x);;
-twice bump 2;;
-\end{caml_example}
-
-This transformation is coherent with the intended semantics,
-including side-effects. That is, if the application of optional
-parameters shall produce side-effects, these are delayed until the
-received function is really applied to an argument.
-
-\subsection{ss:label-suggestions}{Suggestions for labeling}
-
-Like for names, choosing labels for functions is not an easy task. A
-good labeling is a labeling which
-
-\begin{itemize}
-\item makes programs more readable,
-\item is easy to remember,
-\item when possible, allows useful partial applications.
-\end{itemize}
-
-We explain here the rules we applied when labeling OCaml
-libraries.
-
-To speak in an ``object-oriented'' way, one can consider that each
-function has a main argument, its {\em object}, and other arguments
-related with its action, the {\em parameters}. To permit the
-combination of functions through functionals in commuting label mode, the
-object will not be labeled. Its role is clear from the function
-itself. The parameters are labeled with names reminding of
-their nature or their role. The best labels combine nature and
-role. When this is not possible the role is to be preferred, since the
-nature will
-often be given by the type itself. Obscure abbreviations should be
-avoided.
-\begin{alltt}
-"ListLabels.map : f:('a -> 'b) -> 'a list -> 'b list"
-UnixLabels.write : file_descr -> buf:bytes -> pos:int -> len:int -> unit
-\end{alltt}
-
-When there are several objects of same nature and role, they are all
-left unlabeled.
-\begin{alltt}
-"ListLabels.iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit"
-\end{alltt}
-
-When there is no preferable object, all arguments are labeled.
-\begin{alltt}
-BytesLabels.blit :
- src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int -> unit
-\end{alltt}
-
-However, when there is only one argument, it is often left unlabeled.
-\begin{alltt}
-BytesLabels.create : int -> bytes
-\end{alltt}
-This principle also applies to functions of several arguments whose
-return type is a type variable, as long as the role of each argument
-is not ambiguous. Labeling such functions may lead to awkward error
-messages when one attempts to omit labels in an application, as we
-have seen with "ListLabels.fold_left".
-
-Here are some of the label names you will find throughout the
-libraries.
-
-\begin{tableau}{|l|l|}{Label}{Meaning}
-\entree{"f:"}{a function to be applied}
-\entree{"pos:"}{a position in a string, array or byte sequence}
-\entree{"len:"}{a length}
-\entree{"buf:"}{a byte sequence or string used as buffer}
-\entree{"src:"}{the source of an operation}
-\entree{"dst:"}{the destination of an operation}
-\entree{"init:"}{the initial value for an iterator}
-\entree{"cmp:"}{a comparison function, {\it e.g.} "Stdlib.compare"}
-\entree{"mode:"}{an operation mode or a flag list}
-\end{tableau}
-
-All these are only suggestions, but keep in mind that the
-choice of labels is essential for readability. Bizarre choices will
-make the program harder to maintain.
-
-In the ideal, the right function name with right labels should be
-enough to understand the function's meaning. Since one can get this
-information with OCamlBrowser or the "ocaml" toplevel, the documentation
-is only used when a more detailed specification is needed.
-
-\begin{caml_eval}
-#label false;;
-\end{caml_eval}
-
-
-\section{s:polymorphic-variants}{Polymorphic variants}
-
-Variants as presented in section~\ref{s:tut-recvariants} are a
-powerful tool to build data structures and algorithms. However they
-sometimes lack flexibility when used in modular programming. This is
-due to the fact that every constructor is assigned to a unique type
-when defined and used. Even if the same name appears in the definition
-of multiple types, the constructor itself belongs to only one type.
-Therefore, one cannot decide that a given constructor belongs to
-multiple types, or consider a value of some type to belong to some
-other type with more constructors.
-
-With polymorphic variants, this original assumption is removed. That
-is, a variant tag does not belong to any type in particular, the type
-system will just check that it is an admissible value according to its
-use. You need not define a type before using a variant tag. A variant
-type will be inferred independently for each of its uses.
-
-\subsection*{ss:polyvariant:basic-use}{Basic use}
-
-In programs, polymorphic variants work like usual ones. You just have
-to prefix their names with a backquote character "`".
-\begin{caml_example}{toplevel}
-[`On; `Off];;
-`Number 1;;
-let f = function `On -> 1 | `Off -> 0 | `Number n -> n;;
-List.map f [`On; `Off];;
-\end{caml_example}
-"[>`Off|`On] list" means that to match this list, you should at
-least be able to match "`Off" and "`On", without argument.
-"[<`On|`Off|`Number of int]" means that "f" may be applied to "`Off",
-"`On" (both without argument), or "`Number" $n$ where
-$n$ is an integer.
-The ">" and "<" inside the variant types show that they may still be
-refined, either by defining more tags or by allowing less. As such, they
-contain an implicit type variable. Because each of the variant types
-appears only once in the whole type, their implicit type variables are
-not shown.
-
-The above variant types were polymorphic, allowing further refinement.
-When writing type annotations, one will most often describe fixed
-variant types, that is types that cannot be refined. This is
-also the case for type abbreviations. Such types do not contain "<" or
-">", but just an enumeration of the tags and their associated types,
-just like in a normal datatype definition.
-\begin{caml_example}{toplevel}
-type 'a vlist = [`Nil | `Cons of 'a * 'a vlist];;
-let rec map f : 'a vlist -> 'b vlist = function
- | `Nil -> `Nil
- | `Cons(a, l) -> `Cons(f a, map f l)
-;;
-\end{caml_example}
-
-\subsection*{ss:polyvariant-advanced}{Advanced use}
-
-Type-checking polymorphic variants is a subtle thing, and some
-expressions may result in more complex type information.
-
-\begin{caml_example}{toplevel}
-let f = function `A -> `C | `B -> `D | x -> x;;
-f `E;;
-\end{caml_example}
-Here we are seeing two phenomena. First, since this matching is open
-(the last case catches any tag), we obtain the type "[> `A | `B]"
-rather than "[< `A | `B]" in a closed matching. Then, since "x" is
-returned as is, input and return types are identical. The notation "as
-'a" denotes such type sharing. If we apply "f" to yet another tag
-"`E", it gets added to the list.
-
-\begin{caml_example}{toplevel}
-let f1 = function `A x -> x = 1 | `B -> true | `C -> false
-let f2 = function `A x -> x = "a" | `B -> true ;;
-let f x = f1 x && f2 x;;
-\end{caml_example}
-Here "f1" and "f2" both accept the variant tags "`A" and "`B", but the
-argument of "`A" is "int" for "f1" and "string" for "f2". In "f"'s
-type "`C", only accepted by "f1", disappears, but both argument types
-appear for "`A" as "int & string". This means that if we
-pass the variant tag "`A" to "f", its argument should be {\em both}
-"int" and "string". Since there is no such value, "f" cannot be
-applied to "`A", and "`B" is the only accepted input.
-
-Even if a value has a fixed variant type, one can still give it a
-larger type through coercions. Coercions are normally written with
-both the source type and the destination type, but in simple cases the
-source type may be omitted.
-\begin{caml_example}{toplevel}
-type 'a wlist = [`Nil | `Cons of 'a * 'a wlist | `Snoc of 'a wlist * 'a];;
-let wlist_of_vlist l = (l : 'a vlist :> 'a wlist);;
-let open_vlist l = (l : 'a vlist :> [> 'a vlist]);;
-fun x -> (x :> [`A|`B|`C]);;
-\end{caml_example}
-
-You may also selectively coerce values through pattern matching.
-\begin{caml_example}{toplevel}
-let split_cases = function
- | `Nil | `Cons _ as x -> `A x
- | `Snoc _ as x -> `B x
-;;
-\end{caml_example}
-When an or-pattern composed of variant tags is wrapped inside an
-alias-pattern, the alias is given a type containing only the tags
-enumerated in the or-pattern. This allows for many useful idioms, like
-incremental definition of functions.
-
-\begin{caml_example}{toplevel}
-let num x = `Num x
-let eval1 eval (`Num x) = x
-let rec eval x = eval1 eval x ;;
-let plus x y = `Plus(x,y)
-let eval2 eval = function
- | `Plus(x,y) -> eval x + eval y
- | `Num _ as x -> eval1 eval x
-let rec eval x = eval2 eval x ;;
-\end{caml_example}
-
-To make this even more comfortable, you may use type definitions as
-abbreviations for or-patterns. That is, if you have defined "type
-myvariant = [`Tag1 of int | `Tag2 of bool]", then the pattern "#myvariant" is
-equivalent to writing "(`Tag1(_ : int) | `Tag2(_ : bool))".
-\begin{caml_eval}
-type myvariant = [`Tag1 of int | `Tag2 of bool];;
-\end{caml_eval}
-
-Such abbreviations may be used alone,
-\begin{caml_example}{toplevel}
-let f = function
- | #myvariant -> "myvariant"
- | `Tag3 -> "Tag3";;
-\end{caml_example}
-or combined with with aliases.
-\begin{caml_example}{toplevel}
-let g1 = function `Tag1 _ -> "Tag1" | `Tag2 _ -> "Tag2";;
-let g = function
- | #myvariant as x -> g1 x
- | `Tag3 -> "Tag3";;
-\end{caml_example}
-
-\subsection{ss:polyvariant-weaknesses}{Weaknesses of polymorphic variants}
-
-After seeing the power of polymorphic variants, one may wonder why
-they were added to core language variants, rather than replacing them.
-
-The answer is twofold. One first aspect is that while being pretty
-efficient, the lack of static type information allows for less
-optimizations, and makes polymorphic variants slightly heavier than
-core language ones. However noticeable differences would only
-appear on huge data structures.
-
-More important is the fact that polymorphic variants, while being
-type-safe, result in a weaker type discipline. That is, core language
-variants do actually much more than ensuring type-safety, they also
-check that you use only declared constructors, that all constructors
-present in a data-structure are compatible, and they enforce typing
-constraints to their parameters.
-
-For this reason, you must be more careful about making types explicit
-when you use polymorphic variants. When you write a library, this is
-easy since you can describe exact types in interfaces, but for simple
-programs you are probably better off with core language variants.
-
-Beware also that some idioms make trivial errors very hard to find.
-For instance, the following code is probably wrong but the compiler
-has no way to see it.
-\begin{caml_example}{toplevel}
-type abc = [`A | `B | `C] ;;
-let f = function
- | `As -> "A"
- | #abc -> "other" ;;
-let f : abc -> string = f ;;
-\end{caml_example}
-You can avoid such risks by annotating the definition itself.
-\begin{caml_example}{toplevel}[error]
-let f : abc -> string = function
- | `As -> "A"
- | #abc -> "other" ;;
-\end{caml_example}
+++ /dev/null
-\chapter{The module system} \label{c:moduleexamples}
-%HEVEA\cutname{moduleexamples.html}
-
-This chapter introduces the module system of OCaml.
-
-\section{s:module:structures}{Structures}
-
-A primary motivation for modules is to package together related
-definitions (such as the definitions of a data type and associated
-operations over that type) and enforce a consistent naming scheme for
-these definitions. This avoids running out of names or accidentally
-confusing names. Such a package is called a {\em structure} and
-is introduced by the "struct"\ldots"end" construct, which contains an
-arbitrary sequence of definitions. The structure is usually given a
-name with the "module" binding. Here is for instance a structure
-packaging together a type of priority queues and their operations:
-\begin{caml_example}{toplevel}
-module PrioQueue =
- struct
- type priority = int
- type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue
- let empty = Empty
- let rec insert queue prio elt =
- match queue with
- Empty -> Node(prio, elt, Empty, Empty)
- | Node(p, e, left, right) ->
- if prio <= p
- then Node(prio, elt, insert right p e, left)
- else Node(p, e, insert right prio elt, left)
- exception Queue_is_empty
- let rec remove_top = function
- Empty -> raise Queue_is_empty
- | Node(prio, elt, left, Empty) -> left
- | Node(prio, elt, Empty, right) -> right
- | Node(prio, elt, (Node(lprio, lelt, _, _) as left),
- (Node(rprio, relt, _, _) as right)) ->
- if lprio <= rprio
- then Node(lprio, lelt, remove_top left, right)
- else Node(rprio, relt, left, remove_top right)
- let extract = function
- Empty -> raise Queue_is_empty
- | Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue)
- end;;
-\end{caml_example}
-Outside the structure, its components can be referred to using the
-``dot notation'', that is, identifiers qualified by a structure name.
-For instance, "PrioQueue.insert" is the function "insert" defined
-inside the structure "PrioQueue" and "PrioQueue.queue" is the type
-"queue" defined in "PrioQueue".
-\begin{caml_example}{toplevel}
-PrioQueue.insert PrioQueue.empty 1 "hello";;
-\end{caml_example}
-
-Another possibility is to open the module, which brings all
-identifiers defined inside the module in the scope of the current
-structure.
-
-\begin{caml_example}{toplevel}
-open PrioQueue;;
-insert empty 1 "hello";;
-\end{caml_example}
-
-Opening a module enables lighter access to its components, at the
-cost of making it harder to identify in which module a identifier
-has been defined. In particular, opened modules can shadow
-identifiers present in the current scope, potentially leading
-to confusing errors:
-
-\begin{caml_example}{toplevel}
-let empty = []
-open PrioQueue;;
-let x = 1 :: empty [@@expect error];;
-\end{caml_example}
-
-
-A partial solution to this conundrum is to open modules locally,
-making the components of the module available only in the
-concerned expression. This can also make the code both easier to read
-(since the open statement is closer to where it is used) and easier to refactor
-(since the code fragment is more self-contained).
-Two constructions are available for this purpose:
-\begin{caml_example}{toplevel}
-let open PrioQueue in
-insert empty 1 "hello";;
-\end{caml_example}
-and
-\begin{caml_example}{toplevel}
-PrioQueue.(insert empty 1 "hello");;
-\end{caml_example}
-In the second form, when the body of a local open is itself delimited
-by parentheses, braces or bracket, the parentheses of the local open
-can be omitted. For instance,
-\begin{caml_example}{toplevel}
-PrioQueue.[empty] = PrioQueue.([empty]);;
-PrioQueue.[|empty|] = PrioQueue.([|empty|]);;
-PrioQueue.{ contents = empty } = PrioQueue.({ contents = empty });;
-\end{caml_example}
-becomes
-\begin{caml_example}{toplevel}
-PrioQueue.[insert empty 1 "hello"];;
-\end{caml_example}
-This second form also works for patterns:
-\begin{caml_example}{toplevel}
-let at_most_one_element x = match x with
-| PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
-| _ -> false ;;
-\end{caml_example}
-
-It is also possible to copy the components of a module inside
-another module by using an "include" statement. This can be
-particularly useful to extend existing modules. As an illustration,
-we could add functions that returns an optional value rather than
-an exception when the priority queue is empty.
-\begin{caml_example}{toplevel}
-module PrioQueueOpt =
-struct
- include PrioQueue
-
- let remove_top_opt x =
- try Some(remove_top x) with Queue_is_empty -> None
-
- let extract_opt x =
- try Some(extract x) with Queue_is_empty -> None
-end;;
-\end{caml_example}
-
-\section{s:signature}{Signatures}
-
-Signatures are interfaces for structures. A signature specifies
-which components of a structure are accessible from the outside, and
-with which type. It can be used to hide some components of a structure
-(e.g. local function definitions) or export some components with a
-restricted type. For instance, the signature below specifies the three
-priority queue operations "empty", "insert" and "extract", but not the
-auxiliary function "remove_top". Similarly, it makes the "queue" type
-abstract (by not providing its actual representation as a concrete type).
-\begin{caml_example}{toplevel}
-module type PRIOQUEUE =
- sig
- type priority = int (* still concrete *)
- type 'a queue (* now abstract *)
- val empty : 'a queue
- val insert : 'a queue -> int -> 'a -> 'a queue
- val extract : 'a queue -> int * 'a * 'a queue
- exception Queue_is_empty
- end;;
-\end{caml_example}
-Restricting the "PrioQueue" structure by this signature results in
-another view of the "PrioQueue" structure where the "remove_top"
-function is not accessible and the actual representation of priority
-queues is hidden:
-\begin{caml_example}{toplevel}
-module AbstractPrioQueue = (PrioQueue : PRIOQUEUE);;
-AbstractPrioQueue.remove_top [@@expect error];;
-AbstractPrioQueue.insert AbstractPrioQueue.empty 1 "hello";;
-\end{caml_example}
-The restriction can also be performed during the definition of the
-structure, as in
-\begin{verbatim}
-module PrioQueue = (struct ... end : PRIOQUEUE);;
-\end{verbatim}
-An alternate syntax is provided for the above:
-\begin{verbatim}
-module PrioQueue : PRIOQUEUE = struct ... end;;
-\end{verbatim}
-
-Like for modules, it is possible to include a signature to copy
-its components inside the current signature. For instance, we
-can extend the PRIOQUEUE signature with the "extract_opt"
-function:
-
-\begin{caml_example}{toplevel}
-module type PRIOQUEUE_WITH_OPT =
- sig
- include PRIOQUEUE
- val extract_opt : 'a queue -> (int * 'a * 'a queue) option
- end;;
-\end{caml_example}
-
-
-\section{s:functors}{Functors}
-
-Functors are ``functions'' from modules to modules. Functors let you create
-parameterized modules and then provide other modules as parameter(s) to get
-a specific implementation. For instance, a "Set" module implementing sets
-as sorted lists could be parameterized to work with any module that provides
-an element type and a comparison function "compare" (such as "OrderedString"):
-
-\begin{caml_example}{toplevel}
-type comparison = Less | Equal | Greater;;
-module type ORDERED_TYPE =
- sig
- type t
- val compare: t -> t -> comparison
- end;;
-module Set =
- functor (Elt: ORDERED_TYPE) ->
- struct
- type element = Elt.t
- type set = element list
- let empty = []
- let rec add x s =
- match s with
- [] -> [x]
- | hd::tl ->
- match Elt.compare x hd with
- Equal -> s (* x is already in s *)
- | Less -> x :: s (* x is smaller than all elements of s *)
- | Greater -> hd :: add x tl
- let rec member x s =
- match s with
- [] -> false
- | hd::tl ->
- match Elt.compare x hd with
- Equal -> true (* x belongs to s *)
- | Less -> false (* x is smaller than all elements of s *)
- | Greater -> member x tl
- end;;
-\end{caml_example}
-By applying the "Set" functor to a structure implementing an ordered
-type, we obtain set operations for this type:
-\begin{caml_example}{toplevel}
-module OrderedString =
- struct
- type t = string
- let compare x y = if x = y then Equal else if x < y then Less else Greater
- end;;
-module StringSet = Set(OrderedString);;
-StringSet.member "bar" (StringSet.add "foo" StringSet.empty);;
-\end{caml_example}
-
-\section{s:functors-and-abstraction}{Functors and type abstraction}
-
-As in the "PrioQueue" example, it would be good style to hide the
-actual implementation of the type "set", so that users of the
-structure will not rely on sets being lists, and we can switch later
-to another, more efficient representation of sets without breaking
-their code. This can be achieved by restricting "Set" by a suitable
-functor signature:
-\begin{caml_example}{toplevel}
-module type SETFUNCTOR =
- functor (Elt: ORDERED_TYPE) ->
- sig
- type element = Elt.t (* concrete *)
- type set (* abstract *)
- val empty : set
- val add : element -> set -> set
- val member : element -> set -> bool
- end;;
-module AbstractSet = (Set : SETFUNCTOR);;
-module AbstractStringSet = AbstractSet(OrderedString);;
-AbstractStringSet.add "gee" AbstractStringSet.empty;;
-\end{caml_example}
-
-In an attempt to write the type constraint above more elegantly,
-one may wish to name the signature of the structure
-returned by the functor, then use that signature in the constraint:
-\begin{caml_example}{toplevel}
-module type SET =
- sig
- type element
- type set
- val empty : set
- val add : element -> set -> set
- val member : element -> set -> bool
- end;;
-module WrongSet = (Set : functor(Elt: ORDERED_TYPE) -> SET);;
-module WrongStringSet = WrongSet(OrderedString);;
-WrongStringSet.add "gee" WrongStringSet.empty [@@expect error];;
-\end{caml_example}
-The problem here is that "SET" specifies the type "element"
-abstractly, so that the type equality between "element" in the result
-of the functor and "t" in its argument is forgotten. Consequently,
-"WrongStringSet.element" is not the same type as "string", and the
-operations of "WrongStringSet" cannot be applied to strings.
-As demonstrated above, it is important that the type "element" in the
-signature "SET" be declared equal to "Elt.t"; unfortunately, this is
-impossible above since "SET" is defined in a context where "Elt" does
-not exist. To overcome this difficulty, OCaml provides a
-"with type" construct over signatures that allows enriching a signature
-with extra type equalities:
-\begin{caml_example}{toplevel}
-module AbstractSet2 =
- (Set : functor(Elt: ORDERED_TYPE) -> (SET with type element = Elt.t));;
-\end{caml_example}
-
-As in the case of simple structures, an alternate syntax is provided
-for defining functors and restricting their result:
-\begin{verbatim}
-module AbstractSet2(Elt: ORDERED_TYPE) : (SET with type element = Elt.t) =
- struct ... end;;
-\end{verbatim}
-
-Abstracting a type component in a functor result is a powerful
-technique that provides a high degree of type safety, as we now
-illustrate. Consider an ordering over character strings that is
-different from the standard ordering implemented in the
-"OrderedString" structure. For instance, we compare strings without
-distinguishing upper and lower case.
-\begin{caml_example}{toplevel}
-module NoCaseString =
- struct
- type t = string
- let compare s1 s2 =
- OrderedString.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
- end;;
-module NoCaseStringSet = AbstractSet(NoCaseString);;
-NoCaseStringSet.add "FOO" AbstractStringSet.empty [@@expect error];;
-\end{caml_example}
-Note that the two types "AbstractStringSet.set" and
-"NoCaseStringSet.set" are not compatible, and values of these
-two types do not match. This is the correct behavior: even though both
-set types contain elements of the same type (strings), they are built
-upon different orderings of that type, and different invariants need
-to be maintained by the operations (being strictly increasing for the
-standard ordering and for the case-insensitive ordering). Applying
-operations from "AbstractStringSet" to values of type
-"NoCaseStringSet.set" could give incorrect results, or build
-lists that violate the invariants of "NoCaseStringSet".
-
-\section{s:separate-compilation}{Modules and separate compilation}
-
-All examples of modules so far have been given in the context of the
-interactive system. However, modules are most useful for large,
-batch-compiled programs. For these programs, it is a practical
-necessity to split the source into several files, called compilation
-units, that can be compiled separately, thus minimizing recompilation
-after changes.
-
-In OCaml, compilation units are special cases of structures
-and signatures, and the relationship between the units can be
-explained easily in terms of the module system. A compilation unit \var{A}
-comprises two files:
-\begin{itemize}
-\item the implementation file \var{A}".ml", which contains a sequence
-of definitions, analogous to the inside of a "struct"\ldots"end"
-construct;
-\item the interface file \var{A}".mli", which contains a sequence of
-specifications, analogous to the inside of a "sig"\ldots"end"
-construct.
-\end{itemize}
-These two files together define a structure named \var{A} as if
-the following definition was entered at top-level:
-\begin{alltt}
-module \var{A}: sig (* \hbox{contents of file} \var{A}.mli *) end
- = struct (* \hbox{contents of file} \var{A}.ml *) end;;
-\end{alltt}
-The files that define the compilation units can be compiled separately
-using the "ocamlc -c" command (the "-c" option means ``compile only, do
-not try to link''); this produces compiled interface files (with
-extension ".cmi") and compiled object code files (with extension
-".cmo"). When all units have been compiled, their ".cmo" files are
-linked together using the "ocamlc" command. For instance, the following
-commands compile and link a program composed of two compilation units
-"Aux" and "Main":
-\begin{verbatim}
-$ ocamlc -c Aux.mli # produces aux.cmi
-$ ocamlc -c Aux.ml # produces aux.cmo
-$ ocamlc -c Main.mli # produces main.cmi
-$ ocamlc -c Main.ml # produces main.cmo
-$ ocamlc -o theprogram Aux.cmo Main.cmo
-\end{verbatim}
-The program behaves exactly as if the following phrases were entered
-at top-level:
-\begin{alltt}
-module Aux: sig (* \rminalltt{contents of} Aux.mli *) end
- = struct (* \rminalltt{contents of} Aux.ml *) end;;
-module Main: sig (* \rminalltt{contents of} Main.mli *) end
- = struct (* \rminalltt{contents of} Main.ml *) end;;
-\end{alltt}
-In particular, "Main" can refer to "Aux": the definitions and
-declarations contained in "Main.ml" and "Main.mli" can refer to
-definition in "Aux.ml", using the "Aux."\var{ident} notation, provided
-these definitions are exported in "Aux.mli".
-
-The order in which the ".cmo" files are given to "ocamlc" during the
-linking phase determines the order in which the module definitions
-occur. Hence, in the example above, "Aux" appears first and "Main" can
-refer to it, but "Aux" cannot refer to "Main".
-
-Note that only top-level structures can be mapped to
-separately-compiled files, but neither functors nor module types.
-However, all module-class objects can appear as components of a
-structure, so the solution is to put the functor or module type
-inside a structure, which can then be mapped to a file.
+++ /dev/null
-\chapter{Objects in OCaml}
-\label{c:objectexamples}
-%HEVEA\cutname{objectexamples.html}
-{\it (Chapter written by Jérôme Vouillon, Didier Rémy and Jacques Garrigue)}
-
-\bigskip
-
-\noindent This chapter gives an overview of the object-oriented features of
-OCaml.
-
-Note that the relationship between object, class and type in OCaml is
-different than in mainstream object-oriented languages such as Java and
-C++, so you shouldn't assume that similar keywords mean the same thing.
-Object-oriented features are used much less frequently in OCaml than
-in those languages. OCaml has alternatives that are often more appropriate,
-such as modules and functors. Indeed, many OCaml programs do not use objects
-at all.
-
-\section{s:classes-and-objects}{Classes and objects}
-
-The class "point" below defines one instance variable "x" and two methods
-"get_x" and "move". The initial value of the instance variable is "0".
-The variable "x" is declared mutable, so the method "move" can change
-its value.
-\begin{caml_example}{toplevel}
-class point =
- object
- val mutable x = 0
- method get_x = x
- method move d = x <- x + d
- end;;
-\end{caml_example}
-
-We now create a new point "p", instance of the "point" class.
-\begin{caml_example}{toplevel}
-let p = new point;;
-\end{caml_example}
-Note that the type of "p" is "point". This is an abbreviation
-automatically defined by the class definition above. It stands for the
-object type "<get_x : int; move : int -> unit>", listing the methods
-of class "point" along with their types.
-
-We now invoke some methods of "p":
-\begin{caml_example}{toplevel}
-p#get_x;;
-p#move 3;;
-p#get_x;;
-\end{caml_example}
-
-The evaluation of the body of a class only takes place at object
-creation time. Therefore, in the following example, the instance
-variable "x" is initialized to different values for two different
-objects.
-\begin{caml_example}{toplevel}
-let x0 = ref 0;;
-class point =
- object
- val mutable x = incr x0; !x0
- method get_x = x
- method move d = x <- x + d
- end;;
-new point#get_x;;
-new point#get_x;;
-\end{caml_example}
-
-The class "point" can also be abstracted over the initial values of
-the "x" coordinate.
-\begin{caml_example}{toplevel}
-class point = fun x_init ->
- object
- val mutable x = x_init
- method get_x = x
- method move d = x <- x + d
- end;;
-\end{caml_example}
-Like in function definitions, the definition above can be
-abbreviated as:
-\begin{caml_example}{toplevel}
-class point x_init =
- object
- val mutable x = x_init
- method get_x = x
- method move d = x <- x + d
- end;;
-\end{caml_example}
-An instance of the class "point" is now a function that expects an
-initial parameter to create a point object:
-\begin{caml_example}{toplevel}
-new point;;
-let p = new point 7;;
-\end{caml_example}
-The parameter "x_init" is, of course, visible in the whole body of the
-definition, including methods. For instance, the method "get_offset"
-in the class below returns the position of the object relative to its
-initial position.
-\begin{caml_example}{toplevel}
-class point x_init =
- object
- val mutable x = x_init
- method get_x = x
- method get_offset = x - x_init
- method move d = x <- x + d
- end;;
-\end{caml_example}
-%Instance variables can only be used inside methods. For instance it would
-%not be possible to define
-%\begin{caml_example}{toplevel}
-%class point x_init =
-% object
-% val mutable x = x_init
-% val origin = x
-% method get_offset = x - origin
-% method move d = x <- x + d
-% end;;
-%\end{caml_example}
-Expressions can be evaluated and bound before defining the object body
-of the class. This is useful to enforce invariants. For instance,
-points can be automatically adjusted to the nearest point on a grid,
-as follows:
-\begin{caml_example}{toplevel}
-class adjusted_point x_init =
- let origin = (x_init / 10) * 10 in
- object
- val mutable x = origin
- method get_x = x
- method get_offset = x - origin
- method move d = x <- x + d
- end;;
-\end{caml_example}
-(One could also raise an exception if the "x_init" coordinate is not
-on the grid.) In fact, the same effect could here be obtained by
-calling the definition of class "point" with the value of the
-"origin".
-\begin{caml_example}{toplevel}
-class adjusted_point x_init = point ((x_init / 10) * 10);;
-\end{caml_example}
-An alternate solution would have been to define the adjustment in
-a special allocation function:
-\begin{caml_example}{toplevel}
-let new_adjusted_point x_init = new point ((x_init / 10) * 10);;
-\end{caml_example}
-However, the former pattern is generally more appropriate, since
-the code for adjustment is part of the definition of the class and will be
-inherited.
-
-This ability provides class constructors as can be found in other
-languages. Several constructors can be defined this way to build objects of
-the same class but with different initialization patterns; an
-alternative is to use initializers, as described below in
-section~\ref{s:initializers}.
-
-\section{s:immediate-objects}{Immediate objects}
-
-There is another, more direct way to create an object: create it
-without going through a class.
-
-The syntax is exactly the same as for class expressions, but the
-result is a single object rather than a class. All the constructs
-described in the rest of this section also apply to immediate objects.
-\begin{caml_example}{toplevel}
-let p =
- object
- val mutable x = 0
- method get_x = x
- method move d = x <- x + d
- end;;
-p#get_x;;
-p#move 3;;
-p#get_x;;
-\end{caml_example}
-
-Unlike classes, which cannot be defined inside an expression,
-immediate objects can appear anywhere, using variables from their
-environment.
-\begin{caml_example}{toplevel}
-let minmax x y =
- if x < y then object method min = x method max = y end
- else object method min = y method max = x end;;
-\end{caml_example}
-
-Immediate objects have two weaknesses compared to classes: their types
-are not abbreviated, and you cannot inherit from them. But these two
-weaknesses can be advantages in some situations, as we will see
-in sections~\ref{s:reference-to-self} and~\ref{s:parameterized-classes}.
-
-\section{s:reference-to-self}{Reference to self}
-
-A method or an initializer can invoke methods on self (that is,
-the current object). For that, self must be explicitly bound, here to
-the variable "s" ("s" could be any identifier, even though we will
-often choose the name "self".)
-\begin{caml_example}{toplevel}
-class printable_point x_init =
- object (s)
- val mutable x = x_init
- method get_x = x
- method move d = x <- x + d
- method print = print_int s#get_x
- end;;
-let p = new printable_point 7;;
-p#print;;
-\end{caml_example}
-Dynamically, the variable "s" is bound at the invocation of a method. In
-particular, when the class "printable_point" is inherited, the variable
-"s" will be correctly bound to the object of the subclass.
-
-A common problem with self is that, as its type may be extended in
-subclasses, you cannot fix it in advance. Here is a simple example.
-\begin{caml_example}{toplevel}
-let ints = ref [];;
-class my_int =
- object (self)
- method n = 1
- method register = ints := self :: !ints
- end [@@expect error];;
-\end{caml_example}
-You can ignore the first two lines of the error message. What matters
-is the last one: putting self into an external reference would make it
-impossible to extend it through inheritance.
-We will see in section~\ref{s:using-coercions} a workaround to this
-problem.
-Note however that, since immediate objects are not extensible, the
-problem does not occur with them.
-\begin{caml_example}{toplevel}
-let my_int =
- object (self)
- method n = 1
- method register = ints := self :: !ints
- end;;
-\end{caml_example}
-
-\section{s:initializers}{Initializers}
-
-Let-bindings within class definitions are evaluated before the object
-is constructed. It is also possible to evaluate an expression
-immediately after the object has been built. Such code is written as
-an anonymous hidden method called an initializer. Therefore, it can
-access self and the instance variables.
-\begin{caml_example}{toplevel}
-class printable_point x_init =
- let origin = (x_init / 10) * 10 in
- object (self)
- val mutable x = origin
- method get_x = x
- method move d = x <- x + d
- method print = print_int self#get_x
- initializer print_string "new point at "; self#print; print_newline ()
- end;;
-let p = new printable_point 17;;
-\end{caml_example}
-Initializers cannot be overridden. On the contrary, all initializers are
-evaluated sequentially.
-Initializers are particularly useful to enforce invariants.
-Another example can be seen in section~\ref{s:extended-bank-accounts}.
-
-
-\section{s:virtual-methods}{Virtual methods}
-
-It is possible to declare a method without actually defining it, using
-the keyword "virtual". This method will be provided later in
-subclasses. A class containing virtual methods must be flagged
-"virtual", and cannot be instantiated (that is, no object of this class
-can be created). It still defines type abbreviations (treating virtual methods
-as other methods.)
-\begin{caml_example}{toplevel}
-class virtual abstract_point x_init =
- object (self)
- method virtual get_x : int
- method get_offset = self#get_x - x_init
- method virtual move : int -> unit
- end;;
-class point x_init =
- object
- inherit abstract_point x_init
- val mutable x = x_init
- method get_x = x
- method move d = x <- x + d
- end;;
-\end{caml_example}
-
-Instance variables can also be declared as virtual, with the same effect
-as with methods.
-\begin{caml_example}{toplevel}
-class virtual abstract_point2 =
- object
- val mutable virtual x : int
- method move d = x <- x + d
- end;;
-class point2 x_init =
- object
- inherit abstract_point2
- val mutable x = x_init
- method get_offset = x - x_init
- end;;
-\end{caml_example}
-
-\section{s:private-methods}{Private methods}
-
-Private methods are methods that do not appear in object interfaces.
-They can only be invoked from other methods of the same object.
-\begin{caml_example}{toplevel}
-class restricted_point x_init =
- object (self)
- val mutable x = x_init
- method get_x = x
- method private move d = x <- x + d
- method bump = self#move 1
- end;;
-let p = new restricted_point 0;;
-p#move 10 [@@expect error] ;;
-p#bump;;
-\end{caml_example}
-Note that this is not the same thing as private and protected methods
-in Java or C++, which can be called from other objects of the same
-class. This is a direct consequence of the independence between types
-and classes in OCaml: two unrelated classes may produce
-objects of the same type, and there is no way at the type level to
-ensure that an object comes from a specific class. However a possible
-encoding of friend methods is given in section~\ref{s:friends}.
-
-Private methods are inherited (they are by default visible in subclasses),
-unless they are hidden by signature matching, as described below.
-
-Private methods can be made public in a subclass.
-\begin{caml_example}{toplevel}
-class point_again x =
- object (self)
- inherit restricted_point x
- method virtual move : _
- end;;
-\end{caml_example}
-The annotation "virtual" here is only used to mention a method without
-providing its definition. Since we didn't add the "private"
-annotation, this makes the method public, keeping the original
-definition.
-
-An alternative definition is
-\begin{caml_example}{toplevel}
-class point_again x =
- object (self : < move : _; ..> )
- inherit restricted_point x
- end;;
-\end{caml_example}
-The constraint on self's type is requiring a public "move" method, and
-this is sufficient to override "private".
-
-One could think that a private method should remain private in a subclass.
-However, since the method is visible in a subclass, it is always possible
-to pick its code and define a method of the same name that runs that
-code, so yet another (heavier) solution would be:
-\begin{caml_example}{toplevel}
-class point_again x =
- object
- inherit restricted_point x as super
- method move = super#move
- end;;
-\end{caml_example}
-
-Of course, private methods can also be virtual. Then, the keywords must
-appear in this order "method private virtual".
-
-\section{s:class-interfaces}{Class interfaces}
-
-
-%XXX Differentiate class type and class interface ?
-
-Class interfaces are inferred from class definitions. They may also
-be defined directly and used to restrict the type of a class. Like class
-declarations, they also define a new type abbreviation.
-\begin{caml_example}{toplevel}
-class type restricted_point_type =
- object
- method get_x : int
- method bump : unit
-end;;
-fun (x : restricted_point_type) -> x;;
-\end{caml_example}
-In addition to program documentation, class interfaces can be used to
-constrain the type of a class. Both concrete instance variables and concrete
-private methods can be hidden by a class type constraint. Public
-methods and virtual members, however, cannot.
-\begin{caml_example}{toplevel}
-class restricted_point' x = (restricted_point x : restricted_point_type);;
-\end{caml_example}
-Or, equivalently:
-\begin{caml_example}{toplevel}
-class restricted_point' = (restricted_point : int -> restricted_point_type);;
-\end{caml_example}
-The interface of a class can also be specified in a module
-signature, and used to restrict the inferred signature of a module.
-\begin{caml_example}{toplevel}
-module type POINT = sig
- class restricted_point' : int ->
- object
- method get_x : int
- method bump : unit
- end
-end;;
-module Point : POINT = struct
- class restricted_point' = restricted_point
-end;;
-\end{caml_example}
-
-\section{s:inheritance}{Inheritance}
-
-We illustrate inheritance by defining a class of colored points that
-inherits from the class of points. This class has all instance
-variables and all methods of class "point", plus a new instance
-variable "c" and a new method "color".
-\begin{caml_example}{toplevel}
-class colored_point x (c : string) =
- object
- inherit point x
- val c = c
- method color = c
- end;;
-let p' = new colored_point 5 "red";;
-p'#get_x, p'#color;;
-\end{caml_example}
-A point and a colored point have incompatible types, since a point has
-no method "color". However, the function "get_x" below is a generic
-function applying method "get_x" to any object "p" that has this
-method (and possibly some others, which are represented by an ellipsis
-in the type). Thus, it applies to both points and colored points.
-\begin{caml_example}{toplevel}
-let get_succ_x p = p#get_x + 1;;
-get_succ_x p + get_succ_x p';;
-\end{caml_example}
-Methods need not be declared previously, as shown by the example:
-\begin{caml_example}{toplevel}
-let set_x p = p#set_x;;
-let incr p = set_x p (get_succ_x p);;
-\end{caml_example}
-
-\section{s:multiple-inheritance}{Multiple inheritance}
-
-Multiple inheritance is allowed. Only the last definition of a method
-is kept: the redefinition in a subclass of a method that was visible in
-the parent class overrides the definition in the parent class.
-Previous definitions of a method can be reused by binding the related
-ancestor. Below, "super" is bound to the ancestor "printable_point".
-The name "super" is a pseudo value identifier that can only be used to
-invoke a super-class method, as in "super#print".
-\begin{caml_example}{toplevel}
-class printable_colored_point y c =
- object (self)
- val c = c
- method color = c
- inherit printable_point y as super
- method! print =
- print_string "(";
- super#print;
- print_string ", ";
- print_string (self#color);
- print_string ")"
- end;;
-let p' = new printable_colored_point 17 "red";;
-p'#print;;
-\end{caml_example}
-A private method that has been hidden in the parent class is no longer
-visible, and is thus not overridden. Since initializers are treated as
-private methods, all initializers along the class hierarchy are evaluated,
-in the order they are introduced.
-
-Note that for clarity's sake, the method "print" is explicitly marked as
-overriding another definition by annotating the "method" keyword with
-an exclamation mark "!". If the method "print" were not overriding the
-"print" method of "printable_point", the compiler would raise an error:
-\begin{caml_example}{toplevel}[error]
- object
- method! m = ()
- end;;
-\end{caml_example}
-
-This explicit overriding annotation also works
-for "val" and "inherit":
-\begin{caml_example}{toplevel}
-class another_printable_colored_point y c c' =
- object (self)
- inherit printable_point y
- inherit! printable_colored_point y c
- val! c = c'
- end;;
-\end{caml_example}
-
-\section{s:parameterized-classes}{Parameterized classes}
-
-Reference cells can be implemented as objects.
-The naive definition fails to typecheck:
-\begin{caml_example}{toplevel}[error]
-class oref x_init =
- object
- val mutable x = x_init
- method get = x
- method set y = x <- y
- end;;
-\end{caml_example}
-The reason is that at least one of the methods has a polymorphic type
-(here, the type of the value stored in the reference cell), thus
-either the class should be parametric, or the method type should be
-constrained to a monomorphic type. A monomorphic instance of the class could
-be defined by:
-\begin{caml_example}{toplevel}
-class oref (x_init:int) =
- object
- val mutable x = x_init
- method get = x
- method set y = x <- y
- end;;
-\end{caml_example}
-Note that since immediate objects do not define a class type, they have
-no such restriction.
-\begin{caml_example}{toplevel}
-let new_oref x_init =
- object
- val mutable x = x_init
- method get = x
- method set y = x <- y
- end;;
-\end{caml_example}
-On the other hand, a class for polymorphic references must explicitly
-list the type parameters in its declaration. Class type parameters are
-listed between "[" and "]". The type parameters must also be
-bound somewhere in the class body by a type constraint.
-\begin{caml_example}{toplevel}
-class ['a] oref x_init =
- object
- val mutable x = (x_init : 'a)
- method get = x
- method set y = x <- y
- end;;
-let r = new oref 1 in r#set 2; (r#get);;
-\end{caml_example}
-The type parameter in the declaration may actually be constrained in the
-body of the class definition. In the class type, the actual value of
-the type parameter is displayed in the "constraint" clause.
-\begin{caml_example}{toplevel}
-class ['a] oref_succ (x_init:'a) =
- object
- val mutable x = x_init + 1
- method get = x
- method set y = x <- y
- end;;
-\end{caml_example}
-Let us consider a more complex example: define a circle, whose center
-may be any kind of point. We put an additional type
-constraint in method "move", since no free variables must remain
-unaccounted for by the class type parameters.
-\begin{caml_example}{toplevel}
-class ['a] circle (c : 'a) =
- object
- val mutable center = c
- method center = center
- method set_center c = center <- c
- method move = (center#move : int -> unit)
- end;;
-\end{caml_example}
-An alternate definition of "circle", using a "constraint" clause in
-the class definition, is shown below. The type "#point" used below in
-the "constraint" clause is an abbreviation produced by the definition
-of class "point". This abbreviation unifies with the type of any
-object belonging to a subclass of class "point". It actually expands to
-"< get_x : int; move : int -> unit; .. >". This leads to the following
-alternate definition of "circle", which has slightly stronger
-constraints on its argument, as we now expect "center" to have a
-method "get_x".
-\begin{caml_example}{toplevel}
-class ['a] circle (c : 'a) =
- object
- constraint 'a = #point
- val mutable center = c
- method center = center
- method set_center c = center <- c
- method move = center#move
- end;;
-\end{caml_example}
-The class "colored_circle" is a specialized version of class
-"circle" that requires the type of the center to unify with
-"#colored_point", and adds a method "color". Note that when specializing a
-parameterized class, the instance of type parameter must always be
-explicitly given. It is again written between "[" and "]".
-\begin{caml_example}{toplevel}
-class ['a] colored_circle c =
- object
- constraint 'a = #colored_point
- inherit ['a] circle c
- method color = center#color
- end;;
-\end{caml_example}
-
-\section{s:polymorphic-methods}{Polymorphic methods}
-
-While parameterized classes may be polymorphic in their contents, they
-are not enough to allow polymorphism of method use.
-
-A classical example is defining an iterator.
-\begin{caml_example}{toplevel}
-List.fold_left;;
-class ['a] intlist (l : int list) =
- object
- method empty = (l = [])
- method fold f (accu : 'a) = List.fold_left f accu l
- end;;
-\end{caml_example}
-At first look, we seem to have a polymorphic iterator, however this
-does not work in practice.
-\begin{caml_example}{toplevel}
-let l = new intlist [1; 2; 3];;
-l#fold (fun x y -> x+y) 0;;
-l;;
-l#fold (fun s x -> s ^ Int.to_string x ^ " ") "" [@@expect error];;
-\end{caml_example}
-Our iterator works, as shows its first use for summation. However,
-since objects themselves are not polymorphic (only their constructors
-are), using the "fold" method fixes its type for this individual object.
-Our next attempt to use it as a string iterator fails.
-
-The problem here is that quantification was wrongly located: it is
-not the class we want to be polymorphic, but the "fold" method.
-This can be achieved by giving an explicitly polymorphic type in the
-method definition.
-\begin{caml_example}{toplevel}
-class intlist (l : int list) =
- object
- method empty = (l = [])
- method fold : 'a. ('a -> int -> 'a) -> 'a -> 'a =
- fun f accu -> List.fold_left f accu l
- end;;
-let l = new intlist [1; 2; 3];;
-l#fold (fun x y -> x+y) 0;;
-l#fold (fun s x -> s ^ Int.to_string x ^ " ") "";;
-\end{caml_example}
-As you can see in the class type shown by the compiler, while
-polymorphic method types must be fully explicit in class definitions
-(appearing immediately after the method name), quantified type
-variables can be left implicit in class descriptions. Why require types
-to be explicit? The problem is that "(int -> int -> int) -> int ->
-int" would also be a valid type for "fold", and it happens to be
-incompatible with the polymorphic type we gave (automatic
-instantiation only works for toplevel types variables, not for inner
-quantifiers, where it becomes an undecidable problem.) So the compiler
-cannot choose between those two types, and must be helped.
-
-However, the type can be completely omitted in the class definition if
-it is already known, through inheritance or type constraints on self.
-Here is an example of method overriding.
-\begin{caml_example*}{toplevel}
-class intlist_rev l =
- object
- inherit intlist l
- method! fold f accu = List.fold_left f accu (List.rev l)
- end;;
-\end{caml_example*}
-The following idiom separates description and definition.
-\begin{caml_example*}{toplevel}
-class type ['a] iterator =
- object method fold : ('b -> 'a -> 'b) -> 'b -> 'b end;;
-class intlist' l =
- object (self : int #iterator)
- method empty = (l = [])
- method fold f accu = List.fold_left f accu l
- end;;
-\end{caml_example*}
-Note here the "(self : int #iterator)" idiom, which ensures that this
-object implements the interface "iterator".
-
-Polymorphic methods are called in exactly the same way as normal
-methods, but you should be aware of some limitations of type
-inference. Namely, a polymorphic method can only be called if its
-type is known at the call site. Otherwise, the method will be assumed
-to be monomorphic, and given an incompatible type.
-\begin{caml_example}{toplevel}
-let sum lst = lst#fold (fun x y -> x+y) 0;;
-sum l [@@expect error];;
-\end{caml_example}
-The workaround is easy: you should put a type constraint on the
-parameter.
-\begin{caml_example}{toplevel}
-let sum (lst : _ #iterator) = lst#fold (fun x y -> x+y) 0;;
-\end{caml_example}
-Of course the constraint may also be an explicit method type.
-Only occurrences of quantified variables are required.
-\begin{caml_example}{toplevel}
-let sum lst =
- (lst : < fold : 'a. ('a -> _ -> 'a) -> 'a -> 'a; .. >)#fold (+) 0;;
-\end{caml_example}
-
-Another use of polymorphic methods is to allow some form of implicit
-subtyping in method arguments. We have already seen in
-section~\ref{s:inheritance} how some functions may be polymorphic in the
-class of their argument. This can be extended to methods.
-\begin{caml_example}{toplevel}
-class type point0 = object method get_x : int end;;
-class distance_point x =
- object
- inherit point x
- method distance : 'a. (#point0 as 'a) -> int =
- fun other -> abs (other#get_x - x)
- end;;
-let p = new distance_point 3 in
-(p#distance (new point 8), p#distance (new colored_point 1 "blue"));;
-\end{caml_example}
-Note here the special syntax "(#point0 as 'a)" we have to use to
-quantify the extensible part of "#point0". As for the variable binder,
-it can be omitted in class specifications. If you want polymorphism
-inside object field it must be quantified independently.
-\begin{caml_example}{toplevel}
-class multi_poly =
- object
- method m1 : 'a. (< n1 : 'b. 'b -> 'b; .. > as 'a) -> _ =
- fun o -> o#n1 true, o#n1 "hello"
- method m2 : 'a 'b. (< n2 : 'b -> bool; .. > as 'a) -> 'b -> _ =
- fun o x -> o#n2 x
- end;;
-\end{caml_example}
-In method "m1", "o" must be an object with at least a method "n1",
-itself polymorphic. In method "m2", the argument of "n2" and "x" must
-have the same type, which is quantified at the same level as "'a".
-
-\section{s:using-coercions}{Using coercions}
-
-Subtyping is never implicit. There are, however, two ways to perform
-subtyping. The most general construction is fully explicit: both the
-domain and the codomain of the type coercion must be given.
-
-We have seen that points and colored points have incompatible types.
-For instance, they cannot be mixed in the same list. However, a
-colored point can be coerced to a point, hiding its "color" method:
-\begin{caml_example}{toplevel}
-let colored_point_to_point cp = (cp : colored_point :> point);;
-let p = new point 3 and q = new colored_point 4 "blue";;
-let l = [p; (colored_point_to_point q)];;
-\end{caml_example}
-An object of type "t" can be seen as an object of type "t'"
-only if "t" is a subtype of "t'". For instance, a point cannot be
-seen as a colored point.
-\begin{caml_example}{toplevel}[error]
-(p : point :> colored_point);;
-\end{caml_example}
-Indeed, narrowing coercions without runtime checks would be unsafe.
-Runtime type checks might raise exceptions, and they would require
-the presence of type information at runtime, which is not the case in
-the OCaml system.
-For these reasons, there is no such operation available in the language.
-
-Be aware that subtyping and inheritance are not related. Inheritance is a
-syntactic relation between classes while subtyping is a semantic relation
-between types. For instance, the class of colored points could have been
-defined directly, without inheriting from the class of points; the type of
-colored points would remain unchanged and thus still be a subtype of
-points.
-% Conversely, the class "int_comparable" inherits from class
-%"comparable", but type "int_comparable" is not a subtype of "comparable".
-%\begin{caml_example}{toplevel}
-%function x -> (x : int_comparable :> comparable);;
-%\end{caml_example}
-
-The domain of a coercion can often be omitted. For instance, one can
-define:
-\begin{caml_example}{toplevel}
-let to_point cp = (cp :> point);;
-\end{caml_example}
-In this case, the function "colored_point_to_point" is an instance of the
-function "to_point". This is not always true, however. The fully
-explicit coercion is more precise and is sometimes unavoidable.
-Consider, for example, the following class:
-\begin{caml_example}{toplevel}
-class c0 = object method m = {< >} method n = 0 end;;
-\end{caml_example}
-The object type "c0" is an abbreviation for "<m : 'a; n : int> as 'a".
-Consider now the type declaration:
-\begin{caml_example}{toplevel}
-class type c1 = object method m : c1 end;;
-\end{caml_example}
-The object type "c1" is an abbreviation for the type "<m : 'a> as 'a".
-The coercion from an object of type "c0" to an object of type "c1" is
-correct:
-\begin{caml_example}{toplevel}
-fun (x:c0) -> (x : c0 :> c1);;
-\end{caml_example}
-%%% FIXME come up with a better example.
-% However, the domain of the coercion cannot be omitted here:
-% \begin{caml_example}{toplevel}
-% fun (x:c0) -> (x :> c1);;
-% \end{caml_example}
-However, the domain of the coercion cannot always be omitted.
-In that case, the solution is to use the explicit form.
-%
-Sometimes, a change in the class-type definition can also solve the problem
-\begin{caml_example}{toplevel}
-class type c2 = object ('a) method m : 'a end;;
-fun (x:c0) -> (x :> c2);;
-\end{caml_example}
-While class types "c1" and "c2" are different, both object types
-"c1" and "c2" expand to the same object type (same method names and types).
-Yet, when the domain of a coercion is left implicit and its co-domain
-is an abbreviation of a known class type, then the class type, rather
-than the object type, is used to derive the coercion function. This
-allows leaving the domain implicit in most cases when coercing form a
-subclass to its superclass.
-%
-The type of a coercion can always be seen as below:
-\begin{caml_example}{toplevel}
-let to_c1 x = (x :> c1);;
-let to_c2 x = (x :> c2);;
-\end{caml_example}
-Note the difference between these two coercions: in the case of "to_c2",
-the type
-"#c2 = < m : 'a; .. > as 'a" is polymorphically recursive (according
-to the explicit recursion in the class type of "c2"); hence the
-success of applying this coercion to an object of class "c0".
-On the other hand, in the first case, "c1" was only expanded and
-unrolled twice to obtain "< m : < m : c1; .. >; .. >" (remember "#c1 =
-< m : c1; .. >"), without introducing recursion.
-You may also note that the type of "to_c2" is "#c2 -> c2" while
-the type of "to_c1" is more general than "#c1 -> c1". This is not always true,
-since there are class types for which some instances of "#c" are not subtypes
-of "c", as explained in section~\ref{s:binary-methods}. Yet, for
-parameterless classes the coercion "(_ :> c)" is always more general than
-"(_ : #c :> c)".
-%If a class type exposes the type of self through one of its parameters, this
-%is no longer true. Here is a counter-example.
-%\begin{caml_example}{toplevel}
-%class type ['a] c = object ('a) method m : 'a end;;
-%let to_c x = (x :> _ c);;
-%\end{caml_example}
-
-
-A common problem may occur when one tries to define a coercion to a
-class "c" while defining class "c". The problem is due to the type
-abbreviation not being completely defined yet, and so its subtypes are not
-clearly known. Then, a coercion "(_ :> c)" or "(_ : #c :> c)" is taken to be
-the identity function, as in
-\begin{caml_example}{toplevel}
-function x -> (x :> 'a);;
-\end{caml_example}
-As a consequence, if the coercion is applied to "self", as in the
-following example, the type of "self" is unified with the closed type
-"c" (a closed object type is an object type without ellipsis). This
-would constrain the type of self be closed and is thus rejected.
-Indeed, the type of self cannot be closed: this would prevent any
-further extension of the class. Therefore, a type error is generated
-when the unification of this type with another type would result in a
-closed object type.
-\begin{caml_example}{toplevel}[error]
-class c = object method m = 1 end
-and d = object (self)
- inherit c
- method n = 2
- method as_c = (self :> c)
-end;;
-\end{caml_example}
-However, the most common instance of this problem, coercing self to
-its current class, is detected as a special case by the type checker,
-and properly typed.
-\begin{caml_example}{toplevel}
-class c = object (self) method m = (self :> c) end;;
-\end{caml_example}
-This allows the following idiom, keeping a list of all objects
-belonging to a class or its subclasses:
-\begin{caml_example}{toplevel}
-let all_c = ref [];;
-class c (m : int) =
- object (self)
- method m = m
- initializer all_c := (self :> c) :: !all_c
- end;;
-\end{caml_example}
-This idiom can in turn be used to retrieve an object whose type has
-been weakened:
-\begin{caml_example}{toplevel}
-let rec lookup_obj obj = function [] -> raise Not_found
- | obj' :: l ->
- if (obj :> < >) = (obj' :> < >) then obj' else lookup_obj obj l ;;
-let lookup_c obj = lookup_obj obj !all_c;;
-\end{caml_example}
-The type "< m : int >" we see here is just the expansion of "c", due
-to the use of a reference; we have succeeded in getting back an object
-of type "c".
-
-\medskip
-The previous coercion problem can often be avoided by first
-defining the abbreviation, using a class type:
-\begin{caml_example}{toplevel}
-class type c' = object method m : int end;;
-class c : c' = object method m = 1 end
-and d = object (self)
- inherit c
- method n = 2
- method as_c = (self :> c')
-end;;
-\end{caml_example}
-It is also possible to use a virtual class. Inheriting from this class
-simultaneously forces all methods of "c" to have the same
-type as the methods of "c'".
-\begin{caml_example}{toplevel}
-class virtual c' = object method virtual m : int end;;
-class c = object (self) inherit c' method m = 1 end;;
-\end{caml_example}
-One could think of defining the type abbreviation directly:
-\begin{caml_example*}{toplevel}
-type c' = <m : int>;;
-\end{caml_example*}
-However, the abbreviation "#c'" cannot be defined directly in a similar way.
-It can only be defined by a class or a class-type definition.
-This is because a "#"-abbreviation carries an implicit anonymous
-variable ".." that cannot be explicitly named.
-The closer you get to it is:
-\begin{caml_example*}{toplevel}
-type 'a c'_class = 'a constraint 'a = < m : int; .. >;;
-\end{caml_example*}
-with an extra type variable capturing the open object type.
-
-\section{s:functional-objects}{Functional objects}
-
-It is possible to write a version of class "point" without assignments
-on the instance variables. The override construct "{< ... >}" returns a copy of
-``self'' (that is, the current object), possibly changing the value of
-some instance variables.
-\begin{caml_example}{toplevel}
-class functional_point y =
- object
- val x = y
- method get_x = x
- method move d = {< x = x + d >}
- method move_to x = {< x >}
- end;;
-let p = new functional_point 7;;
-p#get_x;;
-(p#move 3)#get_x;;
-(p#move_to 15)#get_x;;
-p#get_x;;
-\end{caml_example}
-As with records, the form "{< x >}" is an elided version of
-"{< x = x >}" which avoids the repetition of the instance variable name.
-Note that the type abbreviation "functional_point" is recursive, which can
-be seen in the class type of "functional_point": the type of self is "'a"
-and "'a" appears inside the type of the method "move".
-
-The above definition of "functional_point" is not equivalent
-to the following:
-\begin{caml_example}{toplevel}
-class bad_functional_point y =
- object
- val x = y
- method get_x = x
- method move d = new bad_functional_point (x+d)
- method move_to x = new bad_functional_point x
- end;;
-\end{caml_example}
-While objects of either class will behave the same, objects of their
-subclasses will be different. In a subclass of "bad_functional_point",
-the method "move" will
-keep returning an object of the parent class. On the contrary, in a
-subclass of "functional_point", the method "move" will return an
-object of the subclass.
-
-Functional update is often used in conjunction with binary methods
-as illustrated in section~\ref{ss:string-as-class}.
-
-\section{s:cloning-objects}{Cloning objects}
-
-Objects can also be cloned, whether they are functional or imperative.
-The library function "Oo.copy" makes a shallow copy of an object. That is,
-it returns a new object that has the same methods and instance
-variables as its argument. The
-instance variables are copied but their contents are shared.
-Assigning a new value to an instance variable of the copy (using a method
-call) will not affect instance variables of the original, and conversely.
-A deeper assignment (for example if the instance variable is a reference cell)
-will of course affect both the original and the copy.
-
-The type of "Oo.copy" is the following:
-\begin{caml_example}{toplevel}
-Oo.copy;;
-\end{caml_example}
-The keyword "as" in that type binds the type variable "'a" to
-the object type "< .. >". Therefore, "Oo.copy" takes an object with
-any methods (represented by the ellipsis), and returns an object of
-the same type. The type of "Oo.copy" is different from type "< .. > ->
-< .. >" as each ellipsis represents a different set of methods.
-Ellipsis actually behaves as a type variable.
-\begin{caml_example}{toplevel}
-let p = new point 5;;
-let q = Oo.copy p;;
-q#move 7; (p#get_x, q#get_x);;
-\end{caml_example}
-In fact, "Oo.copy p" will behave as "p#copy" assuming that a public
-method "copy" with body "{< >}" has been defined in the class of "p".
-
-Objects can be compared using the generic comparison functions "=" and "<>".
-Two objects are equal if and only if they are physically equal. In
-particular, an object and its copy are not equal.
-\begin{caml_example}{toplevel}
-let q = Oo.copy p;;
-p = q, p = p;;
-\end{caml_example}
-Other generic comparisons such as ("<", "<=", ...) can also be used on
-objects. The
-relation "<" defines an unspecified but strict ordering on objects. The
-ordering relationship between two objects is fixed once for all after the
-two objects have been created and it is not affected by mutation of fields.
-
-Cloning and override have a non empty intersection.
-They are interchangeable when used within an object and without
-overriding any field:
-\begin{caml_example}{toplevel}
-class copy =
- object
- method copy = {< >}
- end;;
-class copy =
- object (self)
- method copy = Oo.copy self
- end;;
-\end{caml_example}
-Only the override can be used to actually override fields, and
-only the "Oo.copy" primitive can be used externally.
-
-Cloning can also be used to provide facilities for saving and
-restoring the state of objects.
-\begin{caml_example}{toplevel}
-class backup =
- object (self : 'mytype)
- val mutable copy = None
- method save = copy <- Some {< copy = None >}
- method restore = match copy with Some x -> x | None -> self
- end;;
-\end{caml_example}
-The above definition will only backup one level.
-The backup facility can be added to any class by using multiple inheritance.
-\begin{caml_example}{toplevel}
-class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
-let rec get p n = if n = 0 then p # get else get (p # restore) (n-1);;
-let p = new backup_ref 0 in
-p # save; p # set 1; p # save; p # set 2;
-[get p 0; get p 1; get p 2; get p 3; get p 4];;
-\end{caml_example}
-We can define a variant of backup that retains all copies. (We also
-add a method "clear" to manually erase all copies.)
-\begin{caml_example}{toplevel}
-class backup =
- object (self : 'mytype)
- val mutable copy = None
- method save = copy <- Some {< >}
- method restore = match copy with Some x -> x | None -> self
- method clear = copy <- None
- end;;
-\end{caml_example}
-\begin{caml_example}{toplevel}
-class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
-let p = new backup_ref 0 in
-p # save; p # set 1; p # save; p # set 2;
-[get p 0; get p 1; get p 2; get p 3; get p 4];;
-\end{caml_example}
-
-
-
-\section{s:recursive-classes}{Recursive classes}
-
-Recursive classes can be used to define objects whose types are
-mutually recursive.
-\begin{caml_example}{toplevel}
-class window =
- object
- val mutable top_widget = (None : widget option)
- method top_widget = top_widget
- end
-and widget (w : window) =
- object
- val window = w
- method window = window
- end;;
-\end{caml_example}
-Although their types are mutually recursive, the classes "widget" and
-"window" are themselves independent.
-
-
-\section{s:binary-methods}{Binary methods}
-
-A binary method is a method which takes an argument of the same type
-as self. The class "comparable" below is a template for classes with a
-binary method "leq" of type "'a -> bool" where the type variable "'a"
-is bound to the type of self. Therefore, "#comparable" expands to "<
-leq : 'a -> bool; .. > as 'a". We see here that the binder "as" also
-allows writing recursive types.
-\begin{caml_example}{toplevel}
-class virtual comparable =
- object (_ : 'a)
- method virtual leq : 'a -> bool
- end;;
-\end{caml_example}
-We then define a subclass "money" of "comparable". The class "money"
-simply wraps floats as comparable objects. We will extend it below with
-more operations. We have to use a type constraint on the class parameter "x"
-because the primitive "<=" is a polymorphic function in
-OCaml. The "inherit" clause ensures that the type of objects
-of this class is an instance of "#comparable".
-\begin{caml_example}{toplevel}
-class money (x : float) =
- object
- inherit comparable
- val repr = x
- method value = repr
- method leq p = repr <= p#value
- end;;
-\end{caml_example}
-% not explained: mutability can be hidden
-Note that the type "money" is not a subtype of type
-"comparable", as the self type appears in contravariant position
-in the type of method "leq".
-Indeed, an object "m" of class "money" has a method "leq"
-that expects an argument of type "money" since it accesses
-its "value" method. Considering "m" of type "comparable" would allow a
-call to method "leq" on "m" with an argument that does not have a method
-"value", which would be an error.
-
-Similarly, the type "money2" below is not a subtype of type "money".
-\begin{caml_example}{toplevel}
-class money2 x =
- object
- inherit money x
- method times k = {< repr = k *. repr >}
- end;;
-\end{caml_example}
-It is however possible to define functions that manipulate objects of
-type either "money" or "money2": the function "min"
-will return the minimum of any two objects whose type unifies with
-"#comparable". The type of "min" is not the same as "#comparable ->
-#comparable -> #comparable", as the abbreviation "#comparable" hides a
-type variable (an ellipsis). Each occurrence of this abbreviation
-generates a new variable.
-\begin{caml_example}{toplevel}
-let min (x : #comparable) y =
- if x#leq y then x else y;;
-\end{caml_example}
-This function can be applied to objects of type "money"
-or "money2".
-\begin{caml_example}{toplevel}
-(min (new money 1.3) (new money 3.1))#value;;
-(min (new money2 5.0) (new money2 3.14))#value;;
-\end{caml_example}
-
-More examples of binary methods can be found in
-sections~\ref{ss:string-as-class} and~\ref{ss:set-as-class}.
-
-Note the use of override for method "times".
-Writing "new money2 (k *. repr)" instead of "{< repr = k *. repr >}"
-would not behave well with inheritance: in a subclass "money3" of "money2"
-the "times" method would return an object of class "money2" but not of class
-"money3" as would be expected.
-
-The class "money" could naturally carry another binary method. Here is a
-direct definition:
-\begin{caml_example}{toplevel}
-class money x =
- object (self : 'a)
- val repr = x
- method value = repr
- method print = print_float repr
- method times k = {< repr = k *. x >}
- method leq (p : 'a) = repr <= p#value
- method plus (p : 'a) = {< repr = x +. p#value >}
- end;;
-\end{caml_example}
-
-\section{s:friends}{Friends}
-
-The above class "money" reveals a problem that often occurs with binary
-methods. In order to interact with other objects of the same class, the
-representation of "money" objects must be revealed, using a method such as
-"value". If we remove all binary methods (here "plus" and "leq"),
-the representation can easily be hidden inside objects by removing the method
-"value" as well. However, this is not possible as soon as some binary
-method requires access to the representation of objects of the same
-class (other than self).
-\begin{caml_example}{toplevel}
-class safe_money x =
- object (self : 'a)
- val repr = x
- method print = print_float repr
- method times k = {< repr = k *. x >}
- end;;
-\end{caml_example}
-Here, the representation of the object is known only to a particular object.
-To make it available to other objects of the same class, we are forced to
-make it available to the whole world. However we can easily restrict the
-visibility of the representation using the module system.
-\begin{caml_example*}{toplevel}
-module type MONEY =
- sig
- type t
- class c : float ->
- object ('a)
- val repr : t
- method value : t
- method print : unit
- method times : float -> 'a
- method leq : 'a -> bool
- method plus : 'a -> 'a
- end
- end;;
-module Euro : MONEY =
- struct
- type t = float
- class c x =
- object (self : 'a)
- val repr = x
- method value = repr
- method print = print_float repr
- method times k = {< repr = k *. x >}
- method leq (p : 'a) = repr <= p#value
- method plus (p : 'a) = {< repr = x +. p#value >}
- end
- end;;
-\end{caml_example*}
-Another example of friend functions may be found in section~\ref{ss:set-as-class}.
-These examples occur when a group of objects (here
-objects of the same class) and functions should see each others internal
-representation, while their representation should be hidden from the
-outside. The solution is always to define all friends in the same module,
-give access to the representation and use a signature constraint to make the
-representation abstract outside the module.
-
-
-
-% LocalWords: typecheck monomorphic uncaptured Subtyping subtyping leq repr Oo
-% LocalWords: val sig bool Euro struct OCaml Vouillon Didier int ref incr init
-% LocalWords: succ mytype rec
-
+++ /dev/null
-
-\chapter{Polymorphism and its limitations}%
-\label{c:polymorphism}
-%HEVEA\cutname{polymorphism.html}
-
-\bigskip
-
-\noindent This chapter covers more advanced questions related to the
-limitations of polymorphic functions and types. There are some situations
-in OCaml where the type inferred by the type checker may be less generic
-than expected. Such non-genericity can stem either from interactions
-between side-effect and typing or the difficulties of implicit polymorphic
-recursion and higher-rank polymorphism.
-
-This chapter details each of these situations and, if it is possible,
-how to recover genericity.
-
-\section{s:weak-polymorphism}{Weak polymorphism and mutation}
-\subsection{ss:weak-types}{Weakly polymorphic types}
-Maybe the most frequent examples of non-genericity derive from the
-interactions between polymorphic types and mutation. A simple example
-appears when typing the following expression
-\begin{caml_example}{toplevel}
-let store = ref None ;;
-\end{caml_example}
-Since the type of "None" is "'a option" and the function "ref" has type
-"'b -> 'b ref", a natural deduction for the type of "store" would be
-"'a option ref". However, the inferred type, "'_weak1 option ref", is
-different. Type variables whose name starts with a "_weak" prefix like
-"'_weak1" are weakly polymorphic type variables, sometimes shortened as
-weak type variables.
-A weak type variable is a placeholder for a single type that is currently
-unknown. Once the specific type "t" behind the placeholder type "'_weak1"
-is known, all occurrences of "'_weak1" will be replaced by "t". For instance,
-we can define another option reference and store an "int" inside:
-\begin{caml_example}{toplevel}
-let another_store = ref None ;;
-another_store := Some 0;
-another_store ;;
-\end{caml_example}
-After storing an "int" inside "another_store", the type of "another_store" has
-been updated from "'_weak2 option ref" to "int option ref".
-This distinction between weakly and generic polymorphic type variable protects
-OCaml programs from unsoundness and runtime errors. To understand from where
-unsoundness might come, consider this simple function which swaps a value "x"
-with the value stored inside a "store" reference, if there is such value:
-\begin{caml_example}{toplevel}
-let swap store x = match !store with
- | None -> store := Some x; x
- | Some y -> store := Some x; y;;
-\end{caml_example}
-We can apply this function to our store
-\begin{caml_example}{toplevel}
-let one = swap store 1
-let one_again = swap store 2
-let two = swap store 3;;
-\end{caml_example}
-After these three swaps the stored value is "3". Everything is fine up to
-now. We can then try to swap "3" with a more interesting value, for
-instance a function:
-\begin{caml_example}{toplevel}[error]
-let error = swap store (fun x -> x);;
-\end{caml_example}
-At this point, the type checker rightfully complains that it is not
-possible to swap an integer and a function, and that an "int" should always
-be traded for another "int". Furthermore, the type checker prevents us to
-change manually the type of the value stored by "store":
-\begin{caml_example}{toplevel}[error]
-store := Some (fun x -> x);;
-\end{caml_example}
-Indeed, looking at the type of store, we see that the weak type "'_weak1" has
-been replaced by the type "int"
-\begin{caml_example}{toplevel}
-store;;
-\end{caml_example}
-Therefore, after placing an "int" in "store", we cannot use it to store any
-value other than an "int". More generally, weak types protect the program from
-undue mutation of values with a polymorphic type.
-
-%todo: fix indentation in manual.pdf
-Moreover, weak types cannot appear in the signature of toplevel modules:
-types must be known at compilation time. Otherwise, different compilation
-units could replace the weak type with different and incompatible types.
-For this reason, compiling the following small piece of code
-\begin{verbatim}
-let option_ref = ref None
-\end{verbatim}
-yields a compilation error
-\begin{verbatim}
-Error: The type of this expression, '_weak1 option ref,
- contains type variables that cannot be generalized
-\end{verbatim}
-To solve this error, it is enough to add an explicit type annotation to
-specify the type at declaration time:
-\begin{verbatim}
-let option_ref: int option ref = ref None
-\end{verbatim}
-This is in any case a good practice for such global mutable variables.
-Otherwise, they will pick out the type of first use. If there is a mistake
-at this point, this can result in confusing type errors when later, correct
-uses are flagged as errors.
-
-\subsection{ss:valuerestriction}{The value restriction}
-
-Identifying the exact context in which polymorphic types should be
-replaced by weak types in a modular way is a difficult question. Indeed
-the type system must handle the possibility that functions may hide persistent
-mutable states. For instance, the following function uses an internal reference
-to implement a delayed identity function
-\begin{caml_example}{toplevel}
-let make_fake_id () =
- let store = ref None in
- fun x -> swap store x ;;
-let fake_id = make_fake_id();;
-\end{caml_example}
-It would be unsound to apply this "fake_id" function to values with different
-types. The function "fake_id" is therefore rightfully assigned the type
-"'_weak3 -> '_weak3" rather than "'a -> 'a". At the same time, it ought to
-be possible to use a local mutable state without impacting the type of a
-function.
-%todo: add an example?
-
-To circumvent these dual difficulties, the type checker considers that any value
-returned by a function might rely on persistent mutable states behind the scene
-and should be given a weak type. This restriction on the type of mutable
-values and the results of function application is called the value restriction.
-Note that this value restriction is conservative: there are situations where the
-value restriction is too cautious and gives a weak type to a value that could be
-safely generalized to a polymorphic type:
-\begin{caml_example}{toplevel}
-let not_id = (fun x -> x) (fun x -> x);;
-\end{caml_example}
-Quite often, this happens when defining function using higher order function.
-To avoid this problem, a solution is to add an explicit argument to the
-function:
-\begin{caml_example}{toplevel}
-let id_again = fun x -> (fun x -> x) (fun x -> x) x;;
-\end{caml_example}
-With this argument, "id_again" is seen as a function definition by the type
-checker and can therefore be generalized. This kind of manipulation is called
-eta-expansion in lambda calculus and is sometimes referred under this name.
-
-\subsection{ss:relaxed-value-restriction}{The relaxed value restriction}
-
-There is another partial solution to the problem of unnecessary weak type,
-which is implemented directly within the type checker. Briefly, it is possible
-to prove that weak types that only appear as type parameters in covariant
-positions --also called positive positions-- can be safely generalized to
-polymorphic types. For instance, the type "'a list" is covariant in "'a":
-\begin{caml_example}{toplevel}
- let f () = [];;
- let empty = f ();;
-\end{caml_example}
-Remark that the type inferred for "empty" is "'a list" and not "'_weak5 list"
-that should have occurred with the value restriction since "f ()" is a
-function application.
-
-The value restriction combined with this generalization for covariant type
-parameters is called the relaxed value restriction.
-
-%question: is here the best place for describing variance?
-\subsection{ss:variance-and-value-restriction}{Variance and value restriction}
-Variance describes how type constructors behave with respect to subtyping.
-Consider for instance a pair of type "x" and "xy" with "x" a subtype of "xy",
-denoted "x :> xy":
-\begin{caml_example}{toplevel}
- type x = [ `X ];;
- type xy = [ `X | `Y ];;
-\end{caml_example}
-As "x" is a subtype of "xy", we can convert a value of type "x"
-to a value of type "xy":
-\begin{caml_example}{toplevel}
- let x:x = `X;;
- let x' = ( x :> xy);;
-\end{caml_example}
-Similarly, if we have a value of type "x list", we can convert it to a value
-of type "xy list", since we could convert each element one by one:
-\begin{caml_example}{toplevel}
- let l:x list = [`X; `X];;
- let l' = ( l :> xy list);;
-\end{caml_example}
-In other words, "x :> xy" implies that "x list :> xy list", therefore
-the type constructor "'a list" is covariant (it preserves subtyping)
-in its parameter "'a".
-
-Contrarily, if we have a function that can handle values of type "xy"
-\begin{caml_example}{toplevel}
- let f: xy -> unit = function
- | `X -> ()
- | `Y -> ();;
-\end{caml_example}
-it can also handle values of type "x":
-\begin{caml_example}{toplevel}
- let f' = (f :> x -> unit);;
-\end{caml_example}
-Note that we can rewrite the type of "f" and "f'" as
-\begin{caml_example}{toplevel}
- type 'a proc = 'a -> unit
- let f' = (f: xy proc :> x proc);;
-\end{caml_example}
-In this case, we have "x :> xy" implies "xy proc :> x proc". Notice
-that the second subtyping relation reverse the order of "x" and "xy":
-the type constructor "'a proc" is contravariant in its parameter "'a".
-More generally, the function type constructor "'a -> 'b" is covariant in
-its return type "'b" and contravariant in its argument type "'a".
-
-A type constructor can also be invariant in some of its type parameters,
-neither covariant nor contravariant. A typical example is a reference:
-\begin{caml_example}{toplevel}
- let x: x ref = ref `X;;
-\end{caml_example}
-If we were able to coerce "x" to the type "xy ref" as a variable "xy",
-we could use "xy" to store the value "`Y" inside the reference and then use
-the "x" value to read this content as a value of type "x",
-which would break the type system.
-
-More generally, as soon as a type variable appears in a position describing
-mutable state it becomes invariant. As a corollary, covariant variables will
-never denote mutable locations and can be safely generalized.
-For a better description, interested readers can consult the original
-article by Jacques Garrigue on
-\url{http://www.math.nagoya-u.ac.jp/~garrigue/papers/morepoly-long.pdf}
-
-Together, the relaxed value restriction and type parameter covariance
-help to avoid eta-expansion in many situations.
-
-\subsection{ss:variance:abstract-data-types}{Abstract data types}
-Moreover, when the type definitions are exposed, the type checker
-is able to infer variance information on its own and one can benefit from
-the relaxed value restriction even unknowingly. However, this is not the case
-anymore when defining new abstract types. As an illustration, we can define a
-module type collection as:
-\begin{caml_example}{toplevel}
-module type COLLECTION = sig
- type 'a t
- val empty: unit -> 'a t
-end
-
-module Implementation = struct
- type 'a t = 'a list
- let empty ()= []
-end;;
-
-module List2: COLLECTION = Implementation;;
-\end{caml_example}
-
-In this situation, when coercing the module "List2" to the module type
-"COLLECTION", the type checker forgets that "'a List2.t" was covariant
-in "'a". Consequently, the relaxed value restriction does not apply anymore:
-
-\begin{caml_example}{toplevel}
- List2.empty ();;
-\end{caml_example}
-
-To keep the relaxed value restriction, we need to declare the abstract type
-"'a COLLECTION.t" as covariant in "'a":
-\begin{caml_example}{toplevel}
-module type COLLECTION = sig
- type +'a t
- val empty: unit -> 'a t
-end
-
-module List2: COLLECTION = Implementation;;
-\end{caml_example}
-
-We then recover polymorphism:
-
-\begin{caml_example}{toplevel}
- List2.empty ();;
-\end{caml_example}
-
-\section{s:polymorphic-recursion}{Polymorphic recursion}
-
-The second major class of non-genericity is directly related to the problem
-of type inference for polymorphic functions. In some circumstances, the type
-inferred by OCaml might be not general enough to allow the definition of
-some recursive functions, in particular for recursive function acting on
-non-regular algebraic data type.
-
-With a regular polymorphic algebraic data type, the type parameters of
-the type constructor are constant within the definition of the type. For
-instance, we can look at arbitrarily nested list defined as:
-\begin{caml_example}{toplevel}
- type 'a regular_nested = List of 'a list | Nested of 'a regular_nested list
- let l = Nested[ List [1]; Nested [List[2;3]]; Nested[Nested[]] ];;
-\end{caml_example}
-Note that the type constructor "regular_nested" always appears as
-"'a regular_nested" in the definition above, with the same parameter
-"'a". Equipped with this type, one can compute a maximal depth with
-a classic recursive function
-\begin{caml_example}{toplevel}
- let rec maximal_depth = function
- | List _ -> 1
- | Nested [] -> 0
- | Nested (a::q) -> 1 + max (maximal_depth a) (maximal_depth (Nested q));;
-\end{caml_example}
-
-Non-regular recursive algebraic data types correspond to polymorphic algebraic
-data types whose parameter types vary between the left and right side of
-the type definition. For instance, it might be interesting to define a datatype
-that ensures that all lists are nested at the same depth:
-\begin{caml_example}{toplevel}
- type 'a nested = List of 'a list | Nested of 'a list nested;;
-\end{caml_example}
-Intuitively, a value of type "'a nested" is a list of list \dots of list of
-elements "a" with "k" nested list. We can then adapt the "maximal_depth"
-function defined on "regular_depth" into a "depth" function that computes this
-"k". As a first try, we may define
-\begin{caml_example}{toplevel}[error]
-let rec depth = function
- | List _ -> 1
- | Nested n -> 1 + depth n;;
-\end{caml_example}
-The type error here comes from the fact that during the definition of "depth",
-the type checker first assigns to "depth" the type "'a -> 'b ".
-When typing the pattern matching, "'a -> 'b" becomes "'a nested -> 'b", then
-"'a nested -> int" once the "List" branch is typed.
-However, when typing the application "depth n" in the "Nested" branch,
-the type checker encounters a problem: "depth n" is applied to
-"'a list nested", it must therefore have the type
-"'a list nested -> 'b". Unifying this constraint with the previous one
-leads to the impossible constraint "'a list nested = 'a nested".
-In other words, within its definition, the recursive function "depth" is
-applied to values of type "'a t" with different types "'a" due to the
-non-regularity of the type constructor "nested". This creates a problem because
-the type checker had introduced a new type variable "'a" only at the
-\emph{definition} of the function "depth" whereas, here, we need a
-different type variable for every \emph{application} of the function "depth".
-
-\subsection{ss:explicit-polymorphism}{Explicitly polymorphic annotations}
-The solution of this conundrum is to use an explicitly polymorphic type
-annotation for the type "'a":
-\begin{caml_example}{toplevel}
-let rec depth: 'a. 'a nested -> int = function
- | List _ -> 1
- | Nested n -> 1 + depth n;;
-depth ( Nested(List [ [7]; [8] ]) );;
-\end{caml_example}
-In the type of "depth", "'a.'a nested -> int", the type variable "'a"
-is universally quantified. In other words, "'a.'a nested -> int" reads as
-``for all type "'a", "depth" maps "'a nested" values to integers''.
-Whereas the standard type "'a nested -> int" can be interpreted
-as ``let be a type variable "'a", then "depth" maps "'a nested" values
-to integers''. There are two major differences with these two type
-expressions. First, the explicit polymorphic annotation indicates to the
-type checker that it needs to introduce a new type variable every times
-the function "depth" is applied. This solves our problem with the definition
-of the function "depth".
-
-Second, it also notifies the type checker that the type of the function should
-be polymorphic. Indeed, without explicit polymorphic type annotation, the
-following type annotation is perfectly valid
-\begin{caml_example}{toplevel}
- let sum: 'a -> 'b -> 'c = fun x y -> x + y;;
-\end{caml_example}
-since "'a","'b" and "'c" denote type variables that may or may not be
-polymorphic. Whereas, it is an error to unify an explicitly polymorphic type
-with a non-polymorphic type:
-\begin{caml_example}{toplevel}[error]
- let sum: 'a 'b 'c. 'a -> 'b -> 'c = fun x y -> x + y;;
-\end{caml_example}
-
-An important remark here is that it is not needed to explicit fully
-the type of "depth": it is sufficient to add annotations only for the
-universally quantified type variables:
-\begin{caml_example}{toplevel}
-let rec depth: 'a. 'a nested -> _ = function
- | List _ -> 1
- | Nested n -> 1 + depth n;;
-depth ( Nested(List [ [7]; [8] ]) );;
-\end{caml_example}
-
-%todo: add a paragraph on the interaction with locally abstract type
-
-\subsection{ss:recursive-poly-examples}{More examples}
-With explicit polymorphic annotations, it becomes possible to implement
-any recursive function that depends only on the structure of the nested
-lists and not on the type of the elements. For instance, a more complex
-example would be to compute the total number of elements of the nested
-lists:
-\begin{caml_example}{toplevel}
- let len nested =
- let map_and_sum f = List.fold_left (fun acc x -> acc + f x) 0 in
- let rec len: 'a. ('a list -> int ) -> 'a nested -> int =
- fun nested_len n ->
- match n with
- | List l -> nested_len l
- | Nested n -> len (map_and_sum nested_len) n
- in
- len List.length nested;;
-len (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
-\end{caml_example}
-
-Similarly, it may be necessary to use more than one explicitly
-polymorphic type variables, like for computing the nested list of
-list lengths of the nested list:
-\begin{caml_example}{toplevel}
-let shape n =
- let rec shape: 'a 'b. ('a nested -> int nested) ->
- ('b list list -> 'a list) -> 'b nested -> int nested
- = fun nest nested_shape ->
- function
- | List l -> raise
- (Invalid_argument "shape requires nested_list of depth greater than 1")
- | Nested (List l) -> nest @@ List (nested_shape l)
- | Nested n ->
- let nested_shape = List.map nested_shape in
- let nest x = nest (Nested x) in
- shape nest nested_shape n in
- shape (fun n -> n ) (fun l -> List.map List.length l ) n;;
-
-shape (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
-\end{caml_example}
-
-\section{s:higher-rank-poly}{Higher-rank polymorphic functions}
-
-Explicit polymorphic annotations are however not sufficient to cover all
-the cases where the inferred type of a function is less general than
-expected. A similar problem arises when using polymorphic functions as arguments
-of higher-order functions. For instance, we may want to compute the average
-depth or length of two nested lists:
-\begin{caml_example}{toplevel}
- let average_depth x y = (depth x + depth y) / 2;;
- let average_len x y = (len x + len y) / 2;;
- let one = average_len (List [2]) (List [[]]);;
-\end{caml_example}
-It would be natural to factorize these two definitions as:
-\begin{caml_example}{toplevel}
- let average f x y = (f x + f y) / 2;;
-\end{caml_example}
-However, the type of "average len" is less generic than the type of
-"average_len", since it requires the type of the first and second argument to
-be the same:
-\begin{caml_example}{toplevel}
- average_len (List [2]) (List [[]]);;
- average len (List [2]) (List [[]])[@@expect error];;
-\end{caml_example}
-
-As previously with polymorphic recursion, the problem stems from the fact that
-type variables are introduced only at the start of the "let" definitions. When
-we compute both "f x" and "f y", the type of "x" and "y" are unified together.
-To avoid this unification, we need to indicate to the type checker
-that f is polymorphic in its first argument. In some sense, we would want
-"average" to have type
-\begin{verbatim}
-val average: ('a. 'a nested -> int) -> 'a nested -> 'b nested -> int
-\end{verbatim}
-Note that this syntax is not valid within OCaml: "average" has an universally
-quantified type "'a" inside the type of one of its argument whereas for
-polymorphic recursion the universally quantified type was introduced before
-the rest of the type. This position of the universally quantified type means
-that "average" is a second-rank polymorphic function. This kind of higher-rank
-functions is not directly supported by OCaml: type inference for second-rank
-polymorphic function and beyond is undecidable; therefore using this kind of
-higher-rank functions requires to handle manually these universally quantified
-types.
-
-In OCaml, there are two ways to introduce this kind of explicit universally
-quantified types: universally quantified record fields,
-\begin{caml_example}{toplevel}
- type 'a nested_reduction = { f:'elt. 'elt nested -> 'a };;
- let boxed_len = { f = len };;
-\end{caml_example}
-and universally quantified object methods:
-\begin{caml_example}{toplevel}
- let obj_len = object method f:'a. 'a nested -> 'b = len end;;
-\end{caml_example}
-To solve our problem, we can therefore use either the record solution:
-\begin{caml_example}{toplevel}
- let average nsm x y = (nsm.f x + nsm.f y) / 2 ;;
-\end{caml_example}
-or the object one:
-\begin{caml_example}{toplevel}
- let average (obj:<f:'a. 'a nested -> _ > ) x y = (obj#f x + obj#f y) / 2 ;;
-\end{caml_example}
--- /dev/null
+allfiles.tex
+biblio.tex
+foreword.tex
+version.tex
+warnings.etex
+warnings.tex
+foreword.htex
+manual.html
+webman
+ifocamldoc.tex
--- /dev/null
+SRC = $(abspath ../..)
+-include $(SRC)/Makefile.config
+
+export LD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
+export DYLD_LIBRARY_PATH ?= "$(SRC)/otherlibs/unix/:$(SRC)/otherlibs/str/"
+SET_LD_PATH = CAML_LD_LIBRARY_PATH=$(LD_LIBRARY_PATH)
+
+TEXQUOTE = $(SRC)/runtime/ocamlrun ../tools/texquote2
+
+FILES = allfiles.tex biblio.tex foreword.tex version.tex cmds/warnings-help.etex ifocamldoc.tex
+
+TEXINPUTS = ".:..:../refman:../refman/extensions:../library:../cmds:../tutorials:../../styles:"
+RELEASE = $$HOME/release/$${RELEASENAME}
+HEVEA = hevea
+HACHA = hacha
+# We suppress warnings in info and text mode (with -s) because hevea listings emit
+# DIV blocks that the text modes do not know how to interpret.
+INFO_FLAGS = -fix -exec xxdate.exe -info -w 79 -s
+HTML_FLAGS = -fix -exec xxdate.exe -O
+TEXT_FLAGS = -fix -exec xxdate.exe -text -w 79 -s
+
+# Copy the documentation files from SRC/api_docgen
+APIDOC=$(SRC)/api_docgen
+.PHONY: html_files
+.PHONY: latex_files
+ifeq ($(DOCUMENTATION_TOOL),odoc)
+latex_files:
+ make -C $(APIDOC) latex
+ cp $(APIDOC)/build/latex/*/*.tex library
+html_files:
+ make -C $(APIDOC) html
+ cp -r $(APIDOC)/build/html/* htmlman
+else
+latex_files:
+ $(MAKE) -C $(APIDOC) latex
+ cp $(APIDOC)/build/latex/*.tex library
+html_files:
+ $(MAKE) -C $(APIDOC) html
+ mkdir -p htmlman/libref
+ cp -r $(APIDOC)/build/html/libref htmlman
+ cp -r $(APIDOC)/build/html/compilerlibref htmlman
+ cp style.css htmlman/libref
+ cp style.css htmlman/compilerlibref
+endif
+
+manual: files latex_files
+ cd texstuff \
+ && TEXINPUTS=$(TEXINPUTS) pdflatex manual.tex
+
+index:
+ cd texstuff \
+ && sh ../../tools/fix_index.sh manual.idx \
+ && makeindex manual.idx \
+ && makeindex manual.kwd.idx
+
+# libref/style.css and comilerlibref/style.css are used as witness
+# for the generation of the html stdlib and compilerlibs reference.
+html: etex-files html_files
+ cd htmlman \
+ && $(HEVEA) $(HTML_FLAGS) \
+ -I .. -I ../cmds -I ../library -I ../refman \
+ -I ../refman/extensions -I ../tutorials \
+ -I ../../styles -I ../texstuff \
+ manual.hva -e macros.tex ../manual.tex \
+ && $(HACHA) -tocter manual.html
+
+info: files latex_files
+ cd infoman \
+ && rm -f ocaml.info* \
+ && $(HEVEA) $(INFO_FLAGS) -o ocaml.info.body \
+ -I .. -I ../cmds -I ../library -I ../refman \
+ -I ../refman/extensions -I ../tutorials \
+ -I ../../styles -I ../texstuff \
+ ../manual.inf -e macros.tex ../manual.tex
+ cat manual.info.header infoman/ocaml.info.body > infoman/ocaml.info
+ cd infoman \
+ && rm -f ocaml.info.tmp ocaml.info.body \
+ && gzip -9 ocaml.info*
+
+text: files latex_files
+ cd textman \
+ && $(HEVEA) $(TEXT_FLAGS) \
+ -I .. -I ../cmds -I ../library -I ../refman \
+ -I ../refman/extensions -I ../tutorials \
+ -I ../../styles -I ../texstuff \
+ ../manual.inf -e macros.tex ../manual.tex
+
+
+all:
+ $(MAKE) html
+ $(MAKE) text
+ $(MAKE) info
+ $(MAKE) manual
+ $(MAKE) index
+ $(MAKE) manual
+
+release: all
+ cp htmlman/manual.html $(RELEASE)refman.html
+ rm -f htmlman/manual.{html,haux,hmanual*,htoc}
+ tar zcf $(RELEASE)refman-html.tar.gz \
+ htmlman/*.* htmlman/libref htmlman/compilerlibref htmlman/fonts
+ zip -8 $(RELEASE)refman-html.zip \
+ htmlman/*.* htmlman/libref/*.* htmlman/compilerlibref/*.* \
+ htmlman/fonts/*.*
+ cp texstuff/manual.pdf $(RELEASE)refman.pdf
+ cp textman/manual.txt $(RELEASE)refman.txt
+ tar cf - infoman/ocaml.info* | gzip > $(RELEASE)refman.info.tar.gz
+
+web: html
+ $(MAKE) -C html_processing all
+
+files: $(FILES)
+ $(MAKE) -C cmds all
+ $(MAKE) -C library all
+ $(MAKE) -C refman all
+ $(MAKE) -C tutorials all
+
+etex-files: $(FILES)
+ $(MAKE) -C cmds etex-files
+ $(MAKE) -C library etex-files
+ $(MAKE) -C refman etex-files
+ $(MAKE) -C tutorials etex-files
+
+
+%.tex: %.etex
+ $(TEXQUOTE) < $< > $*.texquote_error.tex
+ mv $*.texquote_error.tex $@
+
+version.tex: $(SRC)/VERSION
+ sed -n -e '1s/^\([0-9]*\.[0-9]*\).*$$/\\def\\ocamlversion{\1}/p' $< > $@
+
+cmds/warnings-help.etex: $(SRC)/utils/warnings.ml $(SRC)/ocamlc
+ (echo "% This file is generated from (ocamlc -warn-help)";\
+ echo "% according to a rule in manual/src/Makefile.";\
+ echo "% In particular, the reference to documentation sections";\
+ echo "% are inserted through the Makefile, which should be updated";\
+ echo "% when a new warning is documented.";\
+ echo "%";\
+ $(SET_LD_PATH) $(SRC)/boot/ocamlrun $(SRC)/ocamlc -warn-help \
+ | LC_ALL=C sed -e 's/^ *\([0-9][0-9]*\) *\[\([a-z][a-z-]*\)\]\(.*\)/\\item[\1 "\2"] \3/' \
+ -e 's/^ *\([0-9A-Z][0-9]*\) *\([^]].*\)/\\item[\1] \2/'\
+ | sed -e 's/@/\\@/g' \
+ ) >$@
+# sed --inplace is not portable, emulate
+ for i in 52 57; do\
+ sed\
+ s'/\\item\[\('$$i'[^]]*\)\]/\\item\[\1 (see \\ref{ss:warn'$$i'})\]/'\
+ $@ > $@.tmp;\
+ mv $@.tmp $@;\
+ done
+
+ifocamldoc.tex: $(SRC)/Makefile.config
+ $(MAKE) -C $(APIDOC) build/latex/ifocamldoc.tex
+ cp $(APIDOC)/build/latex/ifocamldoc.tex $@
+
+.PHONY: clean
+clean:
+ rm -f $(FILES) *.texquote_error
+ $(MAKE) -C cmds clean
+ $(MAKE) -C library clean
+ $(MAKE) -C refman clean
+ $(MAKE) -C tutorials clean
+ $(MAKE) -C html_processing clean
+ -rm -f texstuff/*
+ cd htmlman; rm -rf libref compilerlibref *.htoc *.html *.haux *.hind *.svg \
+ manual.hmanual manual.hmanual.kwd manual.css
+ cd textman; rm -f manual.txt *.haux *.hind *.htoc
+ cd infoman; rm -f ocaml.info ocaml.info-* *.haux *.hind *.info*.gz
+
+.PHONY: distclean
+distclean: clean
+ $(MAKE) -C html_processing distclean
--- /dev/null
+\makeindex{\jobname}
+\makeindex{\jobname.kwd}
+
+\setlength{\emergencystretch}{50pt} % pour que TeX resolve les overfull hbox lui-meme
+
+\begin{document}
+
+\thispagestyle{empty}
+\begin{maintitle}
+~\vfill
+\Huge The OCaml system \\
+ release \ocamlversion \\[1cm]
+\Large Documentation and user's manual \\[1cm]
+\large Xavier Leroy, \\
+ Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon \\[1cm]
+ \today \\
+ ~
+\vfill
+\normalsize Copyright \copyright\ \number\year\ Institut National de
+ Recherche en Informatique et en Automatique
+\end{maintitle}
+\cleardoublepage
+\setcounter{page}{1}
+
+\begin{htmlonly}
+\begin{maintitle}
+\vspace*{2ex}
+This manual is also available in
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.pdf}{PDF},
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.txt}{plain text},
+as a
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman-html.tar.gz}{bundle of HTML files},
+and as a
+\ahref{https://ocaml.org/releases/\ocamlversion/ocaml-\ocamlversion-refman.info.tar.gz}{bundle of Emacs Info files}.
+\end{maintitle}
+\end{htmlonly}
+
+\tableofcontents
+
+\input{foreword.tex}
+
+\part{An introduction to OCaml}
+\label{p:tutorials}
+\input{coreexamples.tex}
+\input{moduleexamples.tex}
+\input{objectexamples.tex}
+\input{lablexamples.tex}
+\input{polyvariant.tex}
+\input{polymorphism.tex}
+\input{gadtexamples.tex}
+\input{advexamples.tex}
+
+\part{The OCaml language}
+\label{p:refman}
+\input{refman.tex}
+\input{exten.tex}
+
+\part{The OCaml tools}
+\label{p:commands}
+
+\input{comp.tex}
+\input{top.tex}
+\input{runtime.tex}
+\input{native.tex}
+\input{lexyacc.tex}
+\input{ocamldep.tex}
+\input{ocamldoc.tex}
+\input{debugger.tex}
+\input{profil.tex}
+\input{intf-c.tex}
+\input{flambda.tex}
+\input{afl-fuzz.tex}
+\input{instrumented-runtime.tex}
+
+\part{The OCaml library}
+\label{p:library}
+\input{core.tex}
+\input{stdlib-blurb.tex}
+\input{compilerlibs.tex}
+\input{libunix.tex}
+\input{libstr.tex}
+\input{libthreads.tex}
+\input{libdynlink.tex}
+\input{old.tex}
+
+\part{Indexes}
+\label{p:indexes}
+
+\ifouthtml
+\begin{links}
+\item \ahref{libref/index_modules.html}{Index of modules}
+\item \ahref{libref/index_module_types.html}{Index of module types}
+\item \ahref{libref/index_types.html}{Index of types}
+\item \ahref{libref/index_exceptions.html}{Index of exceptions}
+\item \ahref{libref/index_values.html}{Index of values}
+\end{links}
+\else
+\printindex{\jobname}{Index to the library}
+\fi
+\printindex{\jobname.kwd}{Index of keywords}
+
+\end{document}
--- /dev/null
+%hevea book class with anchor links in headers
+\input{bookcommon.hva}
+\newcommand{\@book@attr}[1]{\@secid\envclass@attr{#1}}
+\newcommand{\@titlesecanchor}{\@open{a}{class="section-anchor" href="\#\@sec@id@attr" aria-hidden="true"}\@print@u{xfeff}\@close{a}}
+\@makesection
+ {\part}{-2}{part}
+ {\@opencell{class="center"}{}{}\@open{h1}{\@book@attr{part}}}%
+ {\partname~\thepart}{\\}%
+ {\@close{h1}\@closecell}
+\newstyle{.part}{margin:2ex auto;text-align:center}
+\@makesection
+ {\chapter}{-1}{chapter}
+ {\@open{h1}{\@book@attr{chapter}}}{\chaptername~\thechapter}{\quad}{\@close{h1}}
+\@makesection
+ {\section}{0}{section}
+ {\@open{h2}{\@book@attr{section}}\@titlesecanchor}{\thesection}{\quad}{\@close{h2}}%
+\@makesection
+ {\subsection}{1}{subsection}
+ {\@open{h3}{\@book@attr{subsection}}\@titlesecanchor}{\thesubsection}{\quad}{\@close{h3}}%
+\@makesection
+ {\subsubsection}{2}{subsubsection}
+ {\@open{h4}{\@book@attr{subsubsection}}\@titlesecanchor}{\thesubsubsection}{\quad}{\@close{h4}}%
+\@makesection
+ {\paragraph}{3}{paragraph}
+ {\@open{h5}{\@book@attr{paragraph}}\@titlesecanchor}{\theparagraph}{\quad}{\@close{h5}}%
+\@makesection
+ {\subparagraph}{4}{subparagraph}
+ {\@open{h6}{\@book@attr{subparagraph}}\@titlesecanchor}{\thesubparagraph}{\quad}{\@close{h6}}%
+\newcommand{\hacha@style}{book}%
+\styleloadedtrue
--- /dev/null
+\chapter{Further reading}
+
+For the interested reader, we list below some references to books and
+reports related (sometimes loosely) to Caml Light.
+
+\section{Programming in ML}
+
+The books below are programming courses taught in ML. Their main goal
+is to teach programming, not to describe ML in full details --- though
+most contain fairly good introductions to the ML language. Some of
+those books use the Standard ML dialect instead of the Caml dialect,
+so you will have to keep in mind the differences in syntax and in
+semantics.
+
+\begin{itemize}
+
+\item Pierre Weis and Xavier Leroy. {\it Le langage Caml.}
+InterÉditions, 1993.
+
+The natural companion to this manual, provided you read French. This
+book is a step-by-step introduction to programming in Caml, and
+presents many realistic examples of Caml programs.
+
+\item Guy Cousineau and Michel Mauny. {\it Approche fonctionnelle de
+la programmation}. Ediscience, 1995.
+
+Another Caml programming course written in French, with many original
+examples.
+
+\item Lawrence C.\ Paulson. {\it ML for the working programmer.}
+Cambridge University Press, 1991.
+
+A good introduction to programming in Standard ML. Develops a
+theorem prover as a complete example. Contains a presentation of
+the module system of Standard ML.
+
+\item Jeffrey D.\ Ullman. {\it Elements of ML programming.}
+Prentice Hall, 1993.
+
+Another good introduction to programming in Standard ML. No realistic
+examples, but a very detailed presentation of the language constructs.
+
+\item Ryan Stansifer. {\em ML primer.} Prentice-Hall, 1992.
+
+A short, but nice introduction to programming in Standard ML.
+
+\item Thérèse Accart Hardin and Véronique Donzeau-Gouge Viguié. {\em
+Concepts et outils de la programmation. Du fonctionnel à
+l'impératif avec Caml et Ada.} InterÉditions, 1992.
+
+A first course in programming, that first introduces the main programming
+notions in Caml, then shows them underlying Ada. Intended for
+beginners; slow-paced for the others.
+
+\item Rachel Harrison. {\em Abstract Data Types in Standard ML}.
+John Wiley \& Sons, 1993.
+
+A presentation of Standard ML from the standpoint of abstract data
+types. Uses intensively the Standard ML module system.
+
+\item Harold Abelson and Gerald Jay Sussman.
+{\em Structure and Interpretation of Computer Programs.} The MIT
+press, 1985. (French translation: {\em Structure et interprétation
+des programmes informatiques}, InterÉditions, 1989.)
+
+An outstanding course on programming, taught in Scheme, the modern
+dialect of Lisp. Well worth reading, even if you are more interested
+in ML than in Lisp.
+
+\end{itemize}
+
+\section{Descriptions of ML dialects}
+
+The books and reports below are descriptions of various programming
+languages from the ML family. They assume some familiarity with ML.
+
+\begin{itemize}
+
+\item Xavier Leroy and Pierre Weis. {\em Manuel de référence du
+langage Caml.} InterÉditions, 1993.
+
+The French edition of the present reference manual and user's manual.
+
+\item Robert Harper. {\em Introduction to Standard ML.} Technical
+report ECS-LFCS-86-14, University of Edinburgh, 1986.
+
+An overview of Standard ML, including the module system. Terse, but
+still readable.
+
+\item Robin Milner, Mads Tofte and Robert Harper. {\em The definition
+of Standard ML.} The MIT press, 1990.
+
+A complete formal definition of Standard ML, in the framework of
+structured operational semantics. This book is probably the most
+mathematically precise definition of a programming language ever
+written. It is heavy on formalism and extremely terse, so
+even readers who are thoroughly familiar with ML will have
+major difficulties with it.
+
+\item Robin Milner and Mads Tofte. {\em Commentary on Standard ML.}
+The MIT Press, 1991.
+
+A commentary on the book above, that attempts to explain the most
+delicate parts and motivate the design choices. Easier to read than the
+Definition, but still rather involving.
+
+\item Guy Cousineau and Gérard Huet. {\em The CAML primer.} Technical
+report~122, INRIA, 1990.
+
+A short description of the original Caml system, from which Caml Light
+has evolved. Some familiarity with Lisp is assumed.
+
+\item Pierre Weis et al. {\em The CAML reference manual, version
+2.6.1.} Technical report~121, INRIA, 1990.
+
+The manual for the original Caml system, from which Caml Light
+has evolved.
+
+\item Michael J.\ Gordon, Arthur J.\ Milner and Christopher P.\ Wadsworth.
+{\em Edinburgh LCF.} Lecture Notes in Computer Science
+volume~78, Springer-Verlag, 1979.
+
+This is the first published description of the ML language, at the
+time when it was nothing more than the control language for the LCF
+system, a theorem prover. This book is now obsolete, since the ML
+language has much evolved since then; but it is still of historical
+interest.
+
+\item Paul Hudak, Simon Peyton-Jones and Philip Wadler. {\em
+Report on the programming language Haskell, version 1.1.} Technical
+report, Yale University, 1991.
+
+Haskell is a purely functional language with lazy semantics that
+shares many important points with ML (full functionality, polymorphic
+typing), but has interesting features of its own (dynamic overloading,
+also called type classes).
+
+\end{itemize}
+
+\section{Implementing functional programming languages}
+
+The references below are intended for those who are curious to learn
+how a language like Caml Light is compiled and implemented.
+
+\begin{itemize}
+
+\item Xavier Leroy. {\em The ZINC experiment: an economical
+implementation of the ML language.} Technical report~117, INRIA, 1990.
+(Available by anonymous FTP on "ftp.inria.fr".)
+
+A description of the ZINC implementation, the prototype ML
+implementation that has evolved into Caml Light. Large parts of this
+report still apply to the current Caml Light system, in particular the
+description of the execution model and abstract machine. Other parts
+are now obsolete. Yet this report still gives a complete overview of the
+implementation techniques used in Caml Light.
+
+\item Simon Peyton-Jones. {\em The implementation of functional
+programming languages.} Prentice-Hall, 1987. (French translation:
+{\em Mise en \oe uvre des langages fonctionnels de programmation},
+Masson, 1990.)
+
+An excellent description of the implementation of purely functional
+languages with lazy semantics, using the technique known as graph
+reduction. The part of the book that deals with the transformation
+from ML to enriched lambda-calculus directly applies to Caml Light.
+You will find a good description of how pattern-matching is compiled
+and how types are inferred. The remainder of the book does not apply
+directly to Caml Light, since Caml Light is not purely functional (it
+has side-effects), has strict semantics, and does not use graph
+reduction at all.
+
+\item Andrew W.\ Appel. {\em Compiling with continuations.} Cambridge
+University Press, 1992.
+
+A complete description of an optimizing compiler for Standard ML,
+based on an intermediate representation called continuation-passing
+style. Shows how many advanced program optimizations can be applied to
+ML. Not directly relevant to the Caml Light system, since Caml Light
+does not use continuation-passing style at all, and makes little
+attempts at optimizing programs.
+
+\end{itemize}
+
+\section{Applications of ML}
+
+The following reports show ML at work in various, sometimes
+unexpected, areas.
+
+\begin{itemize}
+
+\item Emmanuel Chailloux and Guy Cousineau. {\em The MLgraph primer.}
+Technical report 92-15, École Normale Supérieure, 1992. (Available by
+anonymous FTP on "ftp.ens.fr".)
+%, répertoire "biblio", fichier
+% "liens-92-15.A4.300dpi.ps.Z".)
+
+Describes a Caml Light library that produces Postscript pictures
+through high-level drawing functions.
+
+\item Xavier Leroy. {\em Programmation du système Unix en Caml Light.}
+Technical report~147, INRIA, 1992. (Available by anonymous FTP on
+"ftp.inria.fr".)
+%, répertoire "INRIA/publication", fichier "RT-0147.ps.Z".)
+
+A Unix systems programming course, demonstrating the use of the Caml
+Light library that gives access to Unix system calls.
+
+\item John H.\ Reppy. {\em Concurrent programming with events --- The
+concurrent ML manual.} Cornell University, 1990.
+(Available by anonymous FTP on "research.att.com".)
+%, répertoire "dist/ml", fichier "CML-0.9.8.tar.Z".)
+
+Concurrent ML extends Standard ML of New Jersey with concurrent
+processes that communicate through channels and events.
+
+\item Jeannette M. Wing, Manuel Faehndrich, J.\ Gregory Morrisett and
+Scottt Nettles. {\em Extensions to Standard ML to support
+transactions.} Technical report CMU-CS-92-132, Carnegie-Mellon
+University, 1992. (Available by anonymous FTP on
+"reports.adm.cs.cmu.edu".)
+% , répertoire "1992", fichier "CMU-CS-92-132.ps".)
+
+How to integrate the basic database operations to Standard ML.
+
+\item Emden R.\ Gansner and John H.\ Reppy. {\em eXene.} Bell Labs,
+1991. (Available by anonymous FTP on "research.att.com".)
+%, répertoire "dist/ml", fichier "eXene-0.4.tar.Z".)
+
+An interface between Standard ML of New Jersey and the X Windows
+windowing system.
+
+%% \item Daniel de Rauglaudre. {\em X toolkit in Caml Light.} INRIA,
+%% 1992. (Included in the Caml Light distribution.)
+%% % Disponible par FTP anonyme sur
+%% % "ftp.inria.fr", répertoire "lang/caml-light", fichier "rt5.tar.Z".)
+%%
+%% An interface between Caml Light and the X Windows windowing system.
+
+\end{itemize}
--- /dev/null
+*.tex
+*.htex
+warnings.etex
--- /dev/null
+ROOTDIR = ../../..
+include $(ROOTDIR)/Makefile.common
+
+LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+ $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
+ -repo-root $(ROOTDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+FILES = comp.tex top.tex runtime.tex native.tex lexyacc.tex intf-c.tex \
+ ocamldep.tex profil.tex debugger.tex ocamldoc.tex \
+ warnings-help.tex flambda.tex \
+ afl-fuzz.tex instrumented-runtime.tex unified-options.tex
+
+etex-files: $(FILES)
+all: $(FILES)
+
+%.gen.tex: %.etex
+ $(CAMLLATEX) $< -o $*_camltex.tex
+ $(TRANSF) < $*_camltex.tex > $*.transf_error.tex
+ mv $*.transf_error.tex $@
+
+%.tex: %.gen.tex
+ $(TEXQUOTE) < $< > $*.texquote_error.tex
+ mv $*.texquote_error.tex $@
+
+.PHONY: clean
+clean:
+ rm -f *.tex
--- /dev/null
+\chapter{Fuzzing with afl-fuzz}
+%HEVEA\cutname{afl-fuzz.html}
+
+\section{s:afl-overview}{Overview}
+
+American fuzzy lop (``afl-fuzz'') is a {\em fuzzer}, a tool for
+testing software by providing randomly-generated inputs, searching for
+those inputs which cause the program to crash.
+
+Unlike most fuzzers, afl-fuzz observes the internal behaviour of the
+program being tested, and adjusts the test cases it generates to
+trigger unexplored execution paths. As a result, test cases generated
+by afl-fuzz cover more of the possible behaviours of the tested
+program than other fuzzers.
+
+This requires that programs to be tested are instrumented to
+communicate with afl-fuzz. The native-code compiler ``ocamlopt'' can
+generate such instrumentation, allowing afl-fuzz to be used against
+programs written in OCaml.
+
+For more information on afl-fuzz, see the website at
+\ifouthtml
+\ahref{http://lcamtuf.coredump.cx/afl/}{http://lcamtuf.coredump.cx/afl/}.
+\else
+{\tt http://lcamtuf.coredump.cx/afl/}
+\fi
+
+\section{s:afl-generate}{Generating instrumentation}
+
+The instrumentation that afl-fuzz requires is not generated by
+default, and must be explicitly enabled, by passing the {\tt
+ -afl-instrument} option to {\tt ocamlopt}.
+
+To fuzz a large system without modifying build tools, OCaml's {\tt
+ configure} script also accepts the {\tt afl-instrument} option. If
+OCaml is configured with {\tt afl-instrument}, then all programs
+compiled by {\tt ocamlopt} will be instrumented.
+
+\subsection{ss:afl-advanced}{Advanced options}
+
+In rare cases, it is useful to control the amount of instrumentation
+generated. By passing the {\tt -afl-inst-ratio N} argument to {\tt
+ ocamlopt} with {\tt N} less than 100, instrumentation can be
+generated for only N\% of branches. (See the afl-fuzz documentation on
+the parameter {\tt AFL\_INST\_RATIO} for the precise effect of this).
+
+\section{s:afl-example}{Example}
+
+As an example, we fuzz-test the following program, {\tt readline.ml}:
+
+\begin{verbatim}
+let _ =
+ let s = read_line () in
+ match Array.to_list (Array.init (String.length s) (String.get s)) with
+ ['s'; 'e'; 'c'; 'r'; 'e'; 't'; ' '; 'c'; 'o'; 'd'; 'e'] -> failwith "uh oh"
+ | _ -> ()
+\end{verbatim}
+
+There is a single input (the string ``secret code'') which causes this
+program to crash, but finding it by blind random search is infeasible.
+
+Instead, we compile with afl-fuzz instrumentation enabled:
+\begin{verbatim}
+ocamlopt -afl-instrument readline.ml -o readline
+\end{verbatim}
+Next, we run the program under afl-fuzz:
+\begin{verbatim}
+mkdir input
+echo asdf > input/testcase
+mkdir output
+afl-fuzz -i input -o output ./readline
+\end{verbatim}
+By inspecting instrumentation output, the fuzzer finds the crashing input quickly.
--- /dev/null
+\chapter{Batch compilation (ocamlc)} \label{c:camlc}
+%HEVEA\cutname{comp.html}
+
+This chapter describes the OCaml batch compiler "ocamlc",
+which compiles OCaml source files to bytecode object files and links
+these object files to produce standalone bytecode executable files.
+These executable files are then run by the bytecode interpreter
+"ocamlrun".
+
+\section{s:comp-overview}{Overview of the compiler}
+
+The "ocamlc" command has a command-line interface similar to the one of
+most C compilers. It accepts several types of arguments and processes them
+sequentially, after all options have been processed:
+
+\begin{itemize}
+\item
+Arguments ending in ".mli" are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file \var{x}".mli", the "ocamlc" compiler produces a compiled interface
+in the file \var{x}".cmi".
+
+\item
+Arguments ending in ".ml" are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects. From the file \var{x}".ml", the "ocamlc"
+compiler produces compiled object bytecode in the file \var{x}".cmo".
+
+If the interface file \var{x}".mli" exists, the implementation
+\var{x}".ml" is checked against the corresponding compiled interface
+\var{x}".cmi", which is assumed to exist. If no interface
+\var{x}".mli" is provided, the compilation of \var{x}".ml" produces a
+compiled interface file \var{x}".cmi" in addition to the compiled
+object code file \var{x}".cmo". The file \var{x}".cmi" produced
+corresponds to an interface that exports everything that is defined in
+the implementation \var{x}".ml".
+
+\item
+Arguments ending in ".cmo" are taken to be compiled object bytecode. These
+files are linked together, along with the object files obtained
+by compiling ".ml" arguments (if any), and the OCaml standard
+library, to produce a standalone executable program. The order in
+which ".cmo" and ".ml" arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given \var{x}".cmo" file must come
+before all ".cmo" files that refer to the unit \var{x}.
+
+\item
+Arguments ending in ".cma" are taken to be libraries of object bytecode.
+A library of object bytecode packs in a single file a set of object
+bytecode files (".cmo" files). Libraries are built with "ocamlc -a"
+(see the description of the "-a" option below). The object files
+contained in the library are linked as regular ".cmo" files (see
+above), in the order specified when the ".cma" file was built. The
+only difference is that if an object file contained in a library is
+not referenced anywhere in the program, then it is not linked in.
+
+\item
+Arguments ending in ".c" are passed to the C compiler, which generates
+a ".o" object file (".obj" under Windows). This object file is linked
+with the program if the "-custom" flag is set (see the description of
+"-custom" below).
+
+\item
+Arguments ending in ".o" or ".a" (".obj" or ".lib" under Windows)
+are assumed to be C object files and libraries. They are passed to the
+C linker when linking in "-custom" mode (see the description of
+"-custom" below).
+
+\item
+Arguments ending in ".so" (".dll" under Windows)
+are assumed to be C shared libraries (DLLs). During linking, they are
+searched for external C functions referenced from the OCaml code,
+and their names are written in the generated bytecode executable.
+The run-time system "ocamlrun" then loads them dynamically at program
+start-up time.
+
+\end{itemize}
+
+The output of the linking phase is a file containing compiled bytecode
+that can be executed by the OCaml bytecode interpreter:
+the command named "ocamlrun". If "a.out" is the name of the file
+produced by the linking phase, the command
+\begin{alltt}
+ ocamlrun a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
+\end{alltt}
+executes the compiled code contained in "a.out", passing it as
+arguments the character strings \nth{arg}{1} to \nth{arg}{n}.
+(See chapter~\ref{c:runtime} for more details.)
+
+On most systems, the file produced by the linking
+phase can be run directly, as in:
+\begin{alltt}
+ ./a.out \nth{arg}{1} \nth{arg}{2} \ldots \nth{arg}{n}
+\end{alltt}
+The produced file has the executable bit set, and it manages to launch
+the bytecode interpreter by itself.
+
+The compiler is able to emit some information on its internal stages.
+It can output ".cmt" files for the implementation of the compilation unit
+and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
+description of "-bin-annot" below).
+Each such file contains a typed abstract syntax tree (AST), that is produced
+during the type checking procedure. This tree contains all available information
+about the location and the specific type of each term in the source file.
+The AST is partial if type checking was unsuccessful.
+
+These ".cmt" and ".cmti" files are typically useful for code inspection tools.
+
+\section{s:comp-options}{Options}
+
+The following command-line options are recognized by "ocamlc".
+The options "-pack", "-a", "-c", "-output-obj" and "-output-complete-obj" are mutually exclusive.
+% Define boolean variables used by the macros in unified-options.etex
+\newif\ifcomp \comptrue
+\newif\ifnat \natfalse
+\newif\iftop \topfalse
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\paragraph{contextual-cli-control}{Contextual control of command-line options}
+
+The compiler command line can be modified ``from the outside''
+with the following mechanisms. These are experimental
+and subject to change. They should be used only for experimental and
+development work, not in released packages.
+
+\begin{options}
+\item["OCAMLPARAM" \rm(environment variable)]
+A set of arguments that will be inserted before or after the arguments from
+the command line. Arguments are specified in a comma-separated list
+of "name=value" pairs. A "_" is used to specify the position of
+the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
+executed before parsing the arguments, and "b=y" after. Finally,
+an alternative separator can be specified as the
+first character of the string, within the set ":|; ,".
+\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
+A mapping of file names to lists of arguments that
+will be added to the command line (and "OCAMLPARAM") arguments.
+\item["OCAML_FLEXLINK" \rm(environment variable)]
+Alternative executable to use on native
+Windows for "flexlink" instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\section{s:modules-file-system}{Modules and the file system}
+
+This short section is intended to clarify the relationship between the
+names of the modules corresponding to compilation units and the names
+of the files that contain their compiled interface and compiled
+implementation.
+
+The compiler always derives the module name by taking the capitalized
+base name of the source file (".ml" or ".mli" file). That is, it
+strips the leading directory name, if any, as well as the ".ml" or
+".mli" suffix; then, it set the first letter to uppercase, in order to
+comply with the requirement that module names must be capitalized.
+For instance, compiling the file "mylib/misc.ml" provides an
+implementation for the module named "Misc". Other compilation units
+may refer to components defined in "mylib/misc.ml" under the names
+"Misc."\var{name}; they can also do "open Misc", then use unqualified
+names \var{name}.
+
+The ".cmi" and ".cmo" files produced by the compiler have the same
+base name as the source file. Hence, the compiled files always have
+their base name equal (modulo capitalization of the first letter) to
+the name of the module they describe (for ".cmi" files) or implement
+(for ".cmo" files).
+
+When the compiler encounters a reference to a free module identifier
+"Mod", it looks in the search path for a file named "Mod.cmi" or "mod.cmi"
+and loads the compiled interface
+contained in that file. As a consequence, renaming ".cmi" files is not
+advised: the name of a ".cmi" file must always correspond to the name
+of the compilation unit it implements. It is admissible to move them
+to another directory, if their base name is preserved, and the correct
+"-I" options are given to the compiler. The compiler will flag an
+error if it loads a ".cmi" file that has been renamed.
+
+Compiled bytecode files (".cmo" files), on the other hand, can be
+freely renamed once created. That's because the linker never attempts
+to find by itself the ".cmo" file that implements a module with a
+given name: it relies instead on the user providing the list of ".cmo"
+files by hand.
+
+\section{s:comp-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[Cannot find file \var{filename}]
+The named file could not be found in the current directory, nor in the
+directories of the search path. The \var{filename} is either a
+compiled interface file (".cmi" file), or a compiled bytecode file
+(".cmo" file). If \var{filename} has the format \var{mod}".cmi", this
+means you are trying to compile a file that references identifiers
+from module \var{mod}, but you have not yet compiled an interface for
+module \var{mod}. Fix: compile \var{mod}".mli" or \var{mod}".ml"
+first, to create the compiled interface \var{mod}".cmi".
+
+If \var{filename} has the format \var{mod}".cmo", this
+means you are trying to link a bytecode object file that does not
+exist yet. Fix: compile \var{mod}".ml" first.
+
+If your program spans several directories, this error can also appear
+because you haven't specified the directories to look into. Fix: add
+the correct "-I" options to the command line.
+
+\item[Corrupted compiled interface \var{filename}]
+The compiler produces this error when it tries to read a compiled
+interface file (".cmi" file) that has the wrong structure. This means
+something went wrong when this ".cmi" file was written: the disk was
+full, the compiler was interrupted in the middle of the file creation,
+and so on. This error can also appear if a ".cmi" file is modified after
+its creation by the compiler. Fix: remove the corrupted ".cmi" file,
+and rebuild it.
+
+\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
+This is by far the most common type error in programs. Type \nth{t}{1} is
+the type inferred for the expression (the part of the program that is
+displayed in the error message), by looking at the expression itself.
+Type \nth{t}{2} is the type expected by the context of the expression; it
+is deduced by looking at how the value of this expression is used in
+the rest of the program. If the two types \nth{t}{1} and \nth{t}{2} are not
+compatible, then the error above is produced.
+
+In some cases, it is hard to understand why the two types \nth{t}{1} and
+\nth{t}{2} are incompatible. For instance, the compiler can report that
+``expression of type "foo" cannot be used with type "foo"'', and it
+really seems that the two types "foo" are compatible. This is not
+always true. Two type constructors can have the same name, but
+actually represent different types. This can happen if a type
+constructor is redefined. Example:
+\begin{verbatim}
+ type foo = A | B
+ let f = function A -> 0 | B -> 1
+ type foo = C | D
+ f C
+\end{verbatim}
+This result in the error message ``expression "C" of type "foo" cannot
+be used with type "foo"''.
+
+\item[The type of this expression, \var{t}, contains type variables
+ that cannot be generalized]
+Type variables ("'a", "'b", \ldots) in a type \var{t} can be in either
+of two states: generalized (which means that the type \var{t} is valid
+for all possible instantiations of the variables) and not generalized
+(which means that the type \var{t} is valid only for one instantiation
+of the variables). In a "let" binding "let "\var{name}" = "\var{expr},
+the type-checker normally generalizes as many type variables as
+possible in the type of \var{expr}. However, this leads to unsoundness
+(a well-typed program can crash) in conjunction with polymorphic
+mutable data structures. To avoid this, generalization is performed at
+"let" bindings only if the bound expression \var{expr} belongs to the
+class of ``syntactic values'', which includes constants, identifiers,
+functions, tuples of syntactic values, etc. In all other cases (for
+instance, \var{expr} is a function application), a polymorphic mutable
+could have been created and generalization is therefore turned off for
+all variables occurring in contravariant or non-variant branches of the
+type. For instance, if the type of a non-value is "'a list" the
+variable is generalizable ("list" is a covariant type constructor),
+but not in "'a list -> 'a list" (the left branch of "->" is
+contravariant) or "'a ref" ("ref" is non-variant).
+
+Non-generalized type variables in a type cause no difficulties inside
+a given structure or compilation unit (the contents of a ".ml" file,
+or an interactive session), but they cannot be allowed inside
+signatures nor in compiled interfaces (".cmi" file), because they
+could be used inconsistently later. Therefore, the compiler
+flags an error when a structure or compilation unit defines a value
+\var{name} whose type contains non-generalized type variables. There
+are two ways to fix this error:
+\begin{itemize}
+\item Add a type constraint or a ".mli" file to give a monomorphic
+type (without type variables) to \var{name}. For instance, instead of
+writing
+\begin{verbatim}
+ let sort_int_list = List.sort Stdlib.compare
+ (* inferred type 'a list -> 'a list, with 'a not generalized *)
+\end{verbatim}
+write
+\begin{verbatim}
+ let sort_int_list = (List.sort Stdlib.compare : int list -> int list);;
+\end{verbatim}
+\item If you really need \var{name} to have a polymorphic type, turn
+its defining expression into a function by adding an extra parameter.
+For instance, instead of writing
+\begin{verbatim}
+ let map_length = List.map Array.length
+ (* inferred type 'a array list -> int list, with 'a not generalized *)
+\end{verbatim}
+write
+\begin{verbatim}
+ let map_length lv = List.map Array.length lv
+\end{verbatim}
+\end{itemize}
+
+\item[Reference to undefined global \var{mod}]
+This error appears when trying to link an incomplete or incorrectly
+ordered set of files. Either you have forgotten to provide an
+implementation for the compilation unit named \var{mod} on the command line
+(typically, the file named \var{mod}".cmo", or a library containing
+that file). Fix: add the missing ".ml" or ".cmo" file to the command
+line. Or, you have provided an implementation for the module named
+\var{mod}, but it comes too late on the command line: the
+implementation of \var{mod} must come before all bytecode object files
+that reference \var{mod}. Fix: change the order of ".ml" and ".cmo"
+files on the command line.
+
+Of course, you will always encounter this error if you have mutually
+recursive functions across modules. That is, function "Mod1.f" calls
+function "Mod2.g", and function "Mod2.g" calls function "Mod1.f".
+In this case, no matter what permutations you perform on the command
+line, the program will be rejected at link-time. Fixes:
+\begin{itemize}
+\item Put "f" and "g" in the same module.
+\item Parameterize one function by the other.
+That is, instead of having
+\begin{verbatim}
+mod1.ml: let f x = ... Mod2.g ...
+mod2.ml: let g y = ... Mod1.f ...
+\end{verbatim}
+define
+\begin{verbatim}
+mod1.ml: let f g x = ... g ...
+mod2.ml: let rec g y = ... Mod1.f g ...
+\end{verbatim}
+and link "mod1.cmo" before "mod2.cmo".
+\item Use a reference to hold one of the two functions, as in :
+\begin{verbatim}
+mod1.ml: let forward_g =
+ ref((fun x -> failwith "forward_g") : <type>)
+ let f x = ... !forward_g ...
+mod2.ml: let g y = ... Mod1.f ...
+ let _ = Mod1.forward_g := g
+\end{verbatim}
+\end{itemize}
+
+\item[The external function \var{f} is not available]
+This error appears when trying to link code that calls external
+functions written in C. As explained in
+chapter~\ref{c:intf-c}, such code must be linked with C libraries that
+implement the required \var{f} C function. If the C libraries in
+question are not shared libraries (DLLs), the code must be linked in
+``custom runtime'' mode. Fix: add the required C libraries to the
+command line, and possibly the "-custom" option.
+
+\end{options}
+
+\section{s:comp-warnings}{Warning reference}
+
+This section describes and explains in detail some warnings:
+
+\subsection{ss:warn6}{Warning 6: Label omitted in function application}
+
+OCaml supports "labels-omitted" full applications: if the function has
+a known arity, all the arguments are unlabeled, and their number
+matches the number of non-optional parameters, then labels are ignored
+and non-optional parameters are matched in their definition
+order. Optional arguments are defaulted.
+
+\begin{verbatim}
+let f ~x ~y = x + y
+let test = f 2 3
+
+> let test = f 2 3
+> ^
+> Warning 6 [labels-omitted]: labels x, y were omitted in the application of this function.
+\end{verbatim}
+
+This support for "labels-omitted" application was introduced when
+labels were added to OCaml, to ease the progressive introduction of
+labels in a codebase. However, it has the downside of weakening the
+labeling discipline: if you use labels to prevent callers from
+mistakenly reordering two parameters of the same type, labels-omitted
+make this mistake possible again.
+
+Warning 6 warns when labels-omitted applications are used, to
+discourage their use. When labels were introduced, this warning was
+not enabled by default, so users would use labels-omitted
+applications, often without noticing.
+
+Over time, it has become idiomatic to enable this warning to avoid
+argument-order mistakes. The warning is now on by default, since OCaml
+4.13. Labels-omitted applications are not recommended anymore, but
+users wishing to preserve this transitory style can disable the
+warning explicitly.
+
+\subsection{ss:warn9}{Warning 9: missing fields in a record pattern}
+
+ When pattern matching on records, it can be useful to match only few
+ fields of a record. Eliding fields can be done either implicitly
+ or explicitly by ending the record pattern with "; _".
+ However, implicit field elision is at odd with pattern matching
+ exhaustiveness checks.
+ Enabling warning 9 prioritizes exhaustiveness checks over the
+ convenience of implicit field elision and will warn on implicit
+ field elision in record patterns. In particular, this warning can
+ help to spot exhaustive record pattern that may need to be updated
+ after the addition of new fields to a record type.
+
+\begin{verbatim}
+type 'a point = {x : 'a; y : 'a}
+let dx { x } = x (* implicit field elision: trigger warning 9 *)
+let dy { y; _ } = y (* explicit field elision: do not trigger warning 9 *)
+\end{verbatim}
+
+\subsection{ss:warn52}{Warning 52: fragile constant pattern}
+
+ Some constructors, such as the exception constructors "Failure" and
+ "Invalid_argument", take as parameter a "string" value holding
+ a text message intended for the user.
+
+ These text messages are usually not stable over time: call sites
+ building these constructors may refine the message in a future
+ version to make it more explicit, etc. Therefore, it is dangerous to
+ match over the precise value of the message. For example, until
+ OCaml 4.02, "Array.iter2" would raise the exception
+\begin{verbatim}
+ Invalid_argument "arrays must have the same length"
+\end{verbatim}
+ Since 4.03 it raises the more helpful message
+\begin{verbatim}
+ Invalid_argument "Array.iter2: arrays must have the same length"
+\end{verbatim}
+ but this means that any code of the form
+\begin{verbatim}
+ try ...
+ with Invalid_argument "arrays must have the same length" -> ...
+\end{verbatim}
+ is now broken and may suffer from uncaught exceptions.
+
+ Warning 52 is there to prevent users from writing such fragile code
+ in the first place. It does not occur on every matching on a literal
+ string, but only in the case in which library authors expressed
+ their intent to possibly change the constructor parameter value in
+ the future, by using the attribute "ocaml.warn_on_literal_pattern"
+ (see the manual section on builtin attributes in
+ \ref{ss:builtin-attributes}):
+\begin{caml_example*}{verbatim}[warning=52]
+type t =
+ | Foo of string [@ocaml.warn_on_literal_pattern]
+ | Bar of string
+
+let no_warning = function
+ | Bar "specific value" -> 0
+ | _ -> 1
+
+let warning = function
+ | Foo "specific value" -> 0
+ | _ -> 1
+\end{caml_example*}
+
+ In particular, all built-in exceptions with a string argument have
+ this attribute set: "Invalid_argument", "Failure", "Sys_error" will
+ all raise this warning if you match for a specific string argument.
+
+ Additionally, built-in exceptions with a structured argument that
+ includes a string also have the attribute set: "Assert_failure" and
+ "Match_failure" will raise the warning for a pattern that uses a
+ literal string to match the first element of their tuple argument.
+
+ If your code raises this warning, you should {\em not} change the
+ way you test for the specific string to avoid the warning (for
+ example using a string equality inside the right-hand-side instead
+ of a literal pattern), as your code would remain fragile. You should
+ instead enlarge the scope of the pattern by matching on all possible
+ values.
+
+\begin{verbatim}
+
+let warning = function
+ | Foo _ -> 0
+ | _ -> 1
+\end{verbatim}
+
+ This may require some care: if the scrutinee may return several
+ different cases of the same pattern, or raise distinct instances of
+ the same exception, you may need to modify your code to separate
+ those several cases.
+
+ For example,
+\begin{verbatim}
+try (int_of_string count_str, bool_of_string choice_str) with
+ | Failure "int_of_string" -> (0, true)
+ | Failure "bool_of_string" -> (-1, false)
+\end{verbatim}
+ should be rewritten into more atomic tests. For example,
+ using the "exception" patterns documented in Section~\ref{sss:exception-match},
+ one can write:
+\begin{verbatim}
+match int_of_string count_str with
+ | exception (Failure _) -> (0, true)
+ | count ->
+ begin match bool_of_string choice_str with
+ | exception (Failure _) -> (-1, false)
+ | choice -> (count, choice)
+ end
+\end{verbatim}
+
+The only case where that transformation is not possible is if a given
+function call may raise distinct exceptions with the same constructor
+but different string values. In this case, you will have to check for
+specific string values. This is dangerous API design and it should be
+discouraged: it's better to define more precise exception constructors
+than store useful information in strings.
+
+\subsection{ss:warn57}{Warning 57: Ambiguous or-pattern variables under guard}
+
+ The semantics of or-patterns in OCaml is specified with
+ a left-to-right bias: a value \var{v} matches the pattern \var{p} "|" \var{q}
+ if it matches \var{p} or \var{q}, but if it matches both,
+ the environment captured by the match is the environment captured by
+ \var{p}, never the one captured by \var{q}.
+
+ While this property is generally intuitive, there is at least one specific
+ case where a different semantics might be expected.
+ Consider a pattern followed by a when-guard:
+ "|"~\var{p}~"when"~\var{g}~"->"~\var{e}, for example:
+\begin{verbatim}
+ | ((Const x, _) | (_, Const x)) when is_neutral x -> branch
+\end{verbatim}
+ The semantics is clear:
+ match the scrutinee against the pattern, if it matches, test the guard,
+ and if the guard passes, take the branch.
+ In particular, consider the input "(Const"~\var{a}", Const"~\var{b}")", where
+ \var{a} fails the test "is_neutral"~\var{a}, while \var{b} passes the test
+ "is_neutral"~\var{b}. With the left-to-right semantics, the clause above is
+ {\em not} taken by its input: matching "(Const"~\var{a}", Const"~\var{b}")"
+ against the or-pattern succeeds in the left branch, it returns the
+ environment \var{x}~"->"~\var{a}, and then the guard
+ "is_neutral"~\var{a} is tested and fails, the branch is not taken.
+
+ However, another semantics may be considered more natural here:
+ any pair that has one side passing the test will take the branch. With this
+ semantics the previous code fragment would be equivalent to
+\begin{verbatim}
+ | (Const x, _) when is_neutral x -> branch
+ | (_, Const x) when is_neutral x -> branch
+\end{verbatim}
+ This is {\em not} the semantics adopted by OCaml.
+
+ Warning 57 is dedicated to these confusing cases where the
+ specified left-to-right semantics is not equivalent to a non-deterministic
+ semantics (any branch can be taken) relatively to a specific guard.
+ More precisely, it warns when guard uses ``ambiguous'' variables, that are bound
+ to different parts of the scrutinees by different sides of a or-pattern.
--- /dev/null
+\chapter{The debugger (ocamldebug)} \label{c:debugger}
+%HEVEA\cutname{debugger.html}
+
+This chapter describes the OCaml source-level replay debugger
+"ocamldebug".
+
+\begin{unix} The debugger is available on Unix systems that provide
+BSD sockets.
+\end{unix}
+
+\begin{windows} The debugger is available under the Cygwin port of
+OCaml, but not under the native Win32 ports.
+\end{windows}
+
+\section{s:debugger-compilation}{Compiling for debugging}
+
+Before the debugger can be used, the program must be compiled and
+linked with the "-g" option: all ".cmo" and ".cma" files that are part
+of the program should have been created with "ocamlc -g", and they
+must be linked together with "ocamlc -g".
+
+Compiling with "-g" entails no penalty on the running time of
+programs: object files and bytecode executable files are bigger and
+take longer to produce, but the executable files run at
+exactly the same speed as if they had been compiled without "-g".
+
+\section{s:debugger-invocation}{Invocation}
+
+\subsection{ss:debugger-start}{Starting the debugger}
+
+The OCaml debugger is invoked by running the program
+"ocamldebug" with the name of the bytecode executable file as first
+argument:
+\begin{alltt}
+ ocamldebug \optvar{options} \var{program} \optvar{arguments}
+\end{alltt}
+The arguments following \var{program} are optional, and are passed as
+command-line arguments to the program being debugged. (See also the
+"set arguments" command.)
+
+The following command-line options are recognized:
+\begin{options}
+\item["-c " \var{count}]
+Set the maximum number of simultaneously live checkpoints to \var{count}.
+
+\item["-cd " \var{dir}]
+Run the debugger program from the working directory \var{dir},
+instead of the current directory. (See also the "cd" command.)
+
+\item["-emacs"]
+Tell the debugger it is executed under Emacs. (See
+section~\ref{s:inf-debugger} for information on how to run the
+debugger under Emacs.)
+
+\item["-I "\var{directory}]
+Add \var{directory} to the list of directories searched for source
+files and compiled files. (See also the "directory" command.)
+
+\item["-s "\var{socket}]
+Use \var{socket} for communicating with the debugged program. See the
+description of the command "set socket" (section~\ref{ss:debugger-communication})
+for the format of \var{socket}.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\subsection{ss:debugger-init-file}{Initialization file}
+
+On start-up, the debugger will read commands from an initialization
+file before giving control to the user. The default file is
+".ocamldebug" in the current directory if it exists, otherwise
+".ocamldebug" in the user's home directory.
+
+\subsection{ss:debugger-exut}{Exiting the debugger}
+
+The command "quit" exits the debugger. You can also exit the debugger
+by typing an end-of-file character (usually "ctrl-D").
+
+Typing an interrupt character (usually "ctrl-C") will not exit the
+debugger, but will terminate the action of any debugger command that is in
+progress and return to the debugger command level.
+
+\section{s:debugger-commands}{Commands}
+
+A debugger command is a single line of input. It starts with a command
+name, which is followed by arguments depending on this name. Examples:
+\begin{verbatim}
+ run
+ goto 1000
+ set arguments arg1 arg2
+\end{verbatim}
+
+A command name can be truncated as long as there is no ambiguity. For
+instance, "go 1000" is understood as "goto 1000", since there are no
+other commands whose name starts with "go". For the most frequently
+used commands, ambiguous abbreviations are allowed. For instance, "r"
+stands for "run" even though there are others commands starting with
+"r". You can test the validity of an abbreviation using the "help" command.
+
+If the previous command has been successful, a blank line (typing just
+"RET") will repeat it.
+
+\subsection{ss:debugger-help}{Getting help}
+
+The OCaml debugger has a simple on-line help system, which gives
+a brief description of each command and variable.
+
+\begin{options}
+\item["help"]
+Print the list of commands.
+
+\item["help "\var{command}]
+Give help about the command \var{command}.
+
+\item["help set "\var{variable}, "help show "\var{variable}]
+Give help about the variable \var{variable}. The list of all debugger
+variables can be obtained with "help set".
+
+\item["help info "\var{topic}]
+Give help about \var{topic}. Use "help info" to get a list of known topics.
+\end{options}
+
+\subsection{ss:debugger-state}{Accessing the debugger state}
+
+\begin{options}
+\item["set "\var{variable} \var{value}]
+Set the debugger variable \var{variable} to the value \var{value}.
+
+\item["show "\var{variable}]
+Print the value of the debugger variable \var{variable}.
+
+\item["info "\var{subject}]
+Give information about the given subject.
+For instance, "info breakpoints" will print the list of all breakpoints.
+\end{options}
+
+\section{s:debugger-execution}{Executing a program}
+
+\subsection{ss:debugger-events}{Events}
+
+Events are ``interesting'' locations in the source code, corresponding
+to the beginning or end of evaluation of ``interesting''
+sub-expressions. Events are the unit of single-stepping (stepping goes
+to the next or previous event encountered in the program execution).
+Also, breakpoints can only be set at events. Thus, events play the
+role of line numbers in debuggers for conventional languages.
+
+During program execution, a counter is incremented at each event
+encountered. The value of this counter is referred as the {\em current
+time}. Thanks to reverse execution, it is possible to jump back and
+forth to any time of the execution.
+
+Here is where the debugger events (written \event) are located in
+the source code:
+\begin{itemize}
+\item Following a function application:
+\begin{alltt}
+(f arg)\event
+\end{alltt}
+\item On entrance to a function:
+\begin{alltt}
+fun x y z -> \event ...
+\end{alltt}
+\item On each case of a pattern-matching definition (function,
+"match"\ldots"with" construct, "try"\ldots"with" construct):
+\begin{alltt}
+function pat1 -> \event expr1
+ | ...
+ | patN -> \event exprN
+\end{alltt}
+\item Between subexpressions of a sequence:
+\begin{alltt}
+expr1; \event expr2; \event ...; \event exprN
+\end{alltt}
+\item In the two branches of a conditional expression:
+\begin{alltt}
+if cond then \event expr1 else \event expr2
+\end{alltt}
+\item At the beginning of each iteration of a loop:
+\begin{alltt}
+while cond do \event body done
+for i = a to b do \event body done
+\end{alltt}
+\end{itemize}
+Exceptions: A function application followed by a function return is replaced
+by the compiler by a jump (tail-call optimization). In this case, no
+event is put after the function application.
+% Also, no event is put after a function application when the function
+% is external (written in C).
+
+\subsection{ss:debugger-starting-program}{Starting the debugged program}
+
+The debugger starts executing the debugged program only when needed.
+This allows setting breakpoints or assigning debugger variables before
+execution starts. There are several ways to start execution:
+\begin{options}
+\item["run"] Run the program until a breakpoint is hit, or the program
+terminates.
+\item["goto 0"] Load the program and stop on the first event.
+\item["goto "\var{time}] Load the program and execute it until the
+given time. Useful when you already know approximately at what time
+the problem appears. Also useful to set breakpoints on function values
+that have not been computed at time 0 (see section~\ref{s:breakpoints}).
+\end{options}
+
+The execution of a program is affected by certain information it
+receives when the debugger starts it, such as the command-line
+arguments to the program and its working directory. The debugger
+provides commands to specify this information ("set arguments" and "cd").
+These commands must be used before program execution starts. If you try
+to change the arguments or the working directory after starting your
+program, the debugger will kill the program (after asking for confirmation).
+
+\subsection{ss:debugger-running}{Running the program}
+
+The following commands execute the program forward or backward,
+starting at the current time. The execution will stop either when
+specified by the command or when a breakpoint is encountered.
+
+\begin{options}
+\item["run"] Execute the program forward from current time. Stops at
+next breakpoint or when the program terminates.
+\item["reverse"] Execute the program backward from current time.
+Mostly useful to go to the last breakpoint encountered before the
+current time.
+\item["step "\optvar{count}] Run the program and stop at the next
+event. With an argument, do it \var{count} times. If \var{count} is 0,
+run until the program terminates or a breakpoint is hit.
+\item["backstep "\optvar{count}] Run the program backward and stop at
+the previous event. With an argument, do it \var{count} times.
+\item["next "\optvar{count}] Run the program and stop at the next
+event, skipping over function calls. With an argument, do it
+\var{count} times.
+\item["previous "\optvar{count}] Run the program backward and stop at
+the previous event, skipping over function calls. With an argument, do
+it \var{count} times.
+\item["finish"] Run the program until the current function returns.
+\item["start"] Run the program backward and stop at the first event
+before the current function invocation.
+\end{options}
+
+\subsection{ss:debugger-time-travel}{Time travel}
+
+You can jump directly to a given time, without stopping on
+breakpoints, using the "goto" command.
+
+As you move through the program, the debugger maintains an history of
+the successive times you stop at. The "last" command can be used to
+revisit these times: each "last" command moves one step back through
+the history. That is useful mainly to undo commands such as "step"
+and "next".
+
+\begin{options}
+\item["goto "\var{time}]
+Jump to the given time.
+\item["last "\optvar{count}]
+Go back to the latest time recorded in the execution history. With an
+argument, do it \var{count} times.
+\item["set history "\var{size}]
+Set the size of the execution history.
+\end{options}
+
+\subsection{ss:debugger-kill}{Killing the program}
+
+\begin{options}
+\item["kill"] Kill the program being executed. This command is mainly
+useful if you wish to recompile the program without leaving the debugger.
+\end{options}
+
+\section{s:breakpoints}{Breakpoints}
+
+A breakpoint causes the program to stop whenever a certain point in
+the program is reached. It can be set in several ways using the
+"break" command. Breakpoints are assigned numbers when set, for
+further reference. The most comfortable way to set breakpoints is
+through the Emacs interface (see section~\ref{s:inf-debugger}).
+
+\begin{options}
+\item["break"]
+Set a breakpoint at the current position in the program execution. The
+current position must be on an event (i.e., neither at the beginning,
+nor at the end of the program).
+
+\item["break "\var{function}]
+Set a breakpoint at the beginning of \var{function}. This works only
+when the functional value of the identifier \var{function} has been
+computed and assigned to the identifier. Hence this command cannot be
+used at the very beginning of the program execution, when all
+identifiers are still undefined; use "goto" \var{time} to advance
+execution until the functional value is available.
+
+\item["break \@" \optvar{module} \var{line}]
+Set a breakpoint in module \var{module} (or in the current module if
+\var{module} is not given), at the first event of line \var{line}.
+
+\item["break \@" \optvar{module} \var{line} \var{column}]
+Set a breakpoint in module \var{module} (or in the current module if
+\var{module} is not given), at the event closest to line \var{line},
+column \var{column}.
+
+\item["break \@" \optvar{module} "#" \var{character}]
+Set a breakpoint in module \var{module} at the event closest to
+character number \var{character}.
+
+\item["break " \var{frag}":"\var{pc}, "break " \var{pc}]
+Set a breakpoint at code address \var{frag}":"\var{pc}. The integer
+\var{frag} is the identifier of a code fragment, a set of modules that
+have been loaded at once, either initially or with the "Dynlink"
+module. The integer \var{pc} is the instruction counter within this
+code fragment. If \var{frag} is omitted, it defaults to 0, which is
+the code fragment of the program loaded initially.
+
+\item["delete "\optvar{breakpoint-numbers}]
+Delete the specified breakpoints. Without argument, all breakpoints
+are deleted (after asking for confirmation).
+
+\item["info breakpoints"] Print the list of all breakpoints.
+\end{options}
+
+\section{s:debugger-callstack}{The call stack}
+
+Each time the program performs a function application, it saves the
+location of the application (the return address) in a block of data
+called a stack frame. The frame also contains the local variables of
+the caller function. All the frames are allocated in a region of
+memory called the call stack. The command "backtrace" (or "bt")
+displays parts of the call stack.
+
+At any time, one of the stack frames is ``selected'' by the debugger; several
+debugger commands refer implicitly to the selected frame. In particular,
+whenever you ask the debugger for the value of a local variable, the
+value is found in the selected frame. The commands "frame", "up" and "down"
+select whichever frame you are interested in.
+
+When the program stops, the debugger automatically selects the
+currently executing frame and describes it briefly as the "frame"
+command does.
+
+\begin{options}
+\item["frame"]
+Describe the currently selected stack frame.
+
+\item["frame" \var{frame-number}]
+Select a stack frame by number and describe it. The frame currently
+executing when the program stopped has number 0; its caller has number
+1; and so on up the call stack.
+
+\item["backtrace "\optvar{count}, "bt "\optvar{count}]
+Print the call stack. This is useful to see which sequence of function
+calls led to the currently executing frame. With a positive argument,
+print only the innermost \var{count} frames.
+With a negative argument, print only the outermost -\var{count} frames.
+
+\item["up" \optvar{count}]
+Select and display the stack frame just ``above'' the selected frame,
+that is, the frame that called the selected frame. An argument says how
+many frames to go up.
+
+\item["down "\optvar{count}]
+Select and display the stack frame just ``below'' the selected frame,
+that is, the frame that was called by the selected frame. An argument
+says how many frames to go down.
+\end{options}
+
+\section{s:debugger-examining-values}{Examining variable values}
+
+The debugger can print the current value of simple expressions. The
+expressions can involve program variables: all the identifiers that
+are in scope at the selected program point can be accessed.
+
+Expressions that can be printed are a subset of OCaml
+expressions, as described by the following grammar:
+\begin{syntax}
+simple-expr:
+ lowercase-ident
+ | { capitalized-ident '.' } lowercase-ident
+ | '*'
+ | '$' integer
+ | simple-expr '.' lowercase-ident
+ | simple-expr '.(' integer ')'
+ | simple-expr '.[' integer ']'
+ | '!' simple-expr
+ | '(' simple-expr ')'
+\end{syntax}
+The first two cases refer to a value identifier, either unqualified or
+qualified by the path to the structure that define it.
+"*" refers to the result just computed (typically, the value of a
+function application), and is valid only if the selected event is an
+``after'' event (typically, a function application).
+@'$' integer@ refer to a previously printed value. The remaining four
+forms select part of an expression: respectively, a record field, an
+array element, a string element, and the current contents of a
+reference.
+
+\begin{options}
+\item["print "\var{variables}]
+Print the values of the given variables. "print" can be abbreviated as
+"p".
+\item["display "\var{variables}]
+Same as "print", but limit the depth of printing to 1. Useful to
+browse large data structures without printing them in full.
+"display" can be abbreviated as "d".
+\end{options}
+
+When printing a complex expression, a name of the form "$"\var{integer}
+is automatically assigned to its value. Such names are also assigned
+to parts of the value that cannot be printed because the maximal
+printing depth is exceeded. Named values can be printed later on
+with the commands "p $"\var{integer} or "d $"\var{integer}.
+Named values are valid only as long as the program is stopped. They
+are forgotten as soon as the program resumes execution.
+
+\begin{options}
+\item["set print_depth" \var{d}]
+Limit the printing of values to a maximal depth of \var{d}.
+\item["set print_length" \var{l}]
+Limit the printing of values to at most \var{l} nodes printed.
+\end{options}
+
+\section{s:debugger-control}{Controlling the debugger}
+
+\subsection{ss:debugger-name-and-arguments}{Setting the program name and arguments}
+
+\begin{options}
+\item["set program" \var{file}]
+Set the program name to \var{file}.
+\item["set arguments" \var{arguments}]
+Give \var{arguments} as command-line arguments for the program.
+\end{options}
+
+A shell is used to pass the arguments to the debugged program. You can
+therefore use wildcards, shell variables, and file redirections inside
+the arguments. To debug programs that read from standard input, it is
+recommended to redirect their input from a file (using
+"set arguments < input-file"), otherwise input to the program and
+input to the debugger are not properly separated, and inputs are not
+properly replayed when running the program backwards.
+
+\subsection{ss:debugger-loading}{How programs are loaded}
+
+The "loadingmode" variable controls how the program is executed.
+
+\begin{options}
+\item["set loadingmode direct"]
+The program is run directly by the debugger. This is the default mode.
+\item["set loadingmode runtime"]
+The debugger execute the OCaml runtime "ocamlrun" on the program.
+Rarely useful; moreover it prevents the debugging of programs compiled
+in ``custom runtime'' mode.
+\item["set loadingmode manual"]
+The user starts manually the program, when asked by the debugger.
+Allows remote debugging (see section~\ref{ss:debugger-communication}).
+\end{options}
+
+\subsection{ss:debugger-search-path}{Search path for files}
+
+The debugger searches for source files and compiled interface files in
+a list of directories, the search path. The search path initially
+contains the current directory "." and the standard library directory.
+The "directory" command adds directories to the path.
+
+Whenever the search path is modified, the debugger will clear any
+information it may have cached about the files.
+
+\begin{options}
+\item["directory" \var{directorynames}]
+Add the given directories to the search path. These directories are
+added at the front, and will therefore be searched first.
+
+\item["directory" \var{directorynames} "for" \var{modulename}]
+Same as "directory" \var{directorynames}, but the given directories will be
+searched only when looking for the source file of a module that has
+been packed into \var{modulename}.
+
+\item["directory"]
+Reset the search path. This requires confirmation.
+\end{options}
+
+\subsection{ss:debugger-working-dir}{Working directory}
+
+Each time a program is started in the debugger, it inherits its working
+directory from the current working directory of the debugger. This
+working directory is initially whatever it inherited from its parent
+process (typically the shell), but you can specify a new working
+directory in the debugger with the "cd" command or the "-cd"
+command-line option.
+
+\begin{options}
+\item["cd" \var{directory}]
+Set the working directory for "ocamldebug" to \var{directory}.
+
+\item["pwd"]
+Print the working directory for "ocamldebug".
+\end{options}
+
+\subsection{ss:debugger-reverse-execution}{Turning reverse execution on and off}
+
+In some cases, you may want to turn reverse execution off. This speeds
+up the program execution, and is also sometimes useful for interactive
+programs.
+
+Normally, the debugger takes checkpoints of the program state from
+time to time. That is, it makes a copy of the current state of the
+program (using the Unix system call "fork"). If the variable
+\var{checkpoints} is set to "off", the debugger will not take any
+checkpoints.
+
+\begin{options}
+\item["set checkpoints" \var{on/off}]
+Select whether the debugger makes checkpoints or not.
+\end{options}
+
+\subsection{ss:debugger-fork}{Behavior of the debugger with respect to "fork"}
+
+When the program issues a call to "fork", the debugger can either
+follow the child or the parent. By default, the debugger follows the
+parent process. The variable \var{follow_fork_mode} controls this
+behavior:
+
+\begin{options}
+\item["set follow_fork_mode" \var{child/parent}]
+Select whether to follow the child or the parent in case of a call to
+"fork".
+\end{options}
+
+\subsection{ss:debugger-stop-at-new-load}{Stopping execution when new code is loaded}
+
+The debugger is compatible with the "Dynlink" module. However, when an
+external module is not yet loaded, it is impossible to set a
+breakpoint in its code. In order to facilitate setting breakpoints in
+dynamically loaded code, the debugger stops the program each time new
+modules are loaded. This behavior can be disabled using the
+\var{break_on_load} variable:
+
+\begin{options}
+\item["set break_on_load" \var{on/off}]
+Select whether to stop after loading new code.
+\end{options}
+
+\subsection{ss:debugger-communication}{Communication between the debugger and the program}
+
+The debugger communicate with the program being debugged through a
+Unix socket. You may need to change the socket name, for example if
+you need to run the debugger on a machine and your program on another.
+
+\begin{options}
+\item["set socket" \var{socket}]
+Use \var{socket} for communication with the program. \var{socket} can be
+either a file name, or an Internet port specification
+\var{host}:\var{port}, where \var{host} is a host name or an Internet
+address in dot notation, and \var{port} is a port number on the host.
+\end{options}
+
+On the debugged program side, the socket name is passed through the
+"CAML_DEBUG_SOCKET" environment variable.
+
+\subsection{ss:debugger-fine-tuning}{Fine-tuning the debugger}
+
+Several variables enables to fine-tune the debugger. Reasonable
+defaults are provided, and you should normally not have to change them.
+
+\begin{options}
+\item["set processcount" \var{count}]
+Set the maximum number of checkpoints to \var{count}. More checkpoints
+facilitate going far back in time, but use more memory and create more
+Unix processes.
+\end{options}
+
+As checkpointing is quite expensive, it must not be done too often. On
+the other hand, backward execution is faster when checkpoints are
+taken more often. In particular, backward single-stepping is more
+responsive when many checkpoints have been taken just before the
+current time. To fine-tune the checkpointing strategy, the debugger
+does not take checkpoints at the same frequency for long displacements
+(e.g. "run") and small ones (e.g. "step"). The two variables "bigstep"
+and "smallstep" contain the number of events between two checkpoints
+in each case.
+
+\begin{options}
+\item["set bigstep" \var{count}]
+Set the number of events between two checkpoints for long displacements.
+\item["set smallstep" \var{count}]
+Set the number of events between two checkpoints for small
+displacements.
+\end{options}
+
+The following commands display information on checkpoints and events:
+
+\begin{options}
+\item["info checkpoints"]
+Print a list of checkpoints.
+\item["info events" \optvar{module}]
+Print the list of events in the given module (the current module, by default).
+\end{options}
+
+\subsection{ss:debugger-printers}{User-defined printers}
+
+Just as in the toplevel system (section~\ref{s:toplevel-directives}),
+the user can register functions for printing values of certain types.
+For technical reasons, the debugger cannot call printing functions
+that reside in the program being debugged. The code for the printing
+functions must therefore be loaded explicitly in the debugger.
+
+\begin{options}
+\item["load_printer \""\var{file-name}"\""]
+Load in the debugger the indicated ".cmo" or ".cma" object file. The
+file is loaded in an environment consisting only of the OCaml
+standard library plus the definitions provided by object files
+previously loaded using "load_printer". If this file depends on other
+object files not yet loaded, the debugger automatically loads them if
+it is able to find them in the search path. The loaded file does not
+have direct access to the modules of the program being debugged.
+
+\item["install_printer "\var{printer-name}]
+Register the function named \var{printer-name} (a
+value path) as a printer for objects whose types match the argument
+type of the function. That is, the debugger will call
+\var{printer-name} when it has such an object to print.
+The printing function \var{printer-name} must use the "Format" library
+module to produce its output, otherwise its output will not be
+correctly located in the values printed by the toplevel loop.
+
+The value path \var{printer-name} must refer to one of the functions
+defined by the object files loaded using "load_printer". It cannot
+reference the functions of the program being debugged.
+
+\item["remove_printer "\var{printer-name}]
+Remove the named function from the table of value printers.
+\end{options}
+
+\section{s:debugger-misc-cmds}{Miscellaneous commands}
+
+\begin{options}
+\item["list" \optvar{module} \optvar{beginning} \optvar{end}]
+List the source of module \var{module}, from line number
+\var{beginning} to line number \var{end}. By default, 20 lines of the
+current module are displayed, starting 10 lines before the current
+position.
+\item["source" \var{filename}]
+Read debugger commands from the script \var{filename}.
+\end{options}
+
+\section{s:inf-debugger}{Running the debugger under Emacs}
+
+The most user-friendly way to use the debugger is to run it under Emacs with
+the OCaml mode available through MELPA and also at
+\url{https://github.com/ocaml/caml-mode}.
+
+The OCaml debugger is started under Emacs by the command "M-x
+camldebug", with argument the name of the executable file
+\var{progname} to debug. Communication with the debugger takes place
+in an Emacs buffer named "*camldebug-"\var{progname}"*". The editing
+and history facilities of Shell mode are available for interacting
+with the debugger.
+
+In addition, Emacs displays the source files containing the current
+event (the current position in the program execution) and highlights
+the location of the event. This display is updated synchronously with
+the debugger action.
+
+The following bindings for the most common debugger commands are
+available in the "*camldebug-"\var{progname}"*" buffer:
+
+\begin{options}
+\item["C-c C-s"] (command "step"): execute the program one step forward.
+\item["C-c C-k"] (command "backstep"): execute the program one step backward.
+\item["C-c C-n"] (command "next"): execute the program one step
+forward, skipping over function calls.
+\item[Middle mouse button] (command "display"): display named value.
+"$"\var{n} under mouse cursor (support incremental browsing of large
+data structures).
+\item["C-c C-p"] (command "print"): print value of identifier at point.
+\item["C-c C-d"] (command "display"): display value of identifier at point.
+\item["C-c C-r"] (command "run"): execute the program forward to next
+breakpoint.
+\item["C-c C-v"] (command "reverse"): execute the program backward to
+latest breakpoint.
+\item["C-c C-l"] (command "last"): go back one step in the command history.
+\item["C-c C-t"] (command "backtrace"): display backtrace of function calls.
+\item["C-c C-f"] (command "finish"): run forward till the current
+function returns.
+\item["C-c <"] (command "up"): select the stack frame below the
+current frame.
+\item["C-c >"] (command "down"): select the stack frame above the
+current frame.
+\end{options}
+
+In all buffers in OCaml editing mode, the following debugger commands
+are also available:
+
+\begin{options}
+\item["C-x C-a C-b"] (command "break"): set a breakpoint at event closest
+to point
+\item["C-x C-a C-p"] (command "print"): print value of identifier at point
+\item["C-x C-a C-d"] (command "display"): display value of identifier at point
+\end{options}
--- /dev/null
+\chapter{Optimisation with Flambda}
+%HEVEA\cutname{flambda.html}
+
+\section{s:flambda-overview}{Overview}
+
+{\em Flambda} is the term used to describe a series of optimisation passes
+provided by the native code compilers as of OCaml 4.03.
+
+Flambda aims to make it easier to write idiomatic OCaml code without
+incurring performance penalties.
+
+To use the Flambda optimisers it is necessary to pass the {\tt -flambda}
+option to the OCaml {\tt configure} script. (There is no support for a
+single compiler that can operate in both Flambda and non-Flambda modes.)
+Code compiled with Flambda
+cannot be linked into the same program as code compiled without Flambda.
+Attempting to do this will result in a compiler error.
+
+Whether or not a particular {\tt ocamlopt} uses Flambda may be
+determined by invoking it with the {\tt -config} option and looking
+for any line starting with ``{\tt flambda:}''. If such a line is present
+and says ``{\tt true}'', then Flambda is supported, otherwise it is not.
+
+Flambda provides full optimisation across different compilation units,
+so long as the {\tt .cmx} files for the dependencies of the unit currently
+being compiled are available. (A compilation unit corresponds to a
+single {\tt .ml} source file.) However it does not yet act entirely as
+a whole-program compiler: for example, elimination of dead code across
+a complete set of compilation units is not supported.
+
+Optimisation with Flambda is not currently supported when generating
+bytecode.
+
+Flambda should not in general affect the semantics of existing programs.
+Two exceptions to this rule are: possible elimination of pure code
+that is being benchmarked (see section\ \ref{s:flambda-inhibition}) and changes in
+behaviour of code using unsafe operations (see section\ \ref{s:flambda-unsafe}).
+
+Flambda does not yet optimise array or string bounds checks. Neither
+does it take hints for optimisation from any assertions written by the
+user in the code.
+
+Consult the {\em Glossary} at the end of this chapter for definitions of
+technical terms used below.
+
+\section{s:flambda-cli}{Command-line flags}
+
+The Flambda optimisers provide a variety of command-line flags that may
+be used to control their behaviour. Detailed descriptions of each flag
+are given in the referenced sections. Those sections also describe any
+arguments which the particular flags take.
+
+Commonly-used options:
+\begin{options}
+\item[\machine{-O2}] Perform more optimisation than usual. Compilation
+times may be lengthened. (This flag is an abbreviation for a certain
+set of parameters described in section\ \ref{s:flambda-defaults}.)
+\item[\machine{-O3}] Perform even more optimisation than usual, possibly
+including unrolling of recursive functions. Compilation times may be
+significantly lengthened.
+\item[\machine{-Oclassic}] Make inlining decisions at the point of
+definition of a function rather than at the call site(s). This mirrors
+the behaviour of OCaml compilers not using Flambda. Compared to compilation
+using the new Flambda inlining heuristics (for example at {\tt -O2}) it
+produces
+smaller {\tt .cmx} files, shorter compilation times and code that probably
+runs rather slower. When using {\tt -Oclassic}, only the following options
+described in this section are relevant: {\tt -inlining-report} and
+{\tt -inline}. If any other of the options described in this section are
+used, the behaviour is undefined and may cause an error in future versions
+of the compiler.
+\item[\machine{-inlining-report}] Emit {\tt .inlining} files (one per
+round of optimisation) showing all of the inliner's decisions.
+\end{options}
+
+Less commonly-used options:
+\begin{options}
+\item[\machine{-remove-unused-arguments}] Remove unused function arguments
+even when the argument is not specialised. This may have a small
+performance penalty.
+See section\ \ref{ss:flambda-remove-unused-args}.
+\item[\machine{-unbox-closures}] Pass free variables via specialised arguments
+rather than closures (an optimisation for reducing allocation). See
+section\ \ref{ss:flambda-unbox-closures}. This may have a small performance penalty.
+\end{options}
+
+Advanced options, only needed for detailed tuning:
+\begin{options}
+\item[\machine{-inline}] The behaviour depends on whether {\tt -Oclassic}
+is used.
+\begin{itemize}
+\item When not in {\tt -Oclassic} mode, {\tt -inline} limits the total
+size of functions considered for inlining during any speculative inlining
+search. (See section\ \ref{ss:flambda-speculation}.) Note that
+this parameter does
+{\bf not} control the assessment as to whether any particular function may
+be inlined. Raising it to excessive amounts will not necessarily cause
+more functions to be inlined.
+\item When in {\tt -Oclassic} mode, {\tt -inline} behaves as in
+previous versions of the compiler: it is the maximum size of function to
+be considered for inlining. See section\ \ref{ss:flambda-classic}.
+\end{itemize}
+\item[\machine{-inline-toplevel}] The equivalent of {\tt -inline} but used
+when speculative inlining starts at toplevel. See
+section\ \ref{ss:flambda-speculation}.
+Not used in {\tt -Oclassic} mode.
+\item[\machine{-inline-branch-factor}] Controls how the inliner assesses
+whether a code path is likely to be hot or cold. See
+section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-alloc-cost},
+ \machine{-inline-branch-cost},
+ \machine{-inline-call-cost}] Controls how the inliner assesses the runtime
+ performance penalties associated with various operations. See
+ section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-indirect-cost},
+ \machine{-inline-prim-cost}] Likewise.
+\item[\machine{-inline-lifting-benefit}] Controls inlining of functors
+at toplevel. See section\ \ref{ss:flambda-assessment-inlining}.
+\item[\machine{-inline-max-depth}] The maximum depth of any
+speculative inlining search. See section\ \ref{ss:flambda-speculation}.
+\item[\machine{-inline-max-unroll}] The maximum depth of any unrolling of
+recursive functions during any speculative inlining search.
+See section\ \ref{ss:flambda-speculation}.
+\item[\machine{-no-unbox-free-vars-of-closures}] %
+Do not unbox closure variables. See section\ \ref{ss:flambda-unbox-fvs}.
+\item[\machine{-no-unbox-specialised-args}] %
+Do not unbox arguments to which functions have been specialised. See
+section\ \ref{ss:flambda-unbox-spec-args}.
+\item[\machine{-rounds}] How many rounds of optimisation to perform.
+See section\ \ref{ss:flambda-rounds}.
+\item[\machine{-unbox-closures-factor}] Scaling factor for benefit
+calculation when using {\tt -unbox-closures}. See
+section\ \ref{ss:flambda-unbox-closures}.
+\end{options}
+
+\paragraph{Notes}
+\begin{itemize}
+\item The set of command line flags relating to optimisation should typically
+be specified to be the same across an entire project. Flambda does not
+currently record the requested flags in the {\tt .cmx} files. As such,
+inlining of functions from previously-compiled units will subject their code
+to the optimisation parameters of the unit currently being compiled, rather
+than those specified when they were previously compiled. It is hoped to
+rectify this deficiency in the future.
+
+\item Flambda-specific flags do not affect linking with the exception of
+affecting the optimisation of code in the startup file (containing
+generated functions such as currying helpers). Typically such optimisation
+will not be significant, so eliding such flags at link time might be
+reasonable.
+
+\item Flambda-specific flags are silently accepted even when the
+{\tt -flambda} option was not provided to the {\tt configure} script.
+(There is no means provided to change this behaviour.)
+This is intended to make it more
+straightforward to run benchmarks with and without the Flambda optimisers
+in effect.
+\item Some of the Flambda flags may be subject to change in future
+releases.
+\end{itemize}
+
+\subsection{ss:flambda-rounds}{Specification of optimisation parameters by round}
+
+Flambda operates in {\em rounds}: one round consists of a certain sequence
+of transformations that may then be repeated in order to achieve more
+satisfactory results. The number of rounds can be set manually using the
+{\tt -rounds} parameter (although this is not necessary when using
+predefined optimisation levels such as with {\tt -O2} and {\tt -O3}).
+For high optimisation the number of rounds might be set at 3 or 4.
+
+Command-line flags that may apply per round, for example those with
+{\tt "-cost"} in the name, accept arguments of the form:
+\begin{center}
+{\em n}{\tt\ |\ }{\em round}{\tt =}{\em n}[{\tt,}...]
+\end{center}
+\begin{itemize}
+\item If the first form is used, with a single integer specified,
+the value will apply to all rounds.
+\item If the second form is used, zero-based {\em round} integers specify
+values which are to be used only for those rounds.
+\end{itemize}
+
+The flags {\tt -Oclassic}, {\tt -O2} and {\tt -O3} are applied before all
+other flags, meaning that certain parameters may be overridden without
+having to specify every parameter usually invoked by the given optimisation
+level.
+
+\section{s:flambda-inlining}{Inlining}
+
+{\em Inlining} refers to the copying of the code of a function to a
+place where the function is called.
+The code of the function will be surrounded by bindings of its parameters
+to the corresponding arguments.
+
+The aims of inlining are:
+\begin{itemize}
+\item to reduce the runtime overhead caused by function calls (including
+setting up for such calls and returning afterwards);
+\item to reduce instruction cache misses by expressing frequently-taken
+paths through the program using fewer machine instructions; and
+\item to reduce the amount of allocation (especially of closures).
+\end{itemize}
+These goals are often reached not just by inlining itself but also by
+other optimisations that the compiler is able to perform as a result of
+inlining.
+
+When a recursive call to a function (within the definition of that function
+or another in the same mutually-recursive group) is inlined, the procedure is
+also known as {\em unrolling}. This is somewhat akin to loop peeling.
+For example, given the following code:
+\begin{verbatim}
+let rec fact x =
+ if x = 0 then
+ 1
+ else
+ x * fact (x - 1)
+
+let n = fact 4
+\end{verbatim}
+unrolling once at the call site {\tt fact 4} produces (with the body of
+{\tt fact} unchanged):
+\begin{verbatim}
+let n =
+ if 4 = 0 then
+ 1
+ else
+ 4 * fact (4 - 1)
+\end{verbatim}
+This simplifies to:
+\begin{verbatim}
+let n = 4 * fact 3
+\end{verbatim}
+
+%% CR pchambart: A specific section for unrolling might be worth (telling
+%% when this is beneficial)
+
+Flambda provides significantly enhanced inlining capabilities relative to
+previous versions of the compiler.
+
+\subsubsection{sss:flambda-inlining-aside}{Aside: when inlining is performed}
+
+Inlining is performed together with all of the other Flambda optimisation
+passes, that is to say, after closure conversion. This has three particular
+advantages over a potentially more straightforward implementation prior to
+closure conversion:
+\begin{itemize}
+\item It permits higher-order inlining, for example when a non-inlinable
+function always returns the same function yet with different environments
+of definition. Not all such cases are supported yet, but it is intended
+that such support will be improved in future.
+\item It is easier to integrate with cross-module optimisation, since
+imported information about other modules is already in the correct
+intermediate language.
+\item It becomes more straightforward to optimise closure allocations since
+the layout of closures does not have to be estimated in any way: it is
+known. Similarly,
+it becomes more straightforward to control which variables end up
+in which closures, helping to avoid closure bloat.
+\end{itemize}
+
+\subsection{ss:flambda-classic}{Classic inlining heuristic}
+
+In {\tt -Oclassic} mode the behaviour of the Flambda inliner
+mimics previous versions
+of the compiler. (Code may still be subject to further optimisations not
+performed by previous versions of the compiler: functors may be inlined,
+constants are lifted and unused code is eliminated all as described elsewhere
+in this chapter. See sections \ref{sss:flambda-functors},\ \ref{ss:flambda-lift-const} %
+and\ \ref{s:flambda-remove-unused}.
+At the definition site of a function, the body of the
+function is measured. It will then be marked as eligible for inlining
+(and hence inlined at every direct call site) if:
+\begin{itemize}
+\item the measured size (in unspecified units) is smaller than that of a
+function call plus the argument of the {\tt -inline} command-line flag; and
+\item the function is not recursive.
+\end{itemize}
+
+Non-Flambda versions of the compiler cannot inline functions that
+contain a definition of another function. However {\tt -Oclassic} does
+permit this. Further, non-Flambda versions also cannot inline functions
+that are only themselves exposed as a result of a previous pass of inlining,
+but again this is permitted by {\tt -Oclassic}.
+For example:
+\begin{verbatim}
+module M : sig
+ val i : int
+end = struct
+ let f x =
+ let g y = x + y in
+ g
+ let h = f 3
+ let i = h 4 (* h is correctly discovered to be g and inlined *)
+end
+\end{verbatim}
+
+All of this contrasts with the normal Flambda mode, that is to say
+without {\tt -Oclassic}, where:
+\begin{itemize}
+\item the inlining decision is made at the {\bf call site}; and
+\item recursive functions can be handled, by {\em specialisation} (see
+below).
+\end{itemize}
+The Flambda mode is described in the next section.
+
+\subsection{ss:flambda-inlining-overview}{Overview of ``Flambda'' inlining heuristics}
+
+The Flambda inlining heuristics, used whenever the compiler is configured
+for Flambda and {\tt -Oclassic} was not specified, make inlining decisions
+at call sites. This helps in situations where the context is important.
+For example:
+\begin{verbatim}
+let f b x =
+ if b then
+ x
+ else
+ ... big expression ...
+
+let g x = f true x
+\end{verbatim}
+In this case, we would like to inline {\tt f} into {\tt g}, because a
+conditional jump can be eliminated and the code size should reduce. If the
+inlining decision has been made after the declaration of {\tt f} without
+seeing the use, its size would have probably made it ineligible for
+inlining; but at the call site, its final size can be known. Further,
+this function should probably not be inlined systematically: if {\tt b}
+is unknown, or indeed {\tt false}, there is little benefit to trade off
+against a large increase in code size. In the existing non-Flambda inliner
+this isn't a great problem because chains of inlining were cut off fairly
+quickly. However it has led to excessive use of overly-large inlining
+parameters such as {\tt -inline 10000}.
+
+In more detail, at each call site the following procedure is followed:
+\begin{itemize}
+\item Determine whether it is clear that inlining would be beneficial
+without, for the moment, doing any inlining within the function itself.
+(The exact assessment of {\em benefit} is described below.) If so, the
+function is inlined.
+\item If inlining the function is not clearly beneficial, then inlining
+will be performed {\em speculatively} inside the function itself. The
+search for speculative inlining possibilities is controlled by two
+parameters: the {\em inlining threshold} and the {\em inlining depth}.
+(These are described in more detail below.)
+\begin{itemize}
+\item If such speculation shows that performing some inlining inside the
+function would be beneficial, then such inlining is performed and the
+resulting function inlined at the original call site.
+\item Otherwise, nothing happens.
+\end{itemize}
+\end{itemize}
+Inlining within recursive functions of calls to other
+functions in the same mutually-recursive group is kept in check by
+an {\em unrolling depth}, described below. This ensures that functions are
+not unrolled to excess. (Unrolling is only enabled
+if {\tt -O3} optimisation level is selected and/or the
+{\tt -inline-max-unroll}
+flag is passed with an argument greater than zero.)
+
+\subsection{ss:flambda-by-constructs}{Handling of specific language constructs}
+
+\subsubsection{sss:flambda-functors}{Functors}
+
+There is nothing particular about functors that inhibits inlining compared
+to normal functions. To the inliner, these both look the same, except
+that functors are marked as such.
+
+Applications of functors at toplevel are biased in favour of inlining.
+(This bias may be adjusted:
+see the documentation for {\tt -inline-lifting-benefit} below.)
+
+Applications of functors not at toplevel, for example in a local module
+inside some other expression, are treated by the inliner identically to
+normal function calls.
+
+\subsubsection{sss:flambda-first-class-modules}{First-class modules}
+
+The inliner will be able to consider inlining a call to a function in a first
+class module if it knows which particular function is going to be called.
+The presence of the first-class module record that wraps the set of functions
+in the module does not per se inhibit inlining.
+
+\subsubsection{sss:flambda-objects}{Objects}
+
+Method calls to objects are not at present inlined by Flambda.
+
+\subsection{ss:flambda-inlining-reports}{Inlining reports}
+
+If the {\tt -inlining-report} option is provided to the compiler then a file
+will be emitted corresponding to each round of optimisation. For the
+OCaml source file {\em basename}{\tt .ml} the files
+are named {\em basename}{\tt .}{\em round}{\tt.inlining.org},
+with {\em round} a
+zero-based integer. Inside the files, which are formatted as ``org mode'',
+will be found English prose describing the decisions that the inliner took.
+
+\subsection{ss:flambda-assessment-inlining}{Assessment of inlining benefit}
+
+Inlining typically
+results in an increase in code size, which if left unchecked, may not only
+lead to grossly large executables and excessive compilation times but also
+a decrease in performance due to worse locality. As such, the
+Flambda inliner trades off the change in code size against
+the expected runtime performance benefit, with the benefit being computed
+based on the number of operations that the compiler observes may be removed
+as a result of inlining.
+
+For example given the following code:
+\begin{verbatim}
+let f b x =
+ if b then
+ x
+ else
+ ... big expression ...
+
+let g x = f true x
+\end{verbatim}
+it would be observed that inlining of {\tt f} would remove:
+\begin{itemize}
+\item one direct call;
+\item one conditional branch.
+\end{itemize}
+
+Formally, an estimate of runtime performance benefit is computed by
+first summing
+the cost of the operations that are known to be removed as a result of the
+inlining and subsequent simplification of the inlined body.
+The individual costs for the various kinds of operations may be adjusted
+using the various {\tt -inline-...-cost} flags as follows. Costs are
+specified as integers. All of these flags accept a single argument
+describing such integers using the conventions
+detailed in section\ \ref{ss:flambda-rounds}.
+\begin{options}
+\item[\machine{-inline-alloc-cost}] The cost of an allocation.
+\item[\machine{-inline-branch-cost}] The cost of a branch.
+\item[\machine{-inline-call-cost}] The cost of a direct function call.
+\item[\machine{-inline-indirect-cost}] The cost of an indirect function call.
+\item[\machine{-inline-prim-cost}] The cost of a {\em primitive}. Primitives
+encompass operations including arithmetic and memory access.
+\end{options}
+(Default values are described in section\ \ref{s:flambda-defaults} below.)
+
+The initial benefit value is then scaled by a factor that attempts to
+compensate for the fact that the current point in the code, if under some
+number of conditional branches, may be cold. (Flambda does not currently
+compute hot and cold paths.) The factor---the estimated probability that
+the inliner really is on a {\em hot} path---is calculated as
+$\frac{1}{(1 + f)^{d}}$, where $f$ is set by
+{\tt -inline-branch-factor} and $d$ is the nesting depth of branches
+at the current point. As the inliner descends into more deeply-nested
+branches, the benefit of inlining thus lessens.
+
+The resulting benefit value is known as the {\em estimated benefit}.
+
+The change in code size is also estimated: morally speaking it should be the
+change in machine code size, but since that is not available to the inliner,
+an approximation is used.
+
+If the estimated benefit exceeds the increase in code size then the inlined
+version of the function will be kept. Otherwise the function will not be
+inlined.
+
+Applications of functors at toplevel will be given
+an additional benefit (which may be controlled by the
+{\tt -inline-lifting-benefit} flag) to bias inlining in such situations
+towards keeping the inlined version.
+
+\subsection{ss:flambda-speculation}{Control of speculation}
+
+As described above, there are three parameters that restrict the search
+for inlining opportunities during speculation:
+\begin{itemize}
+\item the {\em inlining threshold};
+\item the {\em inlining depth};
+\item the {\em unrolling depth}.
+\end{itemize}
+These parameters are ultimately bounded by the arguments provided to
+the corresponding command-line flags (or their default values):
+\begin{itemize}
+\item {\tt -inline} (or, if the call site that triggered speculation is
+at toplevel, {\tt -inline-toplevel});
+\item {\tt -inline-max-depth};
+\item {\tt -inline-max-unroll}.
+\end{itemize}
+{\bf Note in particular} that {\tt -inline} does not have the meaning that
+it has in the previous compiler or in {\tt -Oclassic} mode. In both of those
+situations {\tt -inline} was effectively some kind of basic assessment of
+inlining benefit. However in Flambda inlining mode it corresponds to a
+constraint on the search; the assessment of benefit is independent, as
+described above.
+
+When speculation starts the inlining threshold starts at the value set
+by {\tt -inline} (or {\tt -inline-toplevel} if appropriate, see above).
+Upon making a speculative inlining decision the
+threshold is reduced by the code size of the function being inlined.
+If the threshold becomes exhausted, at or below zero, no further speculation
+will be performed.
+
+The inlining depth starts at zero
+and is increased by one every time the inliner
+descends into another function. It is then decreased by one every time the
+inliner leaves such function. If the depth exceeds the value set by
+{\tt -inline-max-depth} then speculation stops. This parameter is intended
+as a general backstop for situations where the inlining
+threshold does not control the search sufficiently.
+
+The unrolling depth applies to calls within the same mutually-recursive
+group of functions. Each time an inlining of such a call is performed
+the depth is incremented by one when examining the resulting body. If the
+depth reaches the limit set by {\tt -inline-max-unroll} then speculation
+stops.
+
+\section{s:flambda-specialisation}{Specialisation}
+
+The inliner may discover a call site to a recursive function where
+something is known about the arguments: for example, they may be equal to
+some other variables currently in scope. In this situation it may be
+beneficial to {\em specialise} the function to those arguments. This is
+done by copying the declaration of the function (and any others involved
+in any same mutually-recursive declaration) and noting the extra information
+about the arguments. The arguments augmented by this information are known
+as {\em specialised arguments}. In order to try to ensure that specialisation
+is not performed uselessly, arguments are only specialised if it can be shown
+that they are {\em invariant}: in other words, during the execution of the
+recursive function(s) themselves, the arguments never change.
+
+Unless overridden by an attribute (see below), specialisation of a function
+will not be attempted if:
+\begin{itemize}
+\item the compiler is in {\tt -Oclassic} mode;
+\item the function is not obviously recursive;
+\item the function is not closed.
+\end{itemize}
+
+The compiler can prove invariance of function arguments across multiple
+functions within a recursive group (although this has some limitations,
+as shown by the example below).
+
+It should be noted that the {\em unboxing of closures} pass (see below)
+can introduce specialised arguments on non-recursive functions. (No other
+place in the compiler currently does this.)
+
+\paragraph{Example: the well-known {\tt List.iter} function}
+This function might be written like so:
+\begin{verbatim}
+let rec iter f l =
+ match l with
+ | [] -> ()
+ | h :: t ->
+ f h;
+ iter f t
+\end{verbatim}
+and used like this:
+\begin{verbatim}
+let print_int x =
+ print_endline (Int.to_string x)
+
+let run xs =
+ iter print_int (List.rev xs)
+\end{verbatim}
+The argument {\tt f} to {\tt iter} is invariant so the function may be
+specialised:
+\begin{verbatim}
+let run xs =
+ let rec iter' f l =
+ (* The compiler knows: f holds the same value as foo throughout iter'. *)
+ match l with
+ | [] -> ()
+ | h :: t ->
+ f h;
+ iter' f t
+ in
+ iter' print_int (List.rev xs)
+\end{verbatim}
+The compiler notes down that for the function {\tt iter'}, the argument
+{\tt f} is specialised to the constant closure {\tt print\_int}. This
+means that the body of {\tt iter'} may be simplified:
+\begin{verbatim}
+let run xs =
+ let rec iter' f l =
+ (* The compiler knows: f holds the same value as foo throughout iter'. *)
+ match l with
+ | [] -> ()
+ | h :: t ->
+ print_int h; (* this is now a direct call *)
+ iter' f t
+ in
+ iter' print_int (List.rev xs)
+\end{verbatim}
+The call to {\tt print\_int} can indeed be inlined:
+\begin{verbatim}
+let run xs =
+ let rec iter' f l =
+ (* The compiler knows: f holds the same value as foo throughout iter'. *)
+ match l with
+ | [] -> ()
+ | h :: t ->
+ print_endline (Int.to_string h);
+ iter' f t
+ in
+ iter' print_int (List.rev xs)
+\end{verbatim}
+The unused specialised argument {\tt f} may now be removed, leaving:
+\begin{verbatim}
+let run xs =
+ let rec iter' l =
+ match l with
+ | [] -> ()
+ | h :: t ->
+ print_endline (Int.to_string h);
+ iter' t
+ in
+ iter' (List.rev xs)
+\end{verbatim}
+
+\paragraph{Aside on invariant parameters.} The compiler cannot currently
+detect invariance in cases such as the following.
+\begin{verbatim}
+let rec iter_swap f g l =
+ match l with
+ | [] -> ()
+ | 0 :: t ->
+ iter_swap g f l
+ | h :: t ->
+ f h;
+ iter_swap f g t
+\end{verbatim}
+
+\subsection{ss:flambda-assessment-specialisation}{Assessment of specialisation benefit}
+
+The benefit of specialisation is assessed in a similar way as for inlining.
+Specialised argument information may mean that the body of the function
+being specialised can be simplified: the removed operations are accumulated
+into a benefit. This, together with the size of the duplicated (specialised)
+function declaration, is then assessed against the size of the call to the
+original function.
+
+\section{s:flambda-defaults}{Default settings of parameters}
+
+The default settings (when not using {\tt -Oclassic}) are for one
+round of optimisation using the following parameters.
+% CR-soon mshinwell: for 4.04, let's autogenerate these.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{10}
+\entree{{\tt -inline-branch-factor}}{0.1}
+\entree{{\tt -inline-alloc-cost}}{7}
+\entree{{\tt -inline-branch-cost}}{5}
+\entree{{\tt -inline-call-cost}}{5}
+\entree{{\tt -inline-indirect-cost}}{4}
+\entree{{\tt -inline-prim-cost}}{3}
+\entree{{\tt -inline-lifting-benefit}}{1300}
+\entree{{\tt -inline-toplevel}}{160}
+\entree{{\tt -inline-max-depth}}{1}
+\entree{{\tt -inline-max-unroll}}{0}
+\entree{{\tt -unbox-closures-factor}}{10}
+\end{tableau}
+
+\subsection{ss:flambda-o2}{Settings at -O2 optimisation level}
+
+When {\tt -O2} is specified two rounds of optimisation are performed.
+The first round uses the default parameters (see above). The second uses
+the following parameters.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{25}
+\entree{{\tt -inline-branch-factor}}{Same as default}
+\entree{{\tt -inline-alloc-cost}}{Double the default}
+\entree{{\tt -inline-branch-cost}}{Double the default}
+\entree{{\tt -inline-call-cost}}{Double the default}
+\entree{{\tt -inline-indirect-cost}}{Double the default}
+\entree{{\tt -inline-prim-cost}}{Double the default}
+\entree{{\tt -inline-lifting-benefit}}{Same as default}
+\entree{{\tt -inline-toplevel}}{400}
+\entree{{\tt -inline-max-depth}}{2}
+\entree{{\tt -inline-max-unroll}}{Same as default}
+\entree{{\tt -unbox-closures-factor}}{Same as default}
+\end{tableau}
+
+\subsection{ss:flambda-o3}{Settings at -O3 optimisation level}
+
+When {\tt -O3} is specified three rounds of optimisation are performed.
+The first two rounds are as for {\tt -O2}. The third round uses
+the following parameters.
+
+\begin{tableau}{|l|l|}{Parameter}{Setting}
+\entree{{\tt -inline}}{50}
+\entree{{\tt -inline-branch-factor}}{Same as default}
+\entree{{\tt -inline-alloc-cost}}{Triple the default}
+\entree{{\tt -inline-branch-cost}}{Triple the default}
+\entree{{\tt -inline-call-cost}}{Triple the default}
+\entree{{\tt -inline-indirect-cost}}{Triple the default}
+\entree{{\tt -inline-prim-cost}}{Triple the default}
+\entree{{\tt -inline-lifting-benefit}}{Same as default}
+\entree{{\tt -inline-toplevel}}{800}
+\entree{{\tt -inline-max-depth}}{3}
+\entree{{\tt -inline-max-unroll}}{1}
+\entree{{\tt -unbox-closures-factor}}{Same as default}
+\end{tableau}
+
+\section{s:flambda-manual-control}{Manual control of inlining and specialisation}
+
+Should the inliner prove recalcitrant and refuse to inline a particular
+function, or if the observed inlining decisions are not to the programmer's
+satisfaction for some other reason, inlining behaviour can be dictated by the
+programmer directly in the source code.
+One example where this might be appropriate is when the programmer,
+but not the compiler, knows that a particular function call is on a cold
+code path. It might be desirable to prevent inlining of the function so
+that the code size along the hot path is kept smaller, so as to increase
+locality.
+
+The inliner is directed using attributes.
+For non-recursive functions (and one-step unrolling of recursive functions,
+although {\tt \@unroll} is more clear for this purpose)
+the following are supported:
+\begin{options}
+\item[{\machine{\@\@inline always}} or {\machine{\@\@inline never}}] Attached
+to a {\em declaration} of a function or functor, these direct the inliner to
+either
+always or never inline, irrespective of the size/benefit calculation. (If
+the function is recursive then the body is substituted and no special
+action is taken for the recursive call site(s).)
+{\machine{\@\@inline}} with no argument is equivalent to
+{\machine{\@\@inline always}}.
+\item[{\machine{\@inlined always}} or {\machine{\@inlined never}}] Attached
+to a function {\em application}, these direct the inliner likewise. These
+attributes at call sites override any other attribute that may be present
+on the corresponding declaration.
+{\machine{\@inlined}} with no argument is equivalent to
+{\machine{\@inlined always}}. {\machine{\@\@inlined hint}} is equivalent to
+{\machine{\@\@inline always}} except that it will not trigger warning 55 if
+the function application cannot be inlined.
+\end{options}
+
+For recursive functions the relevant attributes are:
+\begin{options}
+\item[{\machine{\@\@specialise always}} or {\machine{\@\@specialise never}}]%
+Attached to a declaration of a function
+or functor, this directs the inliner to either always or never
+specialise the function so
+long as it has appropriate contextual knowledge, irrespective of the
+size/benefit calculation.
+{\machine{\@\@specialise}} with no argument is equivalent to
+{\machine{\@\@specialise always}}.
+\item[{\machine{\@specialised always}} or {\machine{\@specialised never}}]%
+Attached to a function application, this
+directs the inliner likewise. This attribute at a call site overrides any
+other attribute that may be present on the corresponding declaration.
+(Note that the function will still only be specialised if there exist
+one or more invariant parameters whose values are known.)
+{\machine{\@specialised}} with no argument is equivalent to
+{\machine{\@specialised always}}.
+\item[{\machine{\@unrolled }}$n$] This attribute is attached to a function
+application and always takes an integer argument. Each time the inliner sees
+the attribute it behaves as follows:
+\begin{itemize}
+\item If $n$ is zero or less, nothing happens.
+\item Otherwise the function being called is substituted at the call site
+with its body having been rewritten such that
+any recursive calls to that function {\em or
+any others in the same mutually-recursive group} are annotated with the
+attribute {\tt unrolled(}$n - 1${\tt )}. Inlining may continue on that body.
+\end{itemize}
+As such, $n$ behaves as the ``maximum depth of unrolling''.
+\end{options}
+
+A compiler warning will be emitted if it was found impossible to obey an
+annotation from an {\tt \@inlined} or {\tt \@specialised} attribute.
+
+\paragraph{Example showing correct placement of attributes}
+\begin{verbatim}
+module F (M : sig type t end) = struct
+ let[@inline never] bar x =
+ x * 3
+
+ let foo x =
+ (bar [@inlined]) (42 + x)
+end [@@inline never]
+
+module X = F [@inlined] (struct type t = int end)
+\end{verbatim}
+
+\section{s:flambda-simplification}{Simplification}
+
+Simplification, which is run in conjunction with inlining,
+propagates information (known as {\em approximations}) about which
+variables hold what values at runtime. Certain relationships between
+variables and symbols are also tracked: for example, some variable may be
+known to always hold the same value as some other variable; or perhaps
+some variable may be known to always hold the value pointed to by some
+symbol.
+
+The propagation can help to eliminate allocations in cases such as:
+\begin{verbatim}
+let f x y =
+ ...
+ let p = x, y in
+ ...
+ ... (fst p) ... (snd p) ...
+\end{verbatim}
+The projections from {\tt p} may be replaced by uses of the variables
+{\tt x} and {\tt y}, potentially meaning that {\tt p} becomes unused.
+
+The propagation performed by the simplification pass is also important for
+discovering which functions flow to indirect call sites. This can enable
+the transformation of such call sites into direct call sites, which makes
+them eligible for an inlining transformation.
+
+Note that no information is propagated about the contents of strings,
+even in {\tt safe-string} mode, because it cannot yet be guaranteed
+that they are immutable throughout a given program.
+
+\section{s:flambda-other-transfs}{Other code motion transformations}
+
+\subsection{ss:flambda-lift-const}{Lifting of constants}
+
+Expressions found to be constant will be lifted to symbol
+bindings---that is to say, they will be statically allocated in the
+object file---when
+they evaluate to boxed values. Such constants may be straightforward numeric
+constants, such as the floating-point number {\tt 42.0}, or more complicated
+values such as constant closures.
+
+Lifting of constants to toplevel reduces allocation at runtime.
+
+The compiler aims to share constants lifted to toplevel such that there
+are no duplicate definitions. However if {\tt .cmx} files are hidden
+from the compiler then maximal sharing may not be possible.
+
+\paragraph{Notes about float arrays} %
+The following language semantics apply specifically to constant float arrays.
+(By ``constant float array'' is meant an array consisting entirely of floating
+point numbers that are known at compile time. A common case is a literal
+such as {\tt [| 42.0; 43.0; |]}.
+\begin{itemize}
+\item Constant float arrays at the toplevel are mutable and never shared.
+(That is to say, for each
+such definition there is a distinct symbol in the data section of the object
+file pointing at the array.)
+\item Constant float arrays not at toplevel are mutable and are created each
+time the expression is evaluated. This can be thought of as an operation that
+takes an immutable array (which in the source code has no associated name; let
+us call it the {\em initialising array}) and
+duplicates it into a fresh mutable array.
+\begin{itemize}
+\item If the array is of size four or less, the expression will create a
+fresh block and write the values into it one by one. There is no reference
+to the initialising array as a whole.
+
+\item Otherwise, the initialising array is lifted out and subject to the
+normal constant sharing procedure;
+creation of the array consists of bulk copying the initialising array
+into a fresh value on the OCaml heap.
+\end{itemize}
+\end{itemize}
+
+\subsection{ss:flambda-lift-toplevel-let}{Lifting of toplevel let bindings}
+
+Toplevel {\tt let}-expressions may be lifted to symbol bindings to ensure
+that the corresponding bound variables are not captured by closures. If the
+defining expression of a given binding is found to be constant, it is bound
+as such (the technical term is a {\em let-symbol} binding).
+
+Otherwise, the symbol is bound to a (statically-allocated)
+{\em preallocated block} containing one field. At runtime, the defining
+expression will be evaluated and the first field of the block filled with
+the resulting value. This {\em initialise-symbol} binding
+causes one extra indirection but ensures, by
+virtue of the symbol's address being known at compile time, that uses of the
+value are not captured by closures.
+
+It should be noted that the blocks corresponding to initialise-symbol
+bindings are kept alive forever, by virtue of them occurring in a static
+table of GC roots within the object file. This extended lifetime of
+expressions may on occasion be surprising. If it is desired to create
+some non-constant value (for example when writing GC tests) that does not
+have this
+extended lifetime, then it may be created and used inside a function,
+with the application point of that function (perhaps at toplevel)---or
+indeed the function declaration itself---marked
+as to never be inlined. This technique prevents lifting of the definition
+of the value in question (assuming of course that it is not constant).
+
+\section{s:flambda-unboxing}{Unboxing transformations}
+
+The transformations in this section relate to the splitting apart of
+{\em boxed} (that is to say, non-immediate) values. They are largely
+intended to reduce allocation, which tends to result in a runtime
+performance profile with lower variance and smaller tails.
+
+\subsection{ss:flambda-unbox-fvs}{Unboxing of closure variables}
+
+This transformation is enabled unless
+{\tt -no-unbox-free-vars-of-closures} is provided.
+
+Variables that appear in closure environments may themselves be boxed
+values. As such, they may be split into further closure variables, each
+of which corresponds to some projection from the original closure variable(s).
+This transformation is called {\em unboxing of closure variables} or
+{\em unboxing of free variables of closures}. It is only applied when
+there is
+reasonable certainty that there are no uses of the boxed free variable itself
+within the corresponding function bodies.
+% CR-someday mshinwell: Actually, we probably don't check this carefully
+% enough. It needs a global analysis in case there is an out-of-scope
+% projection.
+
+\paragraph{Example:} In the following code, the compiler observes that
+the closure returned from the function {\tt f} contains a variable {\tt pair}
+(free in the body of {\tt f}) that may be split into two separate variables.
+\begin{verbatim}
+let f x0 x1 =
+ let pair = x0, x1 in
+ Printf.printf "foo\n";
+ fun y ->
+ fst pair + snd pair + y
+\end{verbatim}
+After some simplification one obtains:
+\begin{verbatim}
+let f x0 x1 =
+ let pair_0 = x0 in
+ let pair_1 = x1 in
+ Printf.printf "foo\n";
+ fun y ->
+ pair_0 + pair_1 + y
+\end{verbatim}
+and then:
+\begin{verbatim}
+let f x0 x1 =
+ Printf.printf "foo\n";
+ fun y ->
+ x0 + x1 + y
+\end{verbatim}
+The allocation of the pair has been eliminated.
+
+This transformation does not operate if it would cause the closure to
+contain more than twice as many closure variables as it did beforehand.
+
+\subsection{ss:flambda-unbox-spec-args}{Unboxing of specialised arguments}
+
+This transformation is enabled unless
+{\tt -no-unbox-specialised-args} is provided.
+
+It may become the case during compilation that one or more invariant arguments
+to a function become specialised to a particular value. When such values are
+themselves boxed the corresponding specialised arguments may be split into
+more specialised arguments corresponding to the projections out of the boxed
+value that occur within the function body. This transformation is called
+{\em unboxing of specialised arguments}. It is only applied when there is
+reasonable certainty that the boxed argument itself is unused within the
+function.
+
+If the function in question is involved in a recursive group then unboxing
+of specialised arguments may be immediately replicated across the group
+based on the dataflow between invariant arguments.
+
+\paragraph{Example:} Having been given the following code, the compiler
+will inline {\tt loop} into {\tt f}, and then observe {\tt inv}
+being invariant and always the pair formed by adding {\tt 42} and {\tt 43}
+to the argument {\tt x} of the function {\tt f}.
+\begin{verbatim}
+let rec loop inv xs =
+ match xs with
+ | [] -> fst inv + snd inv
+ | x::xs -> x + loop2 xs inv
+and loop2 ys inv =
+ match ys with
+ | [] -> 4
+ | y::ys -> y - loop inv ys
+
+let f x =
+ Printf.printf "%d\n" (loop (x + 42, x + 43) [1; 2; 3])
+\end{verbatim}
+Since the functions have sufficiently few arguments, more specialised
+arguments will be added. After some simplification one obtains:
+\begin{verbatim}
+let f x =
+ let rec loop' xs inv_0 inv_1 =
+ match xs with
+ | [] -> inv_0 + inv_1
+ | x::xs -> x + loop2' xs inv_0 inv_1
+ and loop2' ys inv_0 inv_1 =
+ match ys with
+ | [] -> 4
+ | y::ys -> y - loop' ys inv_0 inv_1
+ in
+ Printf.printf "%d\n" (loop' [1; 2; 3] (x + 42) (x + 43))
+\end{verbatim}
+The allocation of the pair within {\tt f} has been removed. (Since the
+two closures for {\tt loop'} and {\tt loop2'} are constant they will also be
+lifted to toplevel with no runtime allocation penalty. This
+would also happen without having run the transformation to unbox
+specialise arguments.)
+
+The transformation to unbox specialised arguments never introduces extra
+allocation.
+
+The transformation will not unbox arguments if it would result in the
+original function having sufficiently many arguments so as to inhibit
+tail-call optimisation.
+
+The transformation is implemented by creating a wrapper function that
+accepts the original arguments. Meanwhile, the original function is renamed
+and extra arguments are added corresponding to the unboxed specialised
+arguments; this new function
+is called from the wrapper. The wrapper will then be inlined
+at direct call sites. Indeed, all call sites will be direct unless
+{\tt -unbox-closures} is being used, since they will have been generated
+by the compiler when originally specialising the function. (In the case
+of {\tt -unbox-closures} other functions may appear with specialised
+arguments; in this case there may be indirect calls and these will incur
+a small penalty owing to having to bounce through the wrapper. The technique
+of {\em direct call surrogates} used for {\tt -unbox-closures} is not
+used by the transformation to unbox specialised arguments.)
+
+\subsection{ss:flambda-unbox-closures}{Unboxing of closures}
+
+This transformation is {\em not} enabled by default. It may be enabled
+using the {\tt -unbox-closures} flag.
+
+The transformation replaces closure variables by specialised arguments.
+The aim is to cause more closures to become closed. It is particularly
+applicable, as a means of reducing allocation, where the function concerned
+cannot be inlined or specialised. For example, some non-recursive function
+might be too large to inline; or some recursive function might offer
+no opportunities for specialisation perhaps because its only argument is
+one of type {\tt unit}.
+
+At present there may be a small penalty in terms of actual runtime
+performance when this transformation is enabled, although more stable
+performance may be obtained due to reduced allocation. It is recommended
+that developers experiment to determine whether the option is beneficial
+for their code. (It is expected that in the future it will be possible
+for the performance degradation to be removed.)
+
+\paragraph{Simple example:} In the following code (which might typically
+occur when {\tt g} is too large to inline) the value of {\tt x} would usually
+be communicated to the application of the {\tt +} function via the closure
+of {\tt g}.
+\begin{verbatim}
+let f x =
+ let g y =
+ x + y
+ in
+ (g [@inlined never]) 42
+\end{verbatim}
+Unboxing of the closure causes the value for {\tt x} inside {\tt g} to
+be passed as an argument to {\tt g} rather than through its closure. This
+means that the closure of {\tt g} becomes constant and may be lifted to
+toplevel, eliminating the runtime allocation.
+
+The transformation is implemented by adding a new wrapper function in the
+manner of that used when unboxing specialised arguments. The closure
+variables are still free in the wrapper, but the intention is that when
+the wrapper is inlined at direct call sites, the relevant values are
+passed directly to the main function via the new specialised arguments.
+
+Adding such a wrapper will penalise indirect calls to the function
+(which might exist in arbitrary places; remember that this transformation
+is not for example applied only on functions the compiler has produced
+as a result of specialisation) since such calls will bounce through
+the wrapper. To
+mitigate this, if a function is small enough when weighed up against
+the number of free variables being removed, it will be duplicated by the
+transformation to obtain two versions: the original (used for indirect calls,
+since we can do no better) and the wrapper/rewritten function pair as
+described in the previous paragraph. The wrapper/rewritten function pair
+will only be used at direct call sites of the function. (The wrapper in
+this case is known as a {\em direct call surrogate}, since
+it takes the place of another function---the unchanged version used for
+indirect calls---at direct call sites.)
+
+The {\tt -unbox-closures-factor} command line flag, which takes an
+integer, may be used to adjust the point at which a function is deemed
+large enough to be ineligible for duplication. The benefit of
+duplication is scaled by the integer before being evaluated against the
+size.
+
+\paragraph{Harder example:} In the following code, there are two closure
+variables that would typically cause closure allocations. One is called
+{\tt fv} and occurs inside the function {\tt baz}; the other is called
+{\tt z} and occurs inside the function {\tt bar}.
+In this toy (yet sophisticated) example we again use an attribute to
+simulate the typical situation where the first argument of {\tt baz} is
+too large to inline.
+\begin{verbatim}
+let foo c =
+ let rec bar zs fv =
+ match zs with
+ | [] -> []
+ | z::zs ->
+ let rec baz f = function
+ | [] -> []
+ | a::l -> let r = fv + ((f [@inlined never]) a) in r :: baz f l
+ in
+ (map2 (fun y -> z + y) [z; 2; 3; 4]) @ bar zs fv
+ in
+ Printf.printf "%d" (List.length (bar [1; 2; 3; 4] c))
+\end{verbatim}
+The code resulting from applying {\tt -O3 -unbox-closures} to this code
+passes the free variables via function arguments in
+order to eliminate all closure allocation in this example (aside from any
+that might be performed inside {\tt printf}).
+
+\section{s:flambda-remove-unused}{Removal of unused code and values}
+
+\subsection{ss:flambda-redundant-let}{Removal of redundant let expressions}
+
+The simplification pass removes unused {\tt let} bindings so long as
+their corresponding defining expressions have ``no effects''. See
+the section ``Treatment of effects'' below for the precise definition of
+this term.
+
+\subsection{ss:flambda-redundant}{Removal of redundant program constructs}
+
+This transformation is analogous to the removal of {\tt let}-expressions
+whose defining expressions have no effects. It operates instead on symbol
+bindings, removing those that have no effects.
+
+\subsection{ss:flambda-remove-unused-args}{Removal of unused arguments}
+
+This transformation is only enabled by default for specialised arguments.
+It may be enabled for all arguments using the {\tt -remove-unused-arguments}
+flag.
+
+The pass analyses functions to determine which arguments are unused.
+Removal is effected by creating a wrapper function, which will be inlined
+at every direct call site, that accepts the original arguments and then
+discards the unused ones before calling the original function. As a
+consequence, this transformation may be detrimental if the original
+function is usually indirectly called, since such calls will now bounce
+through the wrapper. (The technique of {\em direct call surrogates} used
+to reduce this penalty during unboxing of closure variables (see above)
+does not yet apply to the pass that removes unused arguments.)
+
+\subsection{ss:flambda-removal-closure-vars}{Removal of unused closure variables}
+
+This transformation performs an analysis across
+the whole compilation unit to determine whether there exist closure variables
+that are never used. Such closure variables are then eliminated. (Note that
+this has to be a whole-unit analysis because a projection of a closure
+variable from some particular closure may have propagated to an arbitrary
+location within the code due to inlining.)
+
+\section{s:flambda-other}{Other code transformations}
+
+\subsection{ss:flambda-non-escaping-refs}{Transformation of non-escaping references into mutable variables}
+
+Flambda performs a simple analysis analogous to that performed elsewhere
+in the compiler that can transform {\tt ref}s into mutable variables
+that may then be held in registers (or on the stack as appropriate) rather
+than being allocated on the OCaml heap. This only happens so long as the
+reference concerned can be shown to not escape from its defining scope.
+
+\subsection{ss:flambda-subst-closure-vars}{Substitution of closure variables for specialised arguments}
+
+This transformation discovers closure variables that are known to be
+equal to specialised arguments. Such closure variables are replaced by
+the specialised arguments; the closure variables may then be removed by
+the ``removal of unused closure variables'' pass (see below).
+
+\section{s:flambda-effects}{Treatment of effects}
+
+The Flambda optimisers classify expressions in order to determine whether
+an expression:
+\begin{itemize}
+\item does not need to be evaluated at all; and/or
+\item may be duplicated.
+\end{itemize}
+
+This is done by forming judgements on the {\em effects} and the {\em coeffects}
+that might be performed were the expression to be executed. Effects talk
+about how the expression might affect the world; coeffects talk about how
+the world might affect the expression.
+
+Effects are classified as follows:
+\begin{options}
+\item[{\bf No effects:}] The expression does not change the observable state
+of the world. For example, it must not write to any mutable storage,
+call arbitrary external functions or change control flow (e.g. by raising
+an exception). Note that allocation is {\em not} classed as having
+``no effects'' (see below).
+\begin{itemize}
+\item It is assumed in the compiler that expressions with no
+effects, whose results are not used, may be eliminated. (This typically
+happens where the expression in question is the defining expression of a
+{\tt let}; in such cases the {\tt let}-expression will be
+eliminated.) It is further
+assumed that such expressions with no effects may be
+duplicated (and thus possibly executed more than once).
+\item Exceptions arising from allocation points, for example
+``out of memory'' or
+exceptions propagated from finalizers or signal handlers, are treated as
+``effects out of the ether'' and thus ignored for our determination here
+of effectfulness. The same goes for floating point operations that may
+cause hardware traps on some platforms.
+\end{itemize}
+\item[{\bf Only generative effects:}] The expression does not change the
+observable state of the world save for possibly affecting the state of
+the garbage collector by performing an allocation. Expressions
+that only have generative effects and whose results are unused
+may be eliminated by the compiler. However, unlike expressions with
+``no effects'', such expressions will never be eligible for duplication.
+\item[{\bf Arbitrary effects:}] All other expressions.
+\end{options}
+
+There is a single classification for coeffects:
+\begin{options}
+\item[{\bf No coeffects:}] The expression does not observe the effects (in
+the sense described above) of other expressions. For example, it must not
+read from any mutable storage or call arbitrary external functions.
+\end{options}
+
+It is assumed in the compiler that, subject to data dependencies,
+expressions with neither effects nor coeffects may be reordered with
+respect to other expressions.
+
+\section{s:flambda-static-modules}{Compilation of statically-allocated modules}
+
+Compilation of modules that are able to be statically allocated (for example,
+the module corresponding to an entire compilation unit, as opposed to a first
+class module dependent on values computed at runtime) initially follows the
+strategy used for bytecode. A sequence of {\tt let}-bindings, which may be
+interspersed with arbitrary effects, surrounds a record creation that becomes
+the module block. The Flambda-specific transformation follows: these bindings
+are lifted to toplevel symbols, as described above.
+
+\section{s:flambda-inhibition}{Inhibition of optimisation}
+
+Especially when writing benchmarking suites that run non-side-effecting
+algorithms in loops, it may be found that the optimiser entirely
+elides the code being benchmarked. This behaviour can be prevented by
+using the {\tt Sys.opaque\_identity} function (which indeed behaves as a
+normal OCaml function and does not possess any ``magic'' semantics). The
+documentation of the {\tt Sys} module should be consulted for further details.
+
+\section{s:flambda-unsafe}{Use of unsafe operations}
+
+The behaviour of the Flambda simplification pass means that certain unsafe
+operations, which may without Flambda or when using previous versions of
+the compiler be safe, must not be used. This specifically refers to
+functions found in the {\tt Obj} module.
+
+In particular, it is forbidden to change any value (for example using
+{\tt Obj.set\_field} or {\tt Obj.set\_tag}) that is not mutable.
+(Values returned from C stubs
+are always treated as mutable.) The compiler will emit warning 59 if it
+detects such a write---but it cannot warn in all cases. Here is an example
+of code that will trigger the warning:
+\begin{verbatim}
+let f x =
+ let a = 42, x in
+ (Obj.magic a : int ref) := 1;
+ fst a
+\end{verbatim}
+The reason this is unsafe is because the simplification pass believes that
+{\tt fst a} holds the value {\tt 42}; and indeed it must, unless type
+soundness has been broken via unsafe operations.
+
+If it must be the case that code has to be written that triggers warning 59,
+but the code is known to actually be correct (for some definition of
+correct), then {\tt Sys.opaque\_identity} may be used to wrap the value
+before unsafe operations are performed upon it. Great care must be taken
+when doing this to ensure that the opacity is added at the correct place.
+It must be emphasised that this use of {\tt Sys.opaque\_identity} is only
+for {\bf exceptional} cases. It should not be used in normal code or to
+try to guide the optimiser.
+
+As an example, this code will return the integer {\tt 1}:
+\begin{verbatim}
+let f x =
+ let a = Sys.opaque_identity (42, x) in
+ (Obj.magic a : int ref) := 1;
+ fst a
+\end{verbatim}
+However the following code will still return {\tt 42}:
+\begin{verbatim}
+let f x =
+ let a = 42, x in
+ Sys.opaque_identity (Obj.magic a : int ref) := 1;
+ fst a
+\end{verbatim}
+
+High levels of inlining performed by Flambda may expose bugs in code
+thought previously to be correct. Take care, for example, not
+to add type annotations that claim some mutable value is always immediate
+if it might be possible for an unsafe operation to update it to a boxed
+value.
+
+\section{s:flambda-glossary}{Glossary}
+
+The following terminology is used in this chapter of the manual.
+
+\begin{options}
+\item[{\bf Call site}] See {\em direct call site} and %
+{\em indirect call site} below.
+\item[{\bf Closed function}] A function whose body has no free variables
+except its parameters and any to which are bound other functions within
+the same (possibly mutually-recursive) declaration.
+\item[{\bf Closure}] The runtime representation of a function. This
+includes pointers to the code of the function
+together with the values of any variables that are used in the body of
+the function but actually defined outside of the function, in the
+enclosing scope.
+The values of such variables, collectively known as the
+{\em environment}, are required because the function may be
+invoked from a place where the original bindings of such variables are
+no longer in scope. A group of possibly
+mutually-recursive functions defined using {\em let rec} all share a
+single closure. (Note to developers: in the Flambda source code a
+{\em closure} always corresponds to a single function; a
+{\em set of closures} refers to a group of such.)
+\item[{\bf Closure variable}] A member of the environment held within the
+closure of a given function.
+\item[{\bf Constant}] Some entity (typically an expression) the value of which
+is known by the compiler at compile time. Constantness may be explicit from
+the source code or inferred by the Flambda optimisers.
+\item[{\bf Constant closure}] A closure that is statically allocated in an
+object file. It is almost always the case that the environment portion of
+such a closure is empty.
+\item[{\bf Defining expression}] The expression {\tt e} in %
+{\tt let x = e in e'}.
+\item[{\bf Direct call site}] A place in a program's code where a function is
+called and it is known at compile time which function it will always be.
+\item[{\bf Indirect call site}] A place in a program's code where a function
+is called but is not known to be a {\em direct call site}.
+\item[{\bf Program}] A collection of {\em symbol bindings} forming the
+definition of a single compilation unit (i.e. {\tt .cmx} file).
+\item[{\bf Specialised argument}] An argument to a function that is known
+to always hold a particular value at runtime. These are introduced by the
+inliner when specialising recursive functions; and the {\tt unbox-closures}
+pass. (See section\ \ref{s:flambda-specialisation}.)
+\item[{\bf Symbol}] A name referencing a particular place in an object file
+or executable image. At that particular place will be some constant value.
+Symbols may be examined using operating system-specific tools (for
+example {\tt objdump} on Linux).
+\item[{\bf Symbol binding}] Analogous to a {\tt let}-expression but working
+at the level of symbols defined in the object file. The address of a symbol is
+fixed, but it may be bound to both constant and non-constant expressions.
+\item[{\bf Toplevel}] An expression in the current program which is not
+enclosed within any function declaration.
+\item[{\bf Variable}] A named entity to which some OCaml value is bound by a
+{\tt let} expression, pattern-matching construction, or similar.
+\end{options}
--- /dev/null
+\chapter{Runtime tracing with the instrumented runtime}
+%HEVEA\cutname{instrumented-runtime.html}
+
+This chapter describes the OCaml instrumented runtime, a runtime variant
+allowing the collection of events and metrics.
+
+Collected metrics include time spent executing the {\em garbage collector}.
+The overall execution time of individual pauses are measured
+down to the time spent in specific parts of the garbage collection.
+Insight is also given on memory allocation and motion by recording
+the size of allocated memory blocks, as well as value promotions from the
+{\em minor heap} to the {\em major heap}.
+
+\section{s:instr-runtime-overview}{Overview}
+
+Once compiled and linked with the instrumented runtime, any OCaml program
+can generate {\em trace files} that can then be read
+and analyzed by users in order to understand specific runtime behaviors.
+
+The generated trace files are stored using the {\em Common Trace Format}, which
+is a general purpose binary tracing format.
+A complete trace consists of:
+\begin{itemize}
+\item a {\em metadata file}, part of the OCaml distribution
+\item and a {\em trace file}, generated by the runtime\
+ in the program being traced.
+\end{itemize}
+
+For more information on the {\em Common Trace Format}, see
+\href{https://diamon.org/ctf/}{https://diamon.org/ctf/}.
+
+\section{s:instr-runtime-enabling}{Enabling runtime instrumentation}
+
+
+For the following examples, we will use the following example program:
+
+\begin{caml_example*}{verbatim}
+module SMap = Map.Make(String)
+
+let s i = String.make 512 (Char.chr (i mod 256))
+
+let clear map = SMap.fold (fun k _ m -> SMap.remove k m) map map
+
+let rec seq i =
+ if i = 0 then Seq.empty else fun () -> (Seq.Cons (i, seq (i - 1)))
+
+let () =
+ seq 1_000_000
+ |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
+ |> clear
+ |> ignore
+\end{caml_example*}
+
+The next step is to compile and link the program with the instrumented runtime.
+This can be done by using the "-runtime-variant" flag:
+
+\begin{verbatim}
+ ocamlopt -runtime-variant i program.ml -o program
+\end{verbatim}
+
+Note that the instrumented runtime is an alternative runtime for OCaml
+programs. It is only referenced during the linking stage of the final
+executable. This means that the compilation stage does not need to be altered
+to enable instrumentation.
+
+The resulting program can then be traced by running it with the environment
+variable "OCAML_EVENTLOG_ENABLED":
+
+\begin{verbatim}
+ OCAML_EVENTLOG_ENABLED=1 ./program
+\end{verbatim}
+
+During execution, a trace file will be generated in the
+program's current working directory.
+
+\subsubsection*{sss:instr-runtime-build-more}{More build examples}
+
+When using the {\em dune} build system, this compiler invocation can be
+replicated using the {\tt flags} {\tt stanza} when building an executable.
+
+\begin{verbatim}
+ (executable
+ (name program)
+ (flags "-runtime-variant=i"))
+\end{verbatim}
+
+The instrumented runtime can also be used with the OCaml bytecode interpreter.
+This can be done by either using the
+"-runtime-variant=i" flag when linking the program with {\tt ocamlc}, or by running the generated
+bytecode through {\tt ocamlruni}:
+
+\begin{verbatim}
+ ocamlc program.ml -o program.byte
+ OCAML_EVENTLOG_ENABLED=1 ocamlruni program.byte
+\end{verbatim}
+
+See chapter~\ref{c:camlc} and chapter~\ref{c:runtime} for more information about
+{\tt ocamlc} and {\tt ocamlrun}.
+
+\section{s:instr-runtime-read}{Reading traces}
+
+Traces generated by the instrumented runtime can be analyzed with tooling
+available outside of the OCaml distribution.
+
+A complete trace consists of a {\em metadata file} and a {\em trace file}.
+Two simple ways to work with the traces are the {\em eventlog-tools} and
+{\em babeltrace} libraries.
+
+\subsection{ss:instr-runtime-tools}{eventlog-tools}
+{\em eventlog-tools} is a library implementing a parser, as well as a
+a set of tools that allows to perform basic format conversions and analysis.
+
+For more information about {\em eventlog-tools}, refer to the project's
+main page: \href{https://github.com/ocaml-multicore/eventlog-tools}{https://github.com/ocaml-multicore/eventlog-tools}
+
+\subsection{ss:instr-runtime-babeltrace}{babeltrace}
+
+{\em babeltrace} is a C library, as well as a Python binding and set of tools
+that serve as the reference implementation for the {\em Common Trace Format}.
+The {\em babeltrace} command line utility allows for a basic rendering
+of a trace's content, while the high level Python API can be used to
+decode the trace and process them programmatically with libraries
+such as {\em numpy} or {\em Jupyter}.
+
+Unlike {\em eventlog-tools}, which possesses a specific knowledge of
+OCaml's {\em Common Trace Format} schema, it is required to provide
+the OCaml {\em metadata} file to {\em babeltrace}.
+
+The metadata file is available in the OCaml installation.
+Its location can be obtained using the following command:
+
+\begin{verbatim}
+ ocamlc -where
+\end{verbatim}
+
+The {\em eventlog_metadata} file can be found at this path and
+copied in the same directory as the generated trace file.
+However, {\em babeltrace} expects the file to be named
+{\tt metadata} in order to process the trace.
+Thus, it will need to be renamed when copied to the trace's directory.
+
+Here is a naive decoder example, using {\em babeltrace}'s Python
+library, and {\em Python 3.8}:
+
+\begin{verbatim}
+
+import subprocess
+import shutil
+import sys
+import babeltrace as bt
+
+def print_event(ev):
+ print(ev['timestamp'])
+ print(ev['pid'])
+ if ev.name == "entry":
+ print('entry_event')
+ print(ev['phase'])
+ if ev.name == "exit":
+ print('exit_event')
+ print(ev['phase'])
+ if ev.name == "alloc":
+ print(ev['count'])
+ print(ev['bucket'])
+ if ev.name == "counter":
+ print(ev['count'])
+ print(ev['kind'])
+ if ev.name == "flush":
+ print("flush")
+
+def get_ocaml_dir():
+ # Fetching OCaml's installation directory to extract the CTF metadata
+ ocamlc_where = subprocess.run(['ocamlc', '-where'], stdout=subprocess.PIPE)
+ ocaml_dir = ocamlc_where.stdout.decode('utf-8').rstrip('\n')
+ return(ocaml_dir)
+
+def main():
+ trace_dir = sys.argv[1]
+ ocaml_dir = get_ocaml_dir()
+ metadata_path = ocaml_dir + "/eventlog_metadata"
+ # copying the metadata to the trace's directory,
+ # and renaming it to 'metadata'.
+ shutil.copyfile(metadata_path, trace_dir + "/metadata")
+ tr = bt.TraceCollection()
+ tr.add_trace(trace_dir, 'ctf')
+ for event in tr.events:
+ print_event(event)
+
+if __name__ == '__main__':
+ main()
+
+\end{verbatim}
+
+This script expect to receive as an argument the directory containing the
+trace file. It will then copy the {\em CTF} metadata file to the trace's
+directory, and then decode the trace, printing each event in the process.
+
+For more information on {\em babeltrace}, see the website at:
+\href{https://babeltrace.org/}{https://babeltrace.org/}
+
+\section{s:instr-runtime-more}{Controlling instrumentation and limitations}
+
+\subsection{ss:instr-runtime-prefix}{Trace filename}
+
+The default trace filename is {\tt caml-\{PID\}.eventlog}, where {\tt \{PID\}}
+is the process identifier of the traced program.
+
+This filename can also be specified using the
+"OCAML_EVENTLOG_PREFIX" environment variable.
+The given path will be suffixed with {\tt \{.PID\}.eventlog}.
+
+\begin{verbatim}
+ OCAML_EVENTLOG_PREFIX=/tmp/a_prefix OCAML_EVENTLOG_ENABLED=1 ./program
+\end{verbatim}
+
+In this example, the trace will be available at path
+{\tt /tmp/a_prefix.\{PID\}.eventlog}.
+
+Note that this will only affect the prefix of the trace file, there is no
+option to specify the full effective file name.
+This restriction is in place to make room for future improvements to the
+instrumented runtime, where the single trace file per session design
+may be replaced.
+
+For scripting purpose, matching against `\{PID\}`, as well as the
+{\tt .eventlog} file extension should provide enough control over
+the generated files.
+
+Note as well that parent directories in the given path will not be created
+when opening the trace. The runtime assumes the path is
+accessible for creating and writing the trace. The program will
+fail to start if this requirement isn't met.
+
+\subsection{ss:instr-runtime-pause}{Pausing and resuming tracing}
+Mechanisms are available to control event collection at runtime.
+
+"OCAML_EVENTLOG_ENABLED" can be set to the {\tt p} flag in order
+to start the program with event collection paused.
+
+\begin{verbatim}
+ OCAML_EVENTLOG_ENABLED=p ./program
+\end{verbatim}
+
+The program will have to start event collection explicitly.
+Starting and stopping event collection programmatically can be done by calling
+{\tt Gc.eventlog_resume} and {\tt Gc.eventlog_pause}) from within the program.
+Refer to the {\stdmoduleref{Gc}} module documentation for more information.
+
+Running the program provided earlier with "OCAML_EVENTLOG_ENABLED=p"
+will for example yield the following result.
+
+\begin{verbatim}
+$ OCAML_EVENTLOG_ENABLED=p ./program
+$ ocaml-eventlog-report caml-{PID}.eventlog
+==== eventlog/flush
+median flush time: 58ns
+total flush time: 58ns
+flush count: 1
+\end{verbatim}
+
+The resulting trace contains only one event payload, namely a {\em flush} event,
+indicating how much time was spent flushing the trace file to disk.
+
+However, if the program is changed to include a call to
+{\tt Gc.eventlog_resume}, events payloads can be seen again
+in the trace file.
+
+\begin{caml_example*}{verbatim}
+ let () =
+ Gc.eventlog_resume();
+ seq 1_000_000
+ |> Seq.fold_left (fun m i -> SMap.add (s i) i m) SMap.empty
+ |> clear
+ |> ignore
+
+\end{caml_example*}
+
+The resulting trace will contain all events encountered during
+the program's execution:
+
+\begin{verbatim}
+ $ ocaml-eventlog-report caml-{PID}.eventlog
+ [..omitted..]
+ ==== force_minor/alloc_small
+ 100.0K..200.0K: 174
+ 20.0K..30.0K: 1
+ 0..100: 1
+
+ ==== eventlog/flush
+ median flush time: 207.8us
+ total flush time: 938.1us
+ flush count: 5
+\end{verbatim}
+
+\subsection{ss:instr-runtime-limitations}{Limitations}
+
+The instrumented runtime does not support the {\tt fork} system call.
+A child process forked from an instrumented program will not be traced.
+
+The instrumented runtime aims to provide insight into the runtime's execution
+while maintaining a low overhead.
+However, this overhead may become more noticeable depending on how a program
+executes.
+The instrumented runtime currently puts a strong emphasis on
+tracing {\em garbage collection} events. This means that programs
+with heavy garbage collection activity may be more susceptible to
+tracing induced performance penalties.
+
+While providing an accurate estimate of potential performance loss is difficult,
+test on various OCaml programs showed a total running time increase ranging
+from 1\% to 8\%.
+
+For a program with an extended running time where the collection of only a
+small sample of events is required, using the {\em eventlog_resume} and
+{\em eventlog_pause} primitives may help relieve some of the
+tracing induced performance impact.
--- /dev/null
+\chapter{Interfacing\label{c:intf-c} C with OCaml}
+%HEVEA\cutname{intfc.html}
+
+This chapter describes how user-defined primitives, written in C, can
+be linked with OCaml code and called from OCaml functions, and how
+these C functions can call back to OCaml code.
+
+\section{s:c-overview}{Overview and compilation information}
+
+\subsection{ss:c-prim-decl}{Declaring primitives}
+
+\begin{syntax}
+definition: ...
+ | 'external' value-name ':' typexpr '=' external-declaration
+;
+external-declaration: string-literal [ string-literal [ string-literal ] ]
+\end{syntax}
+
+User primitives are declared in an implementation file or
+@"struct"\ldots"end"@ module expression using the @"external"@ keyword:
+\begin{alltt}
+ external \var{name} : \var{type} = \var{C-function-name}
+\end{alltt}
+This defines the value name \var{name} as a function with type
+\var{type} that executes by calling the given C function.
+For instance, here is how the "seek_in" primitive is declared in the
+standard library module "Stdlib":
+\begin{verbatim}
+ external seek_in : in_channel -> int -> unit = "caml_ml_seek_in"
+\end{verbatim}
+Primitives with several arguments are always curried. The C function
+does not necessarily have the same name as the ML function.
+
+External functions thus defined can be specified in interface files or
+@"sig"\ldots"end"@ signatures either as regular values
+\begin{alltt}
+ val \var{name} : \var{type}
+\end{alltt}
+thus hiding their implementation as C functions, or explicitly as
+``manifest'' external functions
+\begin{alltt}
+ external \var{name} : \var{type} = \var{C-function-name}
+\end{alltt}
+The latter is slightly more efficient, as it allows clients of the
+module to call directly the C function instead of going through the
+corresponding OCaml function. On the other hand, it should not be used
+in library modules if they have side-effects at toplevel, as this
+direct call interferes with the linker's algorithm for removing unused
+modules from libraries at link-time.
+
+The arity (number of arguments) of a primitive is automatically
+determined from its OCaml type in the "external" declaration, by
+counting the number of function arrows in the type. For instance,
+"seek_in" above has arity 2, and the "caml_ml_seek_in" C function
+is called with two arguments. Similarly,
+\begin{verbatim}
+ external seek_in_pair: in_channel * int -> unit = "caml_ml_seek_in_pair"
+\end{verbatim}
+has arity 1, and the "caml_ml_seek_in_pair" C function receives one argument
+(which is a pair of OCaml values).
+
+Type abbreviations are not expanded when determining the arity of a
+primitive. For instance,
+\begin{verbatim}
+ type int_endo = int -> int
+ external f : int_endo -> int_endo = "f"
+ external g : (int -> int) -> (int -> int) = "f"
+\end{verbatim}
+"f" has arity 1, but "g" has arity 2. This allows a primitive to
+return a functional value (as in the "f" example above): just remember
+to name the functional return type in a type abbreviation.
+
+The language accepts external declarations with one or two
+flag strings in addition to the C function's name. These flags are
+reserved for the implementation of the standard library.
+
+\subsection{ss:c-prim-impl}{Implementing primitives}
+
+User primitives with arity $n \leq 5$ are implemented by C functions
+that take $n$ arguments of type "value", and return a result of type
+"value". The type "value" is the type of the representations for OCaml
+values. It encodes objects of several base types (integers,
+floating-point numbers, strings,~\ldots) as well as OCaml data
+structures. The type "value" and the associated conversion
+functions and macros are described in detail below. For instance,
+here is the declaration for the C function implementing the "input"
+primitive:
+\begin{verbatim}
+CAMLprim value input(value channel, value buffer, value offset, value length)
+{
+ ...
+}
+\end{verbatim}
+When the primitive function is applied in an OCaml program, the C
+function is called with the values of the expressions to which the
+primitive is applied as arguments. The value returned by the function is
+passed back to the OCaml program as the result of the function
+application.
+
+User primitives with arity greater than 5 should be implemented by two
+C functions. The first function, to be used in conjunction with the
+bytecode compiler "ocamlc", receives two arguments: a pointer to an
+array of OCaml values (the values for the arguments), and an
+integer which is the number of arguments provided. The other function,
+to be used in conjunction with the native-code compiler "ocamlopt",
+takes its arguments directly. For instance, here are the two C
+functions for the 7-argument primitive "Nat.add_nat":
+\begin{verbatim}
+CAMLprim value add_nat_native(value nat1, value ofs1, value len1,
+ value nat2, value ofs2, value len2,
+ value carry_in)
+{
+ ...
+}
+CAMLprim value add_nat_bytecode(value * argv, int argn)
+{
+ return add_nat_native(argv[0], argv[1], argv[2], argv[3],
+ argv[4], argv[5], argv[6]);
+}
+\end{verbatim}
+The names of the two C functions must be given in the primitive
+declaration, as follows:
+\begin{alltt}
+ external \var{name} : \var{type} =
+ \var{bytecode-C-function-name} \var{native-code-C-function-name}
+\end{alltt}
+For instance, in the case of "add_nat", the declaration is:
+\begin{verbatim}
+ external add_nat: nat -> int -> int -> nat -> int -> int -> int -> int
+ = "add_nat_bytecode" "add_nat_native"
+\end{verbatim}
+
+Implementing a user primitive is actually two separate tasks: on the
+one hand, decoding the arguments to extract C values from the given
+OCaml values, and encoding the return value as an OCaml
+value; on the other hand, actually computing the result from the arguments.
+Except for very simple primitives, it is often preferable to have two
+distinct C functions to implement these two tasks. The first function
+actually implements the primitive, taking native C values as
+arguments and returning a native C value. The second function,
+often called the ``stub code'', is a simple wrapper around the first
+function that converts its arguments from OCaml values to C values,
+call the first function, and convert the returned C value to OCaml
+value. For instance, here is the stub code for the "input"
+primitive:
+\begin{verbatim}
+CAMLprim value input(value channel, value buffer, value offset, value length)
+{
+ return Val_long(getblock((struct channel *) channel,
+ &Byte(buffer, Long_val(offset)),
+ Long_val(length)));
+}
+\end{verbatim}
+(Here, "Val_long", "Long_val" and so on are conversion macros for the
+type "value", that will be described later. The "CAMLprim" macro
+expands to the required compiler directives to ensure that the
+function is exported and accessible from OCaml.)
+The hard work is performed by the function "getblock", which is
+declared as:
+\begin{verbatim}
+long getblock(struct channel * channel, char * p, long n)
+{
+ ...
+}
+\end{verbatim}
+
+To write C code that operates on OCaml values, the following
+include files are provided:
+\begin{tableau}{|l|p{12cm}|}{Include file}{Provides}
+\entree{"caml/mlvalues.h"}{definition of the "value" type, and conversion
+macros}
+\entree{"caml/alloc.h"}{allocation functions (to create structured OCaml
+objects)}
+\entree{"caml/memory.h"}{miscellaneous memory-related functions
+and macros (for GC interface, in-place modification of structures, etc).}
+\entree{"caml/fail.h"}{functions for raising exceptions
+(see section~\ref{ss:c-exceptions})}
+\entree{"caml/callback.h"}{callback from C to OCaml (see
+section~\ref{s:c-callback}).}
+\entree{"caml/custom.h"}{operations on custom blocks (see
+section~\ref{s:c-custom}).}
+\entree{"caml/intext.h"}{operations for writing user-defined
+serialization and deserialization functions for custom blocks
+(see section~\ref{s:c-custom}).}
+\entree{"caml/threads.h"}{operations for interfacing in the presence
+ of multiple threads (see section~\ref{s:C-multithreading}).}
+\end{tableau}
+Before including any of these files, you should define the "CAML_NAME_SPACE"
+macro. For instance,
+\begin{verbatim}
+#define CAML_NAME_SPACE
+#include "caml/mlvalues.h"
+#include "caml/fail.h"
+\end{verbatim}
+These files reside in the "caml/" subdirectory of the OCaml
+standard library directory, which is returned by the command
+"ocamlc -where" (usually "/usr/local/lib/ocaml" or "/usr/lib/ocaml").
+
+{\bf Note:}
+Including the header files without first defining "CAML_NAME_SPACE"
+introduces in scope short names for most functions.
+Those short names are deprecated, and may be removed in the future
+because they usually produce clashes with names defined by other
+C libraries.
+
+\subsection{ss:staticlink-c-code}{Statically linking C code with OCaml code}
+
+The OCaml runtime system comprises three main parts: the bytecode
+interpreter, the memory manager, and a set of C functions that
+implement the primitive operations. Some bytecode instructions are
+provided to call these C functions, designated by their offset in a
+table of functions (the table of primitives).
+
+In the default mode, the OCaml linker produces bytecode for the
+standard runtime system, with a standard set of primitives. References
+to primitives that are not in this standard set result in the
+``unavailable C primitive'' error. (Unless dynamic loading of C
+libraries is supported -- see section~\ref{ss:dynlink-c-code} below.)
+
+In the ``custom runtime'' mode, the OCaml linker scans the
+object files and determines the set of required primitives. Then, it
+builds a suitable runtime system, by calling the native code linker with:
+\begin{itemize}
+\item the table of the required primitives;
+\item a library that provides the bytecode interpreter, the
+memory manager, and the standard primitives;
+\item libraries and object code files (".o" files) mentioned on the
+command line for the OCaml linker, that provide implementations
+for the user's primitives.
+\end{itemize}
+This builds a runtime system with the required primitives. The OCaml
+linker generates bytecode for this custom runtime system. The
+bytecode is appended to the end of the custom runtime system, so that
+it will be automatically executed when the output file (custom
+runtime + bytecode) is launched.
+
+To link in ``custom runtime'' mode, execute the "ocamlc" command with:
+\begin{itemize}
+\item the "-custom" option;
+\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
+\item the names of the C object files and libraries (".o" and ".a"
+files) that implement the required primitives. Under Unix and Windows,
+a library named "lib"\var{name}".a" (respectively, ".lib") residing in one of
+the standard library directories can also be specified as "-cclib -l"\var{name}.
+\end{itemize}
+
+If you are using the native-code compiler "ocamlopt", the "-custom"
+flag is not needed, as the final linking phase of "ocamlopt" always
+builds a standalone executable. To build a mixed OCaml/C executable,
+execute the "ocamlopt" command with:
+\begin{itemize}
+\item the names of the desired OCaml native object files (".cmx" and
+".cmxa" files);
+\item the names of the C object files and libraries (".o", ".a",
+".so" or ".dll" files) that implement the required primitives.
+\end{itemize}
+
+Starting with Objective Caml 3.00, it is possible to record the
+"-custom" option as well as the names of C libraries in an OCaml
+library file ".cma" or ".cmxa". For instance, consider an OCaml library
+"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
+which reference C code in "libmylib.a". If the library is
+built as follows:
+\begin{alltt}
+ ocamlc -a -o mylib.cma -custom a.cmo b.cmo -cclib -lmylib
+\end{alltt}
+users of the library can simply link with "mylib.cma":
+\begin{alltt}
+ ocamlc -o myprog mylib.cma ...
+\end{alltt}
+and the system will automatically add the "-custom" and "-cclib
+-lmylib" options, achieving the same effect as
+\begin{alltt}
+ ocamlc -o myprog -custom a.cmo b.cmo ... -cclib -lmylib
+\end{alltt}
+The alternative is of course to build the library without extra
+options:
+\begin{alltt}
+ ocamlc -a -o mylib.cma a.cmo b.cmo
+\end{alltt}
+and then ask users to provide the "-custom" and "-cclib -lmylib"
+options themselves at link-time:
+\begin{alltt}
+ ocamlc -o myprog -custom mylib.cma ... -cclib -lmylib
+\end{alltt}
+The former alternative is more convenient for the final users of the
+library, however.
+
+\subsection{ss:dynlink-c-code}{Dynamically linking C code with OCaml code}
+
+Starting with Objective Caml 3.03, an alternative to static linking of C code
+using the "-custom" code is provided. In this mode, the OCaml linker
+generates a pure bytecode executable (no embedded custom runtime
+system) that simply records the names of dynamically-loaded libraries
+containing the C code. The standard OCaml runtime system "ocamlrun"
+then loads dynamically these libraries, and resolves references to the
+required primitives, before executing the bytecode.
+
+This facility is currently available on all platforms supported by
+OCaml except Cygwin 64 bits.
+
+To dynamically link C code with OCaml code, the C code must first be
+compiled into a shared library (under Unix) or DLL (under Windows).
+This involves 1- compiling the C files with appropriate C compiler
+flags for producing position-independent code (when required by the
+operating system), and 2- building a
+shared library from the resulting object files. The resulting shared
+library or DLL file must be installed in a place where "ocamlrun" can
+find it later at program start-up time (see
+section~\ref{s:ocamlrun-dllpath}).
+Finally (step 3), execute the "ocamlc" command with
+\begin{itemize}
+\item the names of the desired OCaml object files (".cmo" and ".cma" files) ;
+\item the names of the C shared libraries (".so" or ".dll" files) that
+implement the required primitives. Under Unix and Windows,
+a library named "dll"\var{name}".so" (respectively, ".dll") residing
+in one of the standard library directories can also be specified as
+"-dllib -l"\var{name}.
+\end{itemize}
+Do {\em not} set the "-custom" flag, otherwise you're back to static linking
+as described in section~\ref{ss:staticlink-c-code}.
+The "ocamlmklib" tool (see section~\ref{s:ocamlmklib})
+automates steps 2 and 3.
+
+As in the case of static linking, it is possible (and recommended) to
+record the names of C libraries in an OCaml ".cma" library archive.
+Consider again an OCaml library
+"mylib.cma", built from the OCaml object files "a.cmo" and "b.cmo",
+which reference C code in "dllmylib.so". If the library is
+built as follows:
+\begin{alltt}
+ ocamlc -a -o mylib.cma a.cmo b.cmo -dllib -lmylib
+\end{alltt}
+users of the library can simply link with "mylib.cma":
+\begin{alltt}
+ ocamlc -o myprog mylib.cma ...
+\end{alltt}
+and the system will automatically add the "-dllib -lmylib" option,
+achieving the same effect as
+\begin{alltt}
+ ocamlc -o myprog a.cmo b.cmo ... -dllib -lmylib
+\end{alltt}
+Using this mechanism, users of the library "mylib.cma" do not need to
+known that it references C code, nor whether this C code must be
+statically linked (using "-custom") or dynamically linked.
+
+\subsection{ss:c-static-vs-dynamic}{Choosing between static linking and dynamic linking}
+
+After having described two different ways of linking C code with OCaml
+code, we now review the pros and cons of each, to help developers of
+mixed OCaml/C libraries decide.
+
+The main advantage of dynamic linking is that it preserves the
+platform-independence of bytecode executables. That is, the bytecode
+executable contains no machine code, and can therefore be compiled on
+platform $A$ and executed on other platforms $B$, $C$, \ldots, as long
+as the required shared libraries are available on all these
+platforms. In contrast, executables generated by "ocamlc -custom" run
+only on the platform on which they were created, because they embark a
+custom-tailored runtime system specific to that platform. In
+addition, dynamic linking results in smaller executables.
+
+Another advantage of dynamic linking is that the final users of the
+library do not need to have a C compiler, C linker, and C runtime
+libraries installed on their machines. This is no big deal under
+Unix and Cygwin, but many Windows users are reluctant to install
+Microsoft Visual C just to be able to do "ocamlc -custom".
+
+There are two drawbacks to dynamic linking. The first is that the
+resulting executable is not stand-alone: it requires the shared
+libraries, as well as "ocamlrun", to be installed on the machine
+executing the code. If you wish to distribute a stand-alone
+executable, it is better to link it statically, using "ocamlc -custom
+-ccopt -static" or "ocamlopt -ccopt -static". Dynamic linking also
+raises the ``DLL hell'' problem: some care must be taken to ensure
+that the right versions of the shared libraries are found at start-up
+time.
+
+The second drawback of dynamic linking is that it complicates the
+construction of the library. The C compiler and linker flags to
+compile to position-independent code and build a shared library vary
+wildly between different Unix systems. Also, dynamic linking is not
+supported on all Unix systems, requiring a fall-back case to static
+linking in the Makefile for the library. The "ocamlmklib" command
+(see section~\ref{s:ocamlmklib}) tries to hide some of these system
+dependencies.
+
+In conclusion: dynamic linking is highly recommended under the native
+Windows port, because there are no portability problems and it is much
+more convenient for the end users. Under Unix, dynamic linking should
+be considered for mature, frequently used libraries because it
+enhances platform-independence of bytecode executables. For new or
+rarely-used libraries, static linking is much simpler to set up in a
+portable way.
+
+\subsection{ss:custom-runtime}{Building standalone custom runtime systems}
+
+It is sometimes inconvenient to build a custom runtime system each
+time OCaml code is linked with C libraries, like "ocamlc -custom" does.
+For one thing, the building of the runtime system is slow on some
+systems (that have bad linkers or slow remote file systems); for
+another thing, the platform-independence of bytecode files is lost,
+forcing to perform one "ocamlc -custom" link per platform of interest.
+
+An alternative to "ocamlc -custom" is to build separately a custom
+runtime system integrating the desired C libraries, then generate
+``pure'' bytecode executables (not containing their own runtime
+system) that can run on this custom runtime. This is achieved by the
+"-make-runtime" and "-use-runtime" flags to "ocamlc". For example,
+to build a custom runtime system integrating the C parts of the
+``Unix'' and ``Threads'' libraries, do:
+\begin{verbatim}
+ ocamlc -make-runtime -o /home/me/ocamlunixrun unix.cma threads.cma
+\end{verbatim}
+To generate a bytecode executable that runs on this runtime system,
+do:
+\begin{alltt}
+ ocamlc -use-runtime /home/me/ocamlunixrun -o myprog \char92
+ unix.cma threads.cma {\it{your .cmo and .cma files}}
+\end{alltt}
+The bytecode executable "myprog" can then be launched as usual:
+"myprog" \var{args} or "/home/me/ocamlunixrun myprog" \var{args}.
+
+Notice that the bytecode libraries "unix.cma" and "threads.cma" must
+be given twice: when building the runtime system (so that "ocamlc"
+knows which C primitives are required) and also when building the
+bytecode executable (so that the bytecode from "unix.cma" and
+"threads.cma" is actually linked in).
+
+\section{s:c-value}{The \texttt{value} type}
+
+All OCaml objects are represented by the C type "value",
+defined in the include file "caml/mlvalues.h", along with macros to
+manipulate values of that type. An object of type "value" is either:
+\begin{itemize}
+\item an unboxed integer;
+\item or a pointer to a block inside the heap,
+allocated through one of the \verb"caml_alloc_*" functions described
+in section~\ref{ss:c-block-allocation}.
+\end{itemize}
+
+\subsection{ss:c-int}{Integer values}
+
+Integer values encode 63-bit signed integers (31-bit on 32-bit
+architectures). They are unboxed (unallocated).
+
+\subsection{ss:c-blocks}{Blocks}
+
+Blocks in the heap are garbage-collected, and therefore have strict
+structure constraints. Each block includes a header containing the
+size of the block (in words), and the tag of the block.
+The tag governs how the contents of the blocks are structured. A tag
+lower than "No_scan_tag" indicates a structured block, containing
+well-formed values, which is recursively traversed by the garbage
+collector. A tag greater than or equal to "No_scan_tag" indicates a
+raw block, whose contents are not scanned by the garbage collector.
+For the benefit of ad-hoc polymorphic primitives such as equality and
+structured input-output, structured and raw blocks are further
+classified according to their tags as follows:
+\begin{tableau}{|l|p{10cm}|}{Tag}{Contents of the block}
+\entree{0 to $\hbox{"No_scan_tag"}-1$}{A structured block (an array of
+OCaml objects). Each field is a "value".}
+\entree{"Closure_tag"}{A closure representing a functional value. The first
+word is a pointer to a piece of code, the remaining words are
+"value" containing the environment.}
+\entree{"String_tag"}{A character string or a byte sequence.}
+\entree{"Double_tag"}{A double-precision floating-point number.}
+\entree{"Double_array_tag"}{An array or record of double-precision
+floating-point numbers.}
+\entree{"Abstract_tag"}{A block representing an abstract datatype.}
+\entree{"Custom_tag"}{A block representing an abstract datatype
+ with user-defined finalization, comparison, hashing,
+ serialization and deserialization functions attached.}
+\end{tableau}
+
+\subsection{ss:c-outside-head}{Pointers outside the heap}
+
+In earlier versions of OCaml, it was possible to use
+word-aligned pointers to addresses outside the heap as OCaml values,
+just by casting the pointer to type "value". Starting with OCaml
+4.11, this usage is deprecated and will stop being supported in OCaml 5.00.
+
+A correct way to manipulate pointers to out-of-heap blocks from
+OCaml is to store those pointers in OCaml blocks with tag
+"Abstract_tag" or "Custom_tag", then use the blocks as the OCaml
+values.
+
+Here is an example of encapsulation of out-of-heap pointers of C type
+"ty *" inside "Abstract_tag" blocks. Section~\ref{s:c-intf-example}
+gives a more complete example using "Custom_tag" blocks.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+ value v = caml_alloc(1, Abstract_tag);
+ *((ty **) Data_abstract_val(v)) = p;
+ return v;
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+ return *((ty **) Data_abstract_val(v));
+}
+\end{verbatim}
+Alternatively, out-of-heap pointers can be treated as ``native''
+integers, that is, boxed 32-bit integers on a 32-bit platform and
+boxed 64-bit integers on a 64-bit platform.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+ return caml_copy_nativeint((intnat) p);
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+ return (ty *) Nativeint_val(v);
+}
+\end{verbatim}
+For pointers that are at least 2-aligned (the low bit is guaranteed to
+be zero), we have yet another valid representation as an OCaml tagged
+integer.
+\begin{verbatim}
+/* Create an OCaml value encapsulating the pointer p */
+static value val_of_typtr(ty * p)
+{
+ assert (((uintptr_t) p & 1) == 0); /* check correct alignment */
+ return (value) p | 1;
+}
+
+/* Extract the pointer encapsulated in the given OCaml value */
+static ty * typtr_of_val(value v)
+{
+ return (ty *) (v & ~1);
+}
+\end{verbatim}
+
+
+\section{s:c-ocaml-datatype-repr}{Representation of OCaml data types}
+
+This section describes how OCaml data types are encoded in the
+"value" type.
+
+\subsection{ss:c-atomic}{Atomic types}
+
+\begin{tableau}{|l|l|}{OCaml type}{Encoding}
+\entree{"int"}{Unboxed integer values.}
+\entree{"char"}{Unboxed integer values (ASCII code).}
+\entree{"float"}{Blocks with tag "Double_tag".}
+\entree{"bytes"}{Blocks with tag "String_tag".}
+\entree{"string"}{Blocks with tag "String_tag".}
+\entree{"int32"}{Blocks with tag "Custom_tag".}
+\entree{"int64"}{Blocks with tag "Custom_tag".}
+\entree{"nativeint"}{Blocks with tag "Custom_tag".}
+\end{tableau}
+
+\subsection{ss:c-tuples-and-records}{Tuples and records}
+
+Tuples are represented by pointers to blocks, with tag~0.
+
+Records are also represented by zero-tagged blocks. The ordering of
+labels in the record type declaration determines the layout of
+the record fields: the value associated to the label
+declared first is stored in field~0 of the block, the value associated
+to the second label goes in field~1, and so on.
+
+As an optimization, records whose fields all have static type "float"
+are represented as arrays of floating-point numbers, with tag
+"Double_array_tag". (See the section below on arrays.)
+
+As another optimization, unboxable record types are represented
+specially; unboxable record types are the immutable record types that
+have only one field. An unboxable type will be represented in one of
+two ways: boxed or unboxed. Boxed record types are represented as
+described above (by a block with tag 0 or "Double_array_tag"). An
+unboxed record type is represented directly by the value of its field
+(i.e. there is no block to represent the record itself).
+
+The representation is chosen according to the following, in decreasing
+order of priority:
+\begin{itemize}
+\item An attribute ("[\@\@boxed]" or "[\@\@unboxed]") on the type declaration.
+\item A compiler option ("-unboxed-types" or "-no-unboxed-types").
+\item The default representation. In the present version of OCaml, the
+default is the boxed representation.
+\end{itemize}
+
+\subsection{ss:c-arrays}{Arrays}
+
+Arrays of integers and pointers are represented like tuples,
+that is, as pointers to blocks tagged~0. They are accessed with the
+"Field" macro for reading and the "caml_modify" function for writing.
+
+Arrays of floating-point numbers (type "float array")
+have a special, unboxed, more efficient representation.
+These arrays are represented by pointers to blocks with tag
+"Double_array_tag". They should be accessed with the "Double_field"
+and "Store_double_field" macros.
+
+\subsection{ss:c-concrete-datatypes}{Concrete data types}
+
+Constructed terms are represented either by unboxed integers (for
+constant constructors) or by blocks whose tag encode the constructor
+(for non-constant constructors). The constant constructors and the
+non-constant constructors for a given concrete type are numbered
+separately, starting from 0, in the order in which they appear in the
+concrete type declaration. A constant constructor is represented by
+the unboxed integer equal to its constructor number. A non-constant
+constructor declared with $n$ arguments is represented by
+a block of size $n$, tagged with the constructor number; the $n$
+fields contain its arguments. Example:
+
+\begin{tableau}{|l|p{8cm}|}{Constructed term}{Representation}
+\entree{"()"}{"Val_int(0)"}
+\entree{"false"}{"Val_int(0)"}
+\entree{"true"}{"Val_int(1)"}
+\entree{"[]"}{"Val_int(0)"}
+\entree{"h::t"}{Block with size = 2 and tag = 0; first field
+contains "h", second field "t".}
+\end{tableau}
+
+As a convenience, "caml/mlvalues.h" defines the macros "Val_unit",
+"Val_false" and "Val_true" to refer to "()", "false" and "true".
+
+The following example illustrates the assignment of
+integers and block tags to constructors:
+\begin{verbatim}
+type t =
+ | A (* First constant constructor -> integer "Val_int(0)" *)
+ | B of string (* First non-constant constructor -> block with tag 0 *)
+ | C (* Second constant constructor -> integer "Val_int(1)" *)
+ | D of bool (* Second non-constant constructor -> block with tag 1 *)
+ | E of t * t (* Third non-constant constructor -> block with tag 2 *)
+\end{verbatim}
+
+
+As an optimization, unboxable concrete data types are represented
+specially; a concrete data type is unboxable if it has exactly one
+constructor and this constructor has exactly one argument. Unboxable
+concrete data types are represented in the same ways as unboxable
+record types: see the description in
+section~\ref{ss:c-tuples-and-records}.
+
+\subsection{ss:c-objects}{Objects}
+
+Objects are represented as blocks with tag "Object_tag". The first
+field of the block refers to the object's class and associated method
+suite, in a format that cannot easily be exploited from C. The second
+field contains a unique object ID, used for comparisons. The remaining
+fields of the object contain the values of the instance variables of
+the object. It is unsafe to access directly instance variables, as the
+type system provides no guarantee about the instance variables
+contained by an object.
+% Instance variables are stored in the order in which they
+% appear in the class definition (taking inherited classes into
+% account).
+
+One may extract a public method from an object using the C function
+"caml_get_public_method" (declared in "<caml/mlvalues.h>".)
+Since public method tags are hashed in the same way as variant tags,
+and methods are functions taking self as first argument, if you want
+to do the method call "foo#bar" from the C side, you should call:
+\begin{verbatim}
+ callback(caml_get_public_method(foo, hash_variant("bar")), foo);
+\end{verbatim}
+
+\subsection{ss:c-polyvar}{Polymorphic variants}
+
+Like constructed terms, polymorphic variant values are represented either
+as integers (for polymorphic variants without argument), or as blocks
+(for polymorphic variants with an argument). Unlike constructed
+terms, variant constructors are not numbered starting from 0, but
+identified by a hash value (an OCaml integer), as computed by the C function
+"hash_variant" (declared in "<caml/mlvalues.h>"):
+the hash value for a variant constructor named, say, "VConstr"
+is "hash_variant(\"VConstr\")".
+
+The variant value "`VConstr" is represented by
+"hash_variant(\"VConstr\")". The variant value "`VConstr("\var{v}")" is
+represented by a block of size 2 and tag 0, with field number 0
+containing "hash_variant(\"VConstr\")" and field number 1 containing
+\var{v}.
+
+Unlike constructed values, polymorphic variant values taking several
+arguments are not flattened.
+That is, "`VConstr("\var{v}", "\var{w}")" is represented by a block
+of size 2, whose field number 1 contains the representation of the
+pair "("\var{v}", "\var{w}")", rather than a block of size 3
+containing \var{v} and \var{w} in fields 1 and 2.
+
+\section{s:c-ops-on-values}{Operations on values}
+
+\subsection{ss:c-kind-tests}{Kind tests}
+
+\begin{itemize}
+\item "Is_long("\var{v}")" is true if value \var{v} is an immediate integer,
+false otherwise
+\item "Is_block("\var{v}")" is true if value \var{v} is a pointer to a block,
+and false if it is an immediate integer.
+\item "Is_none("\var{v}")" is true if value \var{v} is "None".
+\item "Is_some("\var{v}")" is true if value \var{v} (assumed to be of option
+type) corresponds to the "Some" constructor.
+\end{itemize}
+
+\subsection{ss:c-int-ops}{Operations on integers}
+
+\begin{itemize}
+\item "Val_long("\var{l}")" returns the value encoding the "long int" \var{l}.
+\item "Long_val("\var{v}")" returns the "long int" encoded in value \var{v}.
+\item "Val_int("\var{i}")" returns the value encoding the "int" \var{i}.
+\item "Int_val("\var{v}")" returns the "int" encoded in value \var{v}.
+\item "Val_bool("\var{x}")" returns the OCaml boolean representing the
+truth value of the C integer \var{x}.
+\item "Bool_val("\var{v}")" returns 0 if \var{v} is the OCaml boolean
+"false", 1 if \var{v} is "true".
+\item "Val_true", "Val_false" represent the OCaml booleans "true" and "false".
+\item "Val_none" represents the OCaml value "None".
+\end{itemize}
+
+\subsection{ss:c-block-access}{Accessing blocks}
+
+\begin{itemize}
+\item "Wosize_val("\var{v}")" returns the size of the block \var{v}, in words,
+excluding the header.
+\item "Tag_val("\var{v}")" returns the tag of the block \var{v}.
+\item "Field("\var{v}", "\var{n}")" returns the value contained in the
+$n\th$ field of the structured block \var{v}. Fields are numbered from 0 to
+$\hbox{"Wosize_val"}(v)-1$.
+\item "Store_field("\var{b}", "\var{n}", "\var{v}")" stores the value
+\var{v} in the field number \var{n} of value \var{b}, which must be a
+structured block.
+\item "Code_val("\var{v}")" returns the code part of the closure \var{v}.
+\item "caml_string_length("\var{v}")" returns the length (number of bytes)
+of the string or byte sequence \var{v}.
+\item "Byte("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
+or byte sequence \var{v}, with type "char". Bytes are numbered from 0 to
+$\hbox{"string_length"}(v)-1$.
+\item "Byte_u("\var{v}", "\var{n}")" returns the $n\th$ byte of the string
+or byte sequence \var{v}, with type "unsigned char". Bytes are
+numbered from 0 to $\hbox{"string_length"}(v)-1$.
+\item "String_val("\var{v}")" returns a pointer to the first byte of the string
+\var{v}, with type "char *" or, when OCaml is configured with
+"-force-safe-string", with type "const char *".
+This pointer is a valid C string: there is a null byte after the last
+byte in the string. However, OCaml strings can contain embedded null bytes,
+which will confuse the usual C functions over strings.
+\item "Bytes_val("\var{v}")" returns a pointer to the first byte of the
+byte sequence \var{v}, with type "unsigned char *".
+\item "Double_val("\var{v}")" returns the floating-point number contained in
+value \var{v}, with type "double".
+\item "Double_field("\var{v}", "\var{n}")" returns
+the $n\th$ element of the array of floating-point numbers \var{v} (a
+block tagged "Double_array_tag").
+\item "Store_double_field("\var{v}", "\var{n}",
+"\var{d}")" stores the double precision floating-point number \var{d}
+in the $n\th$ element of the array of floating-point numbers \var{v}.
+\item "Data_custom_val("\var{v}")" returns a pointer to the data part
+of the custom block \var{v}. This pointer has type "void *" and must
+be cast to the type of the data contained in the custom block.
+\item "Int32_val("\var{v}")" returns the 32-bit integer contained
+in the "int32" \var{v}.
+\item "Int64_val("\var{v}")" returns the 64-bit integer contained
+in the "int64" \var{v}.
+\item "Nativeint_val("\var{v}")" returns the long integer contained
+in the "nativeint" \var{v}.
+\item "caml_field_unboxed("\var{v}")" returns the value of the field
+of a value \var{v} of any unboxed type (record or concrete data type).
+\item "caml_field_boxed("\var{v}")" returns the value of the field
+of a value \var{v} of any boxed type (record or concrete data type).
+\item "caml_field_unboxable("\var{v}")" calls either
+"caml_field_unboxed" or "caml_field_boxed" according to the default
+representation of unboxable types in the current version of OCaml.
+\item "Some_val("\var{v}")" returns the argument "\var{x}" of a value \var{v} of
+the form "Some("\var{x}")".
+\end{itemize}
+The expressions "Field("\var{v}", "\var{n}")",
+"Byte("\var{v}", "\var{n}")" and
+"Byte_u("\var{v}", "\var{n}")"
+are valid l-values. Hence, they can be assigned to, resulting in an
+in-place modification of value \var{v}.
+Assigning directly to "Field("\var{v}", "\var{n}")" must
+be done with care to avoid confusing the garbage collector (see
+below).
+
+\subsection{ss:c-block-allocation}{Allocating blocks}
+
+\subsubsection{sss:c-simple-allocation}{Simple interface}
+
+\begin{itemize}
+\item
+"Atom("\var{t}")" returns an ``atom'' (zero-sized block) with tag \var{t}.
+Zero-sized blocks are preallocated outside of the heap. It is
+incorrect to try and allocate a zero-sized block using the functions below.
+For instance, "Atom(0)" represents the empty array.
+\item
+"caml_alloc("\var{n}", "\var{t}")" returns a fresh block of size \var{n}
+with tag \var{t}. If \var{t} is less than "No_scan_tag", then the
+fields of the block are initialized with a valid value in order to
+satisfy the GC constraints.
+\item
+"caml_alloc_tuple("\var{n}")" returns a fresh block of size
+\var{n} words, with tag 0.
+\item
+"caml_alloc_string("\var{n}")" returns a byte sequence (or string) value of
+length \var{n} bytes. The sequence initially contains uninitialized bytes.
+\item
+"caml_alloc_initialized_string("\var{n}", "\var{p}")" returns a byte sequence
+(or string) value of length \var{n} bytes. The value is initialized from the
+\var{n} bytes starting at address \var{p}.
+\item
+"caml_copy_string("\var{s}")" returns a string or byte sequence value
+containing a copy of the null-terminated C string \var{s} (a "char *").
+\item
+"caml_copy_double("\var{d}")" returns a floating-point value initialized
+with the "double" \var{d}.
+\item
+"caml_copy_int32("\var{i}")", "caml_copy_int64("\var{i}")" and
+"caml_copy_nativeint("\var{i}")" return a value of OCaml type "int32",
+"int64" and "nativeint", respectively, initialized with the integer
+\var{i}.
+\item
+"caml_alloc_array("\var{f}", "\var{a}")" allocates an array of values, calling
+function \var{f} over each element of the input array \var{a} to transform it
+into a value. The array \var{a} is an array of pointers terminated by the
+null pointer. The function \var{f} receives each pointer as argument, and
+returns a value. The zero-tagged block returned by
+"alloc_array("\var{f}", "\var{a}")" is filled with the values returned by the
+successive calls to \var{f}. (This function must not be used to build
+an array of floating-point numbers.)
+\item
+"caml_copy_string_array("\var{p}")" allocates an array of strings or byte
+sequences, copied from the pointer to a string array \var{p}
+(a "char **"). \var{p} must be NULL-terminated.
+\item "caml_alloc_float_array("\var{n}")" allocates an array of floating point
+ numbers of size \var{n}. The array initially contains uninitialized values.
+\item "caml_alloc_unboxed("\var{v}")" returns the value (of any unboxed
+type) whose field is the value \var{v}.
+\item "caml_alloc_boxed("\var{v}")" allocates and returns a value (of
+any boxed type) whose field is the value \var{v}.
+\item "caml_alloc_unboxable("\var{v}")" calls either
+"caml_alloc_unboxed" or "caml_alloc_boxed" according to the default
+representation of unboxable types in the current version of OCaml.
+\item "caml_alloc_some("\var{v}")" allocates a block representing
+"Some("\var{v}")".
+\end{itemize}
+
+\subsubsection{sss:c-low-level-alloc}{Low-level interface}
+
+The following functions are slightly more efficient than "caml_alloc", but
+also much more difficult to use.
+
+From the standpoint of the allocation functions, blocks are divided
+according to their size as zero-sized blocks, small blocks (with size
+less than or equal to \verb"Max_young_wosize"), and large blocks (with
+size greater than \verb"Max_young_wosize"). The constant
+\verb"Max_young_wosize" is declared in the include file "mlvalues.h". It
+is guaranteed to be at least 64 (words), so that any block with
+constant size less than or equal to 64 can be assumed to be small. For
+blocks whose size is computed at run-time, the size must be compared
+against \verb"Max_young_wosize" to determine the correct allocation procedure.
+
+\begin{itemize}
+\item
+"caml_alloc_small("\var{n}", "\var{t}")" returns a fresh small block of size
+$n \leq \hbox{"Max_young_wosize"}$ words, with tag \var{t}.
+If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
+the fields of the block (initially containing garbage) must be initialized
+with legal values (using direct assignment to the fields of the block)
+before the next allocation.
+\item
+"caml_alloc_shr("\var{n}", "\var{t}")" returns a fresh block of size
+\var{n}, with tag \var{t}.
+The size of the block can be greater than \verb"Max_young_wosize". (It
+can also be smaller, but in this case it is more efficient to call
+"caml_alloc_small" instead of "caml_alloc_shr".)
+If this block is a structured block (i.e. if $t < \hbox{"No_scan_tag"}$), then
+the fields of the block (initially containing garbage) must be initialized
+with legal values (using the "caml_initialize" function described below)
+before the next allocation.
+\end{itemize}
+
+\subsection{ss:c-exceptions}{Raising exceptions}
+
+Two functions are provided to raise two standard exceptions:
+\begin{itemize}
+\item "caml_failwith("\var{s}")", where \var{s} is a null-terminated C string (with
+type \verb"char *"), raises exception "Failure" with argument \var{s}.
+\item "caml_invalid_argument("\var{s}")", where \var{s} is a null-terminated C
+string (with type \verb"char *"), raises exception "Invalid_argument"
+with argument \var{s}.
+\end{itemize}
+
+Raising arbitrary exceptions from C is more delicate: the
+exception identifier is dynamically allocated by the OCaml program, and
+therefore must be communicated to the C function using the
+registration facility described below in section~\ref{ss:c-register-exn}.
+Once the exception identifier is recovered in C, the following
+functions actually raise the exception:
+\begin{itemize}
+\item "caml_raise_constant("\var{id}")" raises the exception \var{id} with
+no argument;
+\item "caml_raise_with_arg("\var{id}", "\var{v}")" raises the exception
+\var{id} with the OCaml value \var{v} as argument;
+\item "caml_raise_with_args("\var{id}", "\var{n}", "\var{v}")"
+raises the exception \var{id} with the OCaml values
+\var{v}"[0]", \ldots, \var{v}"["\var{n}"-1]" as arguments;
+\item "caml_raise_with_string("\var{id}", "\var{s}")", where \var{s} is a
+null-terminated C string, raises the exception \var{id} with a copy of
+the C string \var{s} as argument.
+\end{itemize}
+
+\section{s:c-gc-harmony}{Living in harmony with the garbage collector}
+
+Unused blocks in the heap are automatically reclaimed by the garbage
+collector. This requires some cooperation from C code that
+manipulates heap-allocated blocks.
+
+\subsection{ss:c-simple-gc-harmony}{Simple interface}
+
+All the macros described in this section are declared in the
+"memory.h" header file.
+
+\begin{gcrule}
+A function that has parameters or local variables of type "value" must
+begin with a call to one of the "CAMLparam" macros and return with
+"CAMLreturn", "CAMLreturn0", or "CAMLreturnT". In particular, "CAMLlocal"
+and "CAMLxparam" can only be called \emph{after} "CAMLparam".
+\end{gcrule}
+
+There are six "CAMLparam" macros: "CAMLparam0" to "CAMLparam5", which
+take zero to five arguments respectively. If your function has no more
+than 5 parameters of type "value", use the corresponding macros
+with these parameters as arguments. If your function has more than 5
+parameters of type "value", use "CAMLparam5" with five of these
+parameters, and use one or more calls to the "CAMLxparam" macros for
+the remaining parameters ("CAMLxparam1" to "CAMLxparam5").
+
+The macros "CAMLreturn", "CAMLreturn0", and "CAMLreturnT" are used to
+replace the C
+keyword "return". Every occurrence of "return x" must be replaced by
+"CAMLreturn (x)" if "x" has type "value", or "CAMLreturnT (t, x)"
+(where "t" is the type of "x"); every occurrence of "return" without
+argument must be
+replaced by "CAMLreturn0". If your C function is a procedure (i.e. if
+it returns void), you must insert "CAMLreturn0" at the end (to replace
+C's implicit "return").
+
+\paragraph{Note:} some C compilers give bogus warnings about unused
+variables "caml__dummy_xxx" at each use of "CAMLparam" and
+"CAMLlocal". You should ignore them.
+
+\goodbreak
+
+Example:
+\begin{verbatim}
+void foo (value v1, value v2, value v3)
+{
+ CAMLparam3 (v1, v2, v3);
+ ...
+ CAMLreturn0;
+}
+\end{verbatim}
+
+\paragraph{Note:} if your function is a primitive with more than 5 arguments
+for use with the byte-code runtime, its arguments are not "value"s and
+must not be declared (they have types "value *" and "int").
+
+\begin{gcrule}
+Local variables of type "value" must be declared with one of the
+"CAMLlocal" macros. Arrays of "value"s are declared with
+"CAMLlocalN". These macros must be used at the beginning of the
+function, not in a nested block.
+\end{gcrule}
+
+The macros "CAMLlocal1" to "CAMLlocal5" declare and initialize one to
+five local variables of type "value". The variable names are given as
+arguments to the macros. "CAMLlocalN("\var{x}", "\var{n}")" declares
+and initializes a local variable of type "value ["\var{n}"]". You can
+use several calls to these macros if you have more than 5 local
+variables.
+
+Example:
+\begin{verbatim}
+CAMLprim value bar (value v1, value v2, value v3)
+{
+ CAMLparam3 (v1, v2, v3);
+ CAMLlocal1 (result);
+ result = caml_alloc (3, 0);
+ ...
+ CAMLreturn (result);
+}
+\end{verbatim}
+
+\begin{gcrule}
+Assignments to the fields of structured blocks must be done with the
+"Store_field" macro (for normal blocks) or "Store_double_field" macro
+(for arrays and records of floating-point numbers). Other assignments
+must not use "Store_field" nor "Store_double_field".
+\end{gcrule}
+
+"Store_field ("\var{b}", "\var{n}", "\var{v}")" stores the value
+\var{v} in the field number \var{n} of value \var{b}, which must be a
+block (i.e. "Is_block("\var{b}")" must be true).
+
+Example:
+\begin{verbatim}
+CAMLprim value bar (value v1, value v2, value v3)
+{
+ CAMLparam3 (v1, v2, v3);
+ CAMLlocal1 (result);
+ result = caml_alloc (3, 0);
+ Store_field (result, 0, v1);
+ Store_field (result, 1, v2);
+ Store_field (result, 2, v3);
+ CAMLreturn (result);
+}
+\end{verbatim}
+
+\paragraph{Warning:} The first argument of "Store_field" and
+"Store_double_field" must be a variable declared by "CAMLparam*" or
+a parameter declared by "CAMLlocal*" to ensure that a garbage
+collection triggered by the evaluation of the other arguments will not
+invalidate the first argument after it is computed.
+
+\paragraph{Use with CAMLlocalN:} Arrays of values declared using
+"CAMLlocalN" must not be written to using "Store_field".
+Use the normal C array syntax instead.
+
+\begin{gcrule} Global variables containing values must be registered
+with the garbage collector using the "caml_register_global_root" function,
+save that global variables and locations that will only ever contain OCaml
+integers (and never pointers) do not have to be registered.
+
+The same is true for any memory location outside the OCaml heap that contains a
+value and is not guaranteed to be reachable---for as long as it contains such
+value---from either another registered global variable or location, local
+variable declared with "CAMLlocal" or function parameter declared with
+"CAMLparam".
+\end{gcrule}
+
+Registration of a global variable "v" is achieved by calling
+"caml_register_global_root(&v)" just before or just after a valid value is
+stored in "v" for the first time; likewise, registration of an arbitrary
+location "p" is achieved by calling "caml_register_global_root(p)".
+
+You must not call any of the OCaml runtime functions or macros between
+registering and storing the value. Neither must you store anything in the
+variable "v" (likewise, the location "p") that is not a valid value.
+
+The registration causes the contents of the variable or memory location to be
+updated by the garbage collector whenever the value in such variable or location
+is moved within the OCaml heap. In the presence of threads care must be taken to
+ensure appropriate synchronisation with the OCaml runtime to avoid a race
+condition against the garbage collector when reading or writing the value. (See
+section
+\ref{ss:parallel-execution-long-running-c-code}.)
+
+A registered global variable "v" can be un-registered by calling
+"caml_remove_global_root(&v)".
+
+If the contents of the global variable "v" are seldom modified after
+registration, better performance can be achieved by calling
+"caml_register_generational_global_root(&v)" to register "v" (after
+its initialization with a valid "value", but before any allocation or
+call to the GC functions),
+and "caml_remove_generational_global_root(&v)" to un-register it. In
+this case, you must not modify the value of "v" directly, but you must
+use "caml_modify_generational_global_root(&v,x)" to set it to "x".
+The garbage collector takes advantage of the guarantee that "v" is not
+modified between calls to "caml_modify_generational_global_root" to scan it
+less often. This improves performance if the
+modifications of "v" happen less often than minor collections.
+
+\paragraph{Note:} The "CAML" macros use identifiers (local variables, type
+identifiers, structure tags) that start with "caml__". Do not use any
+identifier starting with "caml__" in your programs.
+
+\subsection{ss:c-low-level-gc-harmony}{Low-level interface}
+
+% Il faudrait simplifier violemment ce qui suit.
+% En gros, dire quand on n'a pas besoin de declarer les variables
+% et dans quels cas on peut se passer de "Store_field".
+
+We now give the GC rules corresponding to the low-level allocation
+functions "caml_alloc_small" and "caml_alloc_shr". You can ignore those rules
+if you stick to the simplified allocation function "caml_alloc".
+
+\begin{gcrule} After a structured block (a block with tag less than
+"No_scan_tag") is allocated with the low-level functions, all fields
+of this block must be filled with well-formed values before the next
+allocation operation. If the block has been allocated with
+"caml_alloc_small", filling is performed by direct assignment to the fields
+of the block:
+\begin{alltt}
+ Field(\var{v}, \var{n}) = \nth{v}{n};
+\end{alltt}
+If the block has been allocated with "caml_alloc_shr", filling is performed
+through the "caml_initialize" function:
+\begin{alltt}
+ caml_initialize(&Field(\var{v}, \var{n}), \nth{v}{n});
+\end{alltt}
+\end{gcrule}
+
+The next allocation can trigger a garbage collection. The garbage
+collector assumes that all structured blocks contain well-formed
+values. Newly created blocks contain random data, which generally do
+not represent well-formed values.
+
+If you really need to allocate before the fields can receive their
+final value, first initialize with a constant value (e.g.
+"Val_unit"), then allocate, then modify the fields with the correct
+value (see rule~6).
+
+%% \begin{gcrule} Local variables and function parameters containing
+%% values must be registered with the garbage collector (using the
+%% "Begin_roots" and "End_roots" macros), if they are to survive a call
+%% to an allocation function.
+%% \end{gcrule}
+%%
+%% Registration is performed with the "Begin_roots" set of macros.
+%% "Begin_roots1("\var{v}")" registers variable \var{v} with the garbage
+%% collector. Generally, \var{v} will be a local variable or a
+%% parameter of your function. It must be initialized to a valid value
+%% (e.g. "Val_unit") before the first allocation. Likewise,
+%% "Begin_roots2", \ldots, "Begin_roots5"
+%% let you register up to 5 variables at the same time. "Begin_root" is
+%% the same as "Begin_roots1". "Begin_roots_block("\var{ptr}","\var{size}")"
+%% allows you to register an array of roots. \var{ptr} is a pointer to
+%% the first element, and \var{size} is the number of elements in the
+%% array.
+%%
+%% Once registered, each of your variables (or array element) has the
+%% following properties: if it points to a heap-allocated block, this
+%% block (and its contents) will not be reclaimed; moreover, if this
+%% block is relocated by the garbage collector, the variable is updated
+%% to point to the new location for the block.
+%%
+%% Each of the "Begin_roots" macros open a C block that must be closed
+%% with a matching "End_roots" at the same nesting level. The block must
+%% be exited normally (i.e. not with "return" or "goto"). However, the
+%% roots are automatically un-registered if an OCaml exception is raised,
+%% so you can exit the block with "failwith", "invalid_argument", or one
+%% of the "raise" functions.
+%%
+%% {\bf Note:} The "Begin_roots" macros use a local variable and a
+%% structure tag named "caml__roots_block". Do not use this identifier
+%% in your programs.
+
+\begin{gcrule} Direct assignment to a field of a block, as in
+\begin{alltt}
+ Field(\var{v}, \var{n}) = \var{w};
+\end{alltt}
+is safe only if \var{v} is a block newly allocated by "caml_alloc_small";
+that is, if no allocation took place between the
+allocation of \var{v} and the assignment to the field. In all other cases,
+never assign directly. If the block has just been allocated by "caml_alloc_shr",
+use "caml_initialize" to assign a value to a field for the first time:
+\begin{alltt}
+ caml_initialize(&Field(\var{v}, \var{n}), \var{w});
+\end{alltt}
+Otherwise, you are updating a field that previously contained a
+well-formed value; then, call the "caml_modify" function:
+\begin{alltt}
+ caml_modify(&Field(\var{v}, \var{n}), \var{w});
+\end{alltt}
+\end{gcrule}
+
+To illustrate the rules above, here is a C function that builds and
+returns a list containing the two integers given as parameters.
+First, we write it using the simplified allocation functions:
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (result, r);
+
+ r = caml_alloc(2, 0); /* Allocate a cons cell */
+ Store_field(r, 0, Val_int(i2)); /* car = the integer i2 */
+ Store_field(r, 1, Val_int(0)); /* cdr = the empty list [] */
+ result = caml_alloc(2, 0); /* Allocate the other cons cell */
+ Store_field(result, 0, Val_int(i1)); /* car = the integer i1 */
+ Store_field(result, 1, r); /* cdr = the first cons cell */
+ CAMLreturn (result);
+}
+\end{verbatim}
+Here, the registering of "result" is not strictly needed, because no
+allocation takes place after it gets its value, but it's easier and
+safer to simply register all the local variables that have type "value".
+
+Here is the same function written using the low-level allocation
+functions. We notice that the cons cells are small blocks and can be
+allocated with "caml_alloc_small", and filled by direct assignments on
+their fields.
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (result, r);
+
+ r = caml_alloc_small(2, 0); /* Allocate a cons cell */
+ Field(r, 0) = Val_int(i2); /* car = the integer i2 */
+ Field(r, 1) = Val_int(0); /* cdr = the empty list [] */
+ result = caml_alloc_small(2, 0); /* Allocate the other cons cell */
+ Field(result, 0) = Val_int(i1); /* car = the integer i1 */
+ Field(result, 1) = r; /* cdr = the first cons cell */
+ CAMLreturn (result);
+}
+\end{verbatim}
+In the two examples above, the list is built bottom-up. Here is an
+alternate way, that proceeds top-down. It is less efficient, but
+illustrates the use of "caml_modify".
+\begin{verbatim}
+value alloc_list_int(int i1, int i2)
+{
+ CAMLparam0 ();
+ CAMLlocal2 (tail, r);
+
+ r = caml_alloc_small(2, 0); /* Allocate a cons cell */
+ Field(r, 0) = Val_int(i1); /* car = the integer i1 */
+ Field(r, 1) = Val_int(0); /* A dummy value
+ tail = caml_alloc_small(2, 0); /* Allocate the other cons cell */
+ Field(tail, 0) = Val_int(i2); /* car = the integer i2 */
+ Field(tail, 1) = Val_int(0); /* cdr = the empty list [] */
+ caml_modify(&Field(r, 1), tail); /* cdr of the result = tail */
+ CAMLreturn (r);
+}
+\end{verbatim}
+It would be incorrect to perform
+"Field(r, 1) = tail" directly, because the allocation of "tail"
+has taken place since "r" was allocated.
+
+
+\subsection{ss:c-process-pending-actions}{Pending actions and asynchronous exceptions}
+
+Since 4.10, allocation functions are guaranteed not to call any OCaml
+callbacks from C, including finalisers and signal handlers, and delay
+their execution instead.
+
+The function \verb"caml_process_pending_actions" from
+"<caml/signals.h>" executes any pending signal handlers and
+finalisers, Memprof callbacks, and requested minor and major garbage
+collections. In particular, it can raise asynchronous exceptions. It
+is recommended to call it regularly at safe points inside long-running
+non-blocking C code.
+
+The variant \verb"caml_process_pending_actions_exn" is provided, that
+returns the exception instead of raising it directly into OCaml code.
+Its result must be tested using {\tt Is_exception_result}, and
+followed by {\tt Extract_exception} if appropriate. It is typically
+used for clean up before re-raising:
+
+\begin{verbatim}
+ CAMLlocal1(exn);
+ ...
+ exn = caml_process_pending_actions_exn();
+ if(Is_exception_result(exn)) {
+ exn = Extract_exception(exn);
+ ...cleanup...
+ caml_raise(exn);
+ }
+\end{verbatim}
+
+Correct use of exceptional return, in particular in the presence of
+garbage collection, is further detailed in Section~\ref{ss:c-callbacks}.
+
+\section{s:c-intf-example}{A complete example}
+
+This section outlines how the functions from the Unix "curses" library
+can be made available to OCaml programs. First of all, here is
+the interface "curses.ml" that declares the "curses" primitives and
+data types:
+\begin{verbatim}
+(* File curses.ml -- declaration of primitives and data types *)
+type window (* The type "window" remains abstract *)
+external initscr: unit -> window = "caml_curses_initscr"
+external endwin: unit -> unit = "caml_curses_endwin"
+external refresh: unit -> unit = "caml_curses_refresh"
+external wrefresh : window -> unit = "caml_curses_wrefresh"
+external newwin: int -> int -> int -> int -> window = "caml_curses_newwin"
+external addch: char -> unit = "caml_curses_addch"
+external mvwaddch: window -> int -> int -> char -> unit = "caml_curses_mvwaddch"
+external addstr: string -> unit = "caml_curses_addstr"
+external mvwaddstr: window -> int -> int -> string -> unit
+ = "caml_curses_mvwaddstr"
+(* lots more omitted *)
+\end{verbatim}
+To compile this interface:
+\begin{verbatim}
+ ocamlc -c curses.ml
+\end{verbatim}
+
+To implement these functions, we just have to provide the stub code;
+the core functions are already implemented in the "curses" library.
+The stub code file, "curses_stubs.c", looks like this:
+\begin{verbatim}
+/* File curses_stubs.c -- stub code for curses */
+#include <curses.h>
+#define CAML_NAME_SPACE
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+
+/* Encapsulation of opaque window handles (of type WINDOW *)
+ as OCaml custom blocks. */
+
+static struct custom_operations curses_window_ops = {
+ "fr.inria.caml.curses_windows",
+ custom_finalize_default,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default,
+ custom_compare_ext_default,
+ custom_fixed_length_default
+};
+
+/* Accessing the WINDOW * part of an OCaml custom block */
+#define Window_val(v) (*((WINDOW **) Data_custom_val(v)))
+
+/* Allocating an OCaml custom block to hold the given WINDOW * */
+static value alloc_window(WINDOW * w)
+{
+ value v = caml_alloc_custom(&curses_window_ops, sizeof(WINDOW *), 0, 1);
+ Window_val(v) = w;
+ return v;
+}
+
+CAMLprim value caml_curses_initscr(value unit)
+{
+ CAMLparam1 (unit);
+ CAMLreturn (alloc_window(initscr()));
+}
+
+CAMLprim value caml_curses_endwin(value unit)
+{
+ CAMLparam1 (unit);
+ endwin();
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_refresh(value unit)
+{
+ CAMLparam1 (unit);
+ refresh();
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_wrefresh(value win)
+{
+ CAMLparam1 (win);
+ wrefresh(Window_val(win));
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_newwin(value nlines, value ncols, value x0, value y0)
+{
+ CAMLparam4 (nlines, ncols, x0, y0);
+ CAMLreturn (alloc_window(newwin(Int_val(nlines), Int_val(ncols),
+ Int_val(x0), Int_val(y0))));
+}
+
+CAMLprim value caml_curses_addch(value c)
+{
+ CAMLparam1 (c);
+ addch(Int_val(c)); /* Characters are encoded like integers */
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_mvwaddch(value win, value x, value y, value c)
+{
+ CAMLparam4 (win, x, y, c);
+ mvwaddch(Window_val(win), Int_val(x), Int_val(y), Int_val(c));
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_addstr(value s)
+{
+ CAMLparam1 (s);
+ addstr(String_val(s));
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value caml_curses_mvwaddstr(value win, value x, value y, value s)
+{
+ CAMLparam4 (win, x, y, s);
+ mvwaddstr(Window_val(win), Int_val(x), Int_val(y), String_val(s));
+ CAMLreturn (Val_unit);
+}
+
+/* This goes on for pages. */
+\end{verbatim}
+
+The file "curses_stubs.c" can be compiled with:
+\begin{verbatim}
+ cc -c -I`ocamlc -where` curses_stubs.c
+\end{verbatim}
+or, even simpler,
+\begin{verbatim}
+ ocamlc -c curses_stubs.c
+\end{verbatim}
+(When passed a ".c" file, the "ocamlc" command simply calls the C
+compiler on that file, with the right "-I" option.)
+
+Now, here is a sample OCaml program "prog.ml" that uses the "curses"
+module:
+\begin{verbatim}
+(* File prog.ml -- main program using curses *)
+open Curses;;
+let main_window = initscr () in
+let small_window = newwin 10 5 20 10 in
+ mvwaddstr main_window 10 2 "Hello";
+ mvwaddstr small_window 4 3 "world";
+ refresh();
+ Unix.sleep 5;
+ endwin()
+\end{verbatim}
+To compile and link this program, run:
+\begin{verbatim}
+ ocamlc -custom -o prog unix.cma curses.cmo prog.ml curses_stubs.o -cclib -lcurses
+\end{verbatim}
+(On some machines, you may need to put
+"-cclib -lcurses -cclib -ltermcap" or "-cclib -ltermcap"
+instead of "-cclib -lcurses".)
+
+%% Note by Damien: when I launch the program, it only displays "Hello"
+%% and not "world". Why?
+
+\section{s:c-callback}{Advanced topic: callbacks from C to OCaml}
+
+So far, we have described how to call C functions from OCaml. In this
+section, we show how C functions can call OCaml functions, either as
+callbacks (OCaml calls C which calls OCaml), or with the main program
+written in C.
+
+\subsection{ss:c-callbacks}{Applying OCaml closures from C}
+
+C functions can apply OCaml function values (closures) to OCaml values.
+The following functions are provided to perform the applications:
+\begin{itemize}
+\item "caml_callback("\var{f, a}")" applies the functional value \var{f} to
+the value \var{a} and returns the value returned by~\var{f}.
+\item "caml_callback2("\var{f, a, b}")" applies the functional value \var{f}
+(which is assumed to be a curried OCaml function with two arguments) to
+\var{a} and \var{b}.
+\item "caml_callback3("\var{f, a, b, c}")" applies the functional value \var{f}
+(a curried OCaml function with three arguments) to \var{a}, \var{b} and \var{c}.
+\item "caml_callbackN("\var{f, n, args}")" applies the functional value \var{f}
+to the \var{n} arguments contained in the C array of values \var{args}.
+\end{itemize}
+If the function \var{f} does not return, but raises an exception that
+escapes the scope of the application, then this exception is
+propagated to the next enclosing OCaml code, skipping over the C
+code. That is, if an OCaml function \var{f} calls a C function \var{g} that
+calls back an OCaml function \var{h} that raises a stray exception, then the
+execution of \var{g} is interrupted and the exception is propagated back
+into \var{f}.
+
+If the C code wishes to catch exceptions escaping the OCaml function,
+it can use the functions "caml_callback_exn", "caml_callback2_exn",
+"caml_callback3_exn", "caml_callbackN_exn". These functions take the same
+arguments as their non-"_exn" counterparts, but catch escaping
+exceptions and return them to the C code. The return value \var{v} of the
+"caml_callback*_exn" functions must be tested with the macro
+"Is_exception_result("\var{v}")". If the macro returns ``false'', no
+exception occurred, and \var{v} is the value returned by the OCaml
+function. If "Is_exception_result("\var{v}")" returns ``true'',
+an exception escaped, and its value (the exception descriptor) can be
+recovered using "Extract_exception("\var{v}")".
+
+\paragraph{Warning:} If the OCaml function returned with an exception,
+"Extract_exception" should be applied to the exception result prior
+to calling a function that may trigger garbage collection.
+Otherwise, if \var{v} is reachable during garbage collection, the runtime
+can crash since \var{v} does not contain a valid value.
+
+Example:
+\begin{verbatim}
+ CAMLprim value call_caml_f_ex(value closure, value arg)
+ {
+ CAMLparam2(closure, arg);
+ CAMLlocal2(res, tmp);
+ res = caml_callback_exn(closure, arg);
+ if(Is_exception_result(res)) {
+ res = Extract_exception(res);
+ tmp = caml_alloc(3, 0); /* Safe to allocate: res contains valid value. */
+ ...
+ }
+ CAMLreturn (res);
+ }
+\end{verbatim}
+
+\subsection{ss:c-closures}{Obtaining or registering OCaml closures for use in C functions}
+
+There are two ways to obtain OCaml function values (closures) to
+be passed to the "callback" functions described above. One way is to
+pass the OCaml function as an argument to a primitive function. For
+example, if the OCaml code contains the declaration
+\begin{verbatim}
+ external apply : ('a -> 'b) -> 'a -> 'b = "caml_apply"
+\end{verbatim}
+the corresponding C stub can be written as follows:
+\begin{verbatim}
+ CAMLprim value caml_apply(value vf, value vx)
+ {
+ CAMLparam2(vf, vx);
+ CAMLlocal1(vy);
+ vy = caml_callback(vf, vx);
+ CAMLreturn(vy);
+ }
+\end{verbatim}
+
+Another possibility is to use the registration mechanism provided by
+OCaml. This registration mechanism enables OCaml code to register
+OCaml functions under some global name, and C code to retrieve the
+corresponding closure by this global name.
+
+On the OCaml side, registration is performed by evaluating
+"Callback.register" \var{n} \var{v}. Here, \var{n} is the global name
+(an arbitrary string) and \var{v} the OCaml value. For instance:
+\begin{verbatim}
+ let f x = print_string "f is applied to "; print_int x; print_newline()
+ let _ = Callback.register "test function" f
+\end{verbatim}
+
+On the C side, a pointer to the value registered under name \var{n} is
+obtained by calling "caml_named_value("\var{n}")". The returned
+pointer must then be dereferenced to recover the actual OCaml value.
+If no value is registered under the name \var{n}, the null pointer is
+returned. For example, here is a C wrapper that calls the OCaml function "f"
+above:
+\begin{verbatim}
+ void call_caml_f(int arg)
+ {
+ caml_callback(*caml_named_value("test function"), Val_int(arg));
+ }
+\end{verbatim}
+
+The pointer returned by "caml_named_value" is constant and can safely
+be cached in a C variable to avoid repeated name lookups. The value
+pointed to cannot be changed from C. However, it might change during
+garbage collection, so must always be recomputed at the point of
+use. Here is a more efficient variant of "call_caml_f" above that
+calls "caml_named_value" only once:
+\begin{verbatim}
+ void call_caml_f(int arg)
+ {
+ static const value * closure_f = NULL;
+ if (closure_f == NULL) {
+ /* First time around, look up by name */
+ closure_f = caml_named_value("test function");
+ }
+ caml_callback(*closure_f, Val_int(arg));
+ }
+\end{verbatim}
+
+\subsection{ss:c-register-exn}{Registering OCaml exceptions for use in C functions}
+
+The registration mechanism described above can also be used to
+communicate exception identifiers from OCaml to C. The OCaml code
+registers the exception by evaluating
+"Callback.register_exception" \var{n} \var{exn}, where \var{n} is an
+arbitrary name and \var{exn} is an exception value of the
+exception to register. For example:
+\begin{verbatim}
+ exception Error of string
+ let _ = Callback.register_exception "test exception" (Error "any string")
+\end{verbatim}
+The C code can then recover the exception identifier using
+"caml_named_value" and pass it as first argument to the functions
+"raise_constant", "raise_with_arg", and "raise_with_string" (described
+in section~\ref{ss:c-exceptions}) to actually raise the exception. For
+example, here is a C function that raises the "Error" exception with
+the given argument:
+\begin{verbatim}
+ void raise_error(char * msg)
+ {
+ caml_raise_with_string(*caml_named_value("test exception"), msg);
+ }
+\end{verbatim}
+
+\subsection{ss:main-c}{Main program in C}
+
+In normal operation, a mixed OCaml/C program starts by executing the
+OCaml initialization code, which then may proceed to call C
+functions. We say that the main program is the OCaml code. In some
+applications, it is desirable that the C code plays the role of the
+main program, calling OCaml functions when needed. This can be achieved as
+follows:
+\begin{itemize}
+\item The C part of the program must provide a "main" function,
+which will override the default "main" function provided by the OCaml
+runtime system. Execution will start in the user-defined "main" function
+just like for a regular C program.
+
+\item At some point, the C code must call "caml_main(argv)" to
+initialize the OCaml code. The "argv" argument is a C array of strings
+(type "char **"), terminated with a "NULL" pointer,
+which represents the command-line arguments, as
+passed as second argument to "main". The OCaml array "Sys.argv" will
+be initialized from this parameter. For the bytecode compiler,
+"argv[0]" and "argv[1]" are also consulted to find the file containing
+the bytecode.
+
+\item The call to "caml_main" initializes the OCaml runtime system,
+loads the bytecode (in the case of the bytecode compiler), and
+executes the initialization code of the OCaml program. Typically, this
+initialization code registers callback functions using "Callback.register".
+Once the OCaml initialization code is complete, control returns to the
+C code that called "caml_main".
+
+\item The C code can then invoke OCaml functions using the callback
+mechanism (see section~\ref{ss:c-callbacks}).
+\end{itemize}
+
+\subsection{ss:c-embedded-code}{Embedding the OCaml code in the C code}
+
+The bytecode compiler in custom runtime mode ("ocamlc -custom")
+normally appends the bytecode to the executable file containing the
+custom runtime. This has two consequences. First, the final linking
+step must be performed by "ocamlc". Second, the OCaml runtime library
+must be able to find the name of the executable file from the
+command-line arguments. When using "caml_main(argv)" as in
+section~\ref{ss:main-c}, this means that "argv[0]" or "argv[1]" must
+contain the executable file name.
+
+An alternative is to embed the bytecode in the C code. The
+"-output-obj" and "-output-complete-obj" options to "ocamlc" are
+provided for this purpose. They cause the "ocamlc" compiler to output a
+C object file (".o" file, ".obj" under Windows) containing the
+bytecode for the OCaml part of the program, as well as a
+"caml_startup" function. The C object file produced by "ocamlc
+-output-complete-obj" also contains the runtime and autolink
+libraries. The C object file produced by "ocamlc -output-obj" or
+"ocamlc -output-complete-obj" can then be linked with C code using the
+standard C compiler, or stored in a C library.
+
+The "caml_startup" function must be called from the main C program in
+order to initialize the OCaml runtime and execute the OCaml
+initialization code. Just like "caml_main", it takes one "argv"
+parameter containing the command-line parameters. Unlike "caml_main",
+this "argv" parameter is used only to initialize "Sys.argv", but not
+for finding the name of the executable file.
+
+The "caml_startup" function calls the uncaught exception handler (or
+enters the debugger, if running under ocamldebug) if an exception escapes
+from a top-level module initialiser. Such exceptions may be caught in the
+C code by instead using the "caml_startup_exn" function and testing the result
+using {\tt Is_exception_result} (followed by {\tt Extract_exception} if
+appropriate).
+
+The "-output-obj" and "-output-complete-obj" options can also be used to
+obtain the C source file.
+More interestingly, these options can also produce
+directly a shared library (".so" file, ".dll" under Windows) that
+contains the OCaml code, the OCaml runtime system and any other static
+C code given to "ocamlc" (".o", ".a", respectively, ".obj", ".lib").
+This use of "-output-obj" and "-output-complete-obj"
+is very similar to a normal linking
+step, but instead of producing a main program that automatically runs
+the OCaml code, it produces a shared library that can run the OCaml
+code on demand. The three possible behaviors of "-output-obj"
+and "-output-complete-obj"
+(to produce a C source code ".c", a C object file ".o", a shared library ".so"),
+are selected according to the extension of the resulting file (given
+with "-o").
+
+The native-code compiler "ocamlopt" also supports the "-output-obj"
+and "-output-complete-obj" options, causing it to output a C object
+file or a shared library containing the native code for all OCaml
+modules on the command-line, as well as the OCaml startup code.
+Initialization is performed by calling "caml_startup" (or
+"caml_startup_exn") as in the case of the bytecode compiler. The file
+produced by "ocamlopt -output-complete-obj" also contains the runtime
+and autolink libraries.
+
+For the final linking phase, in addition to the object file produced
+by "-output-obj", you will have to provide the OCaml runtime
+library ("libcamlrun.a" for bytecode, "libasmrun.a" for native-code),
+as well as all C libraries that are required by the OCaml libraries
+used. For instance, assume the OCaml part of your program uses the
+Unix library. With "ocamlc", you should do:
+\begin{alltt}
+ ocamlc -output-obj -o camlcode.o unix.cma {\it{other}} .cmo {\it{and}} .cma {\it{files}}
+ cc -o myprog {\it{C objects and libraries}} \char92
+ camlcode.o -L`ocamlc -where` -lunix -lcamlrun
+\end{alltt}
+With "ocamlopt", you should do:
+\begin{alltt}
+ ocamlopt -output-obj -o camlcode.o unix.cmxa {\it{other}} .cmx {\it{and}} .cmxa {\it{files}}
+ cc -o myprog {\it{C objects and libraries}} \char92
+ camlcode.o -L`ocamlc -where` -lunix -lasmrun
+\end{alltt}
+
+% -- This seems completely wrong -- Damien
+% The shared libraries produced by "ocamlc -output-obj" or by "ocamlopt
+% -output-obj" already contains the OCaml runtime library as
+% well as all the needed C libraries.
+
+For the final linking phase, in addition to the object file produced
+by "-output-complete-obj", you will have only to provide the C
+libraries required by the OCaml runtime.
+
+For instance, assume the OCaml part of your program uses the
+Unix library. With "ocamlc", you should do:
+\begin{alltt}
+ ocamlc -output-complete-obj -o camlcode.o unix.cma {\it{other}} .cmo {\it{and}} .cma {\it{files}}
+ cc -o myprog {\it{C objects and libraries}} \char92
+ camlcode.o {\it{C libraries required by the runtime, eg -lm -ldl -lcurses -lpthread}}
+\end{alltt}
+With "ocamlopt", you should do:
+\begin{alltt}
+ ocamlopt -output-complete-obj -o camlcode.o unix.cmxa {\it{other}} .cmx {\it{and}} .cmxa {\it{files}}
+ cc -o myprog {\it{C objects and libraries}} \char92
+ camlcode.o {\it{C libraries required by the runtime, eg -lm -ldl}}
+\end{alltt}
+
+\paragraph{Warning:} On some ports, special options are required on the final
+linking phase that links together the object file produced by the
+"-output-obj" and "-output-complete-obj" options and the remainder of the program. Those options
+are shown in the configuration file "Makefile.config" generated during
+compilation of OCaml, as the variable "OC_LDFLAGS".
+\begin{itemize}
+\item Windows with the MSVC compiler: the object file produced by
+OCaml have been compiled with the "/MD" flag, and therefore
+all other object files linked with it should also be compiled with
+"/MD".
+\item other systems: you may have to add one or more of "-lcurses",
+"-lm", "-ldl", depending on your OS and C compiler.
+\end{itemize}
+
+\paragraph{Stack backtraces.} When OCaml bytecode produced by
+"ocamlc -g" is embedded in a C program, no debugging information is
+included, and therefore it is impossible to print stack backtraces on
+uncaught exceptions. This is not the case when native code produced
+by "ocamlopt -g" is embedded in a C program: stack backtrace
+information is available, but the backtrace mechanism needs to be
+turned on programmatically. This can be achieved from the OCaml side
+by calling "Printexc.record_backtrace true" in the initialization of
+one of the OCaml modules. This can also be achieved from the C side
+by calling "caml_record_backtraces(1);" in the OCaml-C glue code.
+("caml_record_backtraces" is declared in "backtrace.h")
+
+\paragraph{Unloading the runtime.}
+
+In case the shared library produced with "-output-obj" is to be loaded and
+unloaded repeatedly by a single process, care must be taken to unload the
+OCaml runtime explicitly, in order to avoid various system resource leaks.
+
+Since 4.05, "caml_shutdown" function can be used to shut the runtime down
+gracefully, which equals the following:
+\begin{itemize}
+\item Running the functions that were registered with "Stdlib.at_exit".
+\item Triggering finalization of allocated custom blocks (see
+section~\ref{s:c-custom}). For example, "Stdlib.in_channel" and
+"Stdlib.out_channel" are represented by custom blocks that enclose file
+descriptors, which are to be released.
+\item Unloading the dependent shared libraries that were loaded by the runtime,
+including "dynlink" plugins.
+\item Freeing the memory blocks that were allocated by the runtime with
+"malloc". Inside C primitives, it is advised to use "caml_stat_*" functions
+from "memory.h" for managing static (that is, non-moving) blocks of heap
+memory, as all the blocks allocated with these functions are automatically
+freed by "caml_shutdown". For ensuring compatibility with legacy C stubs that
+have used "caml_stat_*" incorrectly, this behaviour is only enabled if the
+runtime is started with a specialized "caml_startup_pooled" function.
+\end{itemize}
+
+As a shared library may have several clients simultaneously, it is made for
+convenience that "caml_startup" (and "caml_startup_pooled") may be called
+multiple times, given that each such call is paired with a corresponding call
+to "caml_shutdown" (in a nested fashion). The runtime will be unloaded once
+there are no outstanding calls to "caml_startup".
+
+Once a runtime is unloaded, it cannot be started up again without reloading the
+shared library and reinitializing its static data. Therefore, at the moment, the
+facility is only useful for building reloadable shared libraries.
+
+
+\section{s:c-advexample}{Advanced example with callbacks}
+
+This section illustrates the callback facilities described in
+section~\ref{s:c-callback}. We are going to package some OCaml functions
+in such a way that they can be linked with C code and called from C
+just like any C functions. The OCaml functions are defined in the
+following "mod.ml" OCaml source:
+
+\begin{verbatim}
+(* File mod.ml -- some "useful" OCaml functions *)
+
+let rec fib n = if n < 2 then 1 else fib(n-1) + fib(n-2)
+
+let format_result n = Printf.sprintf "Result is: %d\n" n
+
+(* Export those two functions to C *)
+
+let _ = Callback.register "fib" fib
+let _ = Callback.register "format_result" format_result
+\end{verbatim}
+
+Here is the C stub code for calling these functions from C:
+
+\begin{verbatim}
+/* File modwrap.c -- wrappers around the OCaml functions */
+
+#include <stdio.h>
+#include <string.h>
+#include <caml/mlvalues.h>
+#include <caml/callback.h>
+
+int fib(int n)
+{
+ static const value * fib_closure = NULL;
+ if (fib_closure == NULL) fib_closure = caml_named_value("fib");
+ return Int_val(caml_callback(*fib_closure, Val_int(n)));
+}
+
+char * format_result(int n)
+{
+ static const value * format_result_closure = NULL;
+ if (format_result_closure == NULL)
+ format_result_closure = caml_named_value("format_result");
+ return strdup(String_val(caml_callback(*format_result_closure, Val_int(n))));
+ /* We copy the C string returned by String_val to the C heap
+ so that it remains valid after garbage collection. */
+}
+\end{verbatim}
+
+We now compile the OCaml code to a C object file and put it in a C
+library along with the stub code in "modwrap.c" and the OCaml runtime system:
+\begin{verbatim}
+ ocamlc -custom -output-obj -o modcaml.o mod.ml
+ ocamlc -c modwrap.c
+ cp `ocamlc -where`/libcamlrun.a mod.a && chmod +w mod.a
+ ar r mod.a modcaml.o modwrap.o
+\end{verbatim}
+(One can also use "ocamlopt -output-obj" instead of "ocamlc -custom
+-output-obj". In this case, replace "libcamlrun.a" (the bytecode
+runtime library) by "libasmrun.a" (the native-code runtime library).)
+
+Now, we can use the two functions "fib" and "format_result" in any C
+program, just like regular C functions. Just remember to call
+"caml_startup" (or "caml_startup_exn") once before.
+
+\begin{verbatim}
+/* File main.c -- a sample client for the OCaml functions */
+
+#include <stdio.h>
+#include <caml/callback.h>
+
+extern int fib(int n);
+extern char * format_result(int n);
+
+int main(int argc, char ** argv)
+{
+ int result;
+
+ /* Initialize OCaml code */
+ caml_startup(argv);
+ /* Do some computation */
+ result = fib(10);
+ printf("fib(10) = %s\n", format_result(result));
+ return 0;
+}
+\end{verbatim}
+
+To build the whole program, just invoke the C compiler as follows:
+\begin{verbatim}
+ cc -o prog -I `ocamlc -where` main.c mod.a -lcurses
+\end{verbatim}
+(On some machines, you may need to put "-ltermcap" or
+"-lcurses -ltermcap" instead of "-lcurses".)
+
+\section{s:c-custom}{Advanced topic: custom blocks}
+
+Blocks with tag "Custom_tag" contain both arbitrary user data and a
+pointer to a C struct, with type "struct custom_operations", that
+associates user-provided finalization, comparison, hashing,
+serialization and deserialization functions to this block.
+
+\subsection{ss:c-custom-ops}{The "struct custom_operations"}
+
+The "struct custom_operations" is defined in "<caml/custom.h>" and
+contains the following fields:
+\begin{itemize}
+\item "char *identifier" \\
+A zero-terminated character string serving as an identifier for
+serialization and deserialization operations.
+
+\item "void (*finalize)(value v)" \\
+The "finalize" field contains a pointer to a C function that is called
+when the block becomes unreachable and is about to be reclaimed.
+The block is passed as first argument to the function.
+The "finalize" field can also be "custom_finalize_default" to indicate that no
+finalization function is associated with the block.
+
+\item "int (*compare)(value v1, value v2)" \\
+The "compare" field contains a pointer to a C function that is
+called whenever two custom blocks are compared using OCaml's generic
+comparison operators ("=", "<>", "<=", ">=", "<", ">" and
+"compare"). The C function should return 0 if the data contained in
+the two blocks are structurally equal, a negative integer if the data
+from the first block is less than the data from the second block, and
+a positive integer if the data from the first block is greater than
+the data from the second block.
+
+The "compare" field can be set to "custom_compare_default"; this
+default comparison function simply raises "Failure".
+
+\item "int (*compare_ext)(value v1, value v2)" \\
+(Since 3.12.1)
+The "compare_ext" field contains a pointer to a C function that is
+called whenever one custom block and one unboxed integer are compared using OCaml's generic
+comparison operators ("=", "<>", "<=", ">=", "<", ">" and
+"compare"). As in the case of the "compare" field, the C function
+should return 0 if the two arguments are structurally equal, a
+negative integer if the first argument compares less than the second
+argument, and a positive integer if the first argument compares
+greater than the second argument.
+
+The "compare_ext" field can be set to "custom_compare_ext_default"; this
+default comparison function simply raises "Failure".
+
+\item "intnat (*hash)(value v)" \\
+The "hash" field contains a pointer to a C function that is called
+whenever OCaml's generic hash operator (see module \stdmoduleref{Hashtbl}) is
+applied to a custom block. The C function can return an arbitrary
+integer representing the hash value of the data contained in the
+given custom block. The hash value must be compatible with the
+"compare" function, in the sense that two structurally equal data
+(that is, two custom blocks for which "compare" returns 0) must have
+the same hash value.
+
+The "hash" field can be set to "custom_hash_default", in which case
+the custom block is ignored during hash computation.
+
+\item "void (*serialize)(value v, uintnat * bsize_32, uintnat * bsize_64)" \\
+The "serialize" field contains a pointer to a C function that is
+called whenever the custom block needs to be serialized (marshaled)
+using the OCaml functions "output_value" or "Marshal.to_...".
+For a custom block, those functions first write the identifier of the
+block (as given by the "identifier" field) to the output stream,
+then call the user-provided "serialize" function. That function is
+responsible for writing the data contained in the custom block, using
+the "serialize_..." functions defined in "<caml/intext.h>" and listed
+below. The user-provided "serialize" function must then store in its
+"bsize_32" and "bsize_64" parameters the sizes in bytes of the data
+part of the custom block on a 32-bit architecture and on a 64-bit
+architecture, respectively.
+
+The "serialize" field can be set to "custom_serialize_default",
+in which case the "Failure" exception is raised when attempting to
+serialize the custom block.
+
+\item "uintnat (*deserialize)(void * dst)" \\
+The "deserialize" field contains a pointer to a C function that is
+called whenever a custom block with identifier "identifier" needs to
+be deserialized (un-marshaled) using the OCaml functions "input_value"
+or "Marshal.from_...". This user-provided function is responsible for
+reading back the data written by the "serialize" operation, using the
+"deserialize_..." functions defined in "<caml/intext.h>" and listed
+below. It must then rebuild the data part of the custom block
+and store it at the pointer given as the "dst" argument. Finally, it
+returns the size in bytes of the data part of the custom block.
+This size must be identical to the "wsize_32" result of
+the "serialize" operation if the architecture is 32 bits, or
+"wsize_64" if the architecture is 64 bits.
+
+The "deserialize" field can be set to "custom_deserialize_default"
+to indicate that deserialization is not supported. In this case,
+do not register the "struct custom_operations" with the deserializer
+using "register_custom_operations" (see below).
+
+\item "const struct custom_fixed_length* fixed_length" \\
+(Since 4.08.0)
+Normally, space in the serialized output is reserved to write the
+"bsize_32" and "bsize_64" fields returned by "serialize". However, for
+very short custom blocks, this space can be larger than the data
+itself! As a space optimisation, if "serialize" always returns the
+same values for "bsize_32" and "bsize_64", then these values may be
+specified in the "fixed_length" structure, and do not consume space in
+the serialized output.
+\end{itemize}
+
+Note: the "finalize", "compare", "hash", "serialize" and "deserialize"
+functions attached to custom block descriptors must never trigger a
+garbage collection. Within these functions, do not call any of the
+OCaml allocation functions, and do not perform a callback into OCaml
+code. Do not use "CAMLparam" to register the parameters to these
+functions, and do not use "CAMLreturn" to return the result.
+
+\subsection{ss:c-custom-alloc}{Allocating custom blocks}
+
+Custom blocks must be allocated via "caml_alloc_custom" or
+"caml_alloc_custom_mem":
+\begin{center}
+"caml_alloc_custom("\var{ops}", "\var{size}", "\var{used}", "\var{max}")"
+\end{center}
+returns a fresh custom block, with room for \var{size} bytes of user
+data, and whose associated operations are given by \var{ops} (a
+pointer to a "struct custom_operations", usually statically allocated
+as a C global variable).
+
+The two parameters \var{used} and \var{max} are used to control the
+speed of garbage collection when the finalized object contains
+pointers to out-of-heap resources. Generally speaking, the
+OCaml incremental major collector adjusts its speed relative to the
+allocation rate of the program. The faster the program allocates, the
+harder the GC works in order to reclaim quickly unreachable blocks
+and avoid having large amount of ``floating garbage'' (unreferenced
+objects that the GC has not yet collected).
+
+Normally, the allocation rate is measured by counting the in-heap size
+of allocated blocks. However, it often happens that finalized
+objects contain pointers to out-of-heap memory blocks and other resources
+(such as file descriptors, X Windows bitmaps, etc.). For those
+blocks, the in-heap size of blocks is not a good measure of the
+quantity of resources allocated by the program.
+
+The two arguments \var{used} and \var{max} give the GC an idea of how
+much out-of-heap resources are consumed by the finalized block
+being allocated: you give the amount of resources allocated to this
+object as parameter \var{used}, and the maximum amount that you want
+to see in floating garbage as parameter \var{max}. The units are
+arbitrary: the GC cares only about the ratio $\var{used} / \var{max}$.
+
+For instance, if you are allocating a finalized block holding an X
+Windows bitmap of \var{w} by \var{h} pixels, and you'd rather not
+have more than 1 mega-pixels of unreclaimed bitmaps, specify
+$\var{used} = \var{w} * \var{h}$ and $\var{max} = 1000000$.
+
+Another way to describe the effect of the \var{used} and \var{max}
+parameters is in terms of full GC cycles. If you allocate many custom
+blocks with $\var{used} / \var{max} = 1 / \var{N}$, the GC will then do one
+full cycle (examining every object in the heap and calling
+finalization functions on those that are unreachable) every \var{N}
+allocations. For instance, if $\var{used} = 1$ and $\var{max} = 1000$,
+the GC will do one full cycle at least every 1000 allocations of
+custom blocks.
+
+If your finalized blocks contain no pointers to out-of-heap resources,
+or if the previous discussion made little sense to you, just take
+$\var{used} = 0$ and $\var{max} = 1$. But if you later find that the
+finalization functions are not called ``often enough'', consider
+increasing the $\var{used} / \var{max}$ ratio.
+
+\begin{center}
+"caml_alloc_custom_mem("\var{ops}", "\var{size}", "\var{used}")"
+\end{center}
+Use this function when your custom block holds only out-of-heap memory
+(memory allocated with "malloc" or "caml_stat_alloc") and no other
+resources. "used" should be the number of bytes of out-of-heap
+memory that are held by your custom block. This function works like
+"caml_alloc_custom" except that the "max" parameter is under the
+control of the user (via the "custom_major_ratio",
+"custom_minor_ratio", and "custom_minor_max_size" parameters) and
+proportional to the heap sizes.
+
+\subsection{ss:c-custom-access}{Accessing custom blocks}
+
+The data part of a custom block \var{v} can be
+accessed via the pointer "Data_custom_val("\var{v}")". This pointer
+has type "void *" and should be cast to the actual type of the data
+stored in the custom block.
+
+The contents of custom blocks are not scanned by the garbage
+collector, and must therefore not contain any pointer inside the OCaml
+heap. In other terms, never store an OCaml "value" in a custom block,
+and do not use "Field", "Store_field" nor "caml_modify" to access the data
+part of a custom block. Conversely, any C data structure (not
+containing heap pointers) can be stored in a custom block.
+
+\subsection{ss:c-custom-serialization}{Writing custom serialization and deserialization functions}
+
+The following functions, defined in "<caml/intext.h>", are provided to
+write and read back the contents of custom blocks in a portable way.
+Those functions handle endianness conversions when e.g. data is
+written on a little-endian machine and read back on a big-endian machine.
+
+\begin{tableau}{|l|p{10cm}|}{Function}{Action}
+\entree{"caml_serialize_int_1"}{Write a 1-byte integer}
+\entree{"caml_serialize_int_2"}{Write a 2-byte integer}
+\entree{"caml_serialize_int_4"}{Write a 4-byte integer}
+\entree{"caml_serialize_int_8"}{Write a 8-byte integer}
+\entree{"caml_serialize_float_4"}{Write a 4-byte float}
+\entree{"caml_serialize_float_8"}{Write a 8-byte float}
+\entree{"caml_serialize_block_1"}{Write an array of 1-byte quantities}
+\entree{"caml_serialize_block_2"}{Write an array of 2-byte quantities}
+\entree{"caml_serialize_block_4"}{Write an array of 4-byte quantities}
+\entree{"caml_serialize_block_8"}{Write an array of 8-byte quantities}
+\entree{"caml_deserialize_uint_1"}{Read an unsigned 1-byte integer}
+\entree{"caml_deserialize_sint_1"}{Read a signed 1-byte integer}
+\entree{"caml_deserialize_uint_2"}{Read an unsigned 2-byte integer}
+\entree{"caml_deserialize_sint_2"}{Read a signed 2-byte integer}
+\entree{"caml_deserialize_uint_4"}{Read an unsigned 4-byte integer}
+\entree{"caml_deserialize_sint_4"}{Read a signed 4-byte integer}
+\entree{"caml_deserialize_uint_8"}{Read an unsigned 8-byte integer}
+\entree{"caml_deserialize_sint_8"}{Read a signed 8-byte integer}
+\entree{"caml_deserialize_float_4"}{Read a 4-byte float}
+\entree{"caml_deserialize_float_8"}{Read an 8-byte float}
+\entree{"caml_deserialize_block_1"}{Read an array of 1-byte quantities}
+\entree{"caml_deserialize_block_2"}{Read an array of 2-byte quantities}
+\entree{"caml_deserialize_block_4"}{Read an array of 4-byte quantities}
+\entree{"caml_deserialize_block_8"}{Read an array of 8-byte quantities}
+\entree{"caml_deserialize_error"}{Signal an error during deserialization;
+"input_value" or "Marshal.from_..." raise a "Failure" exception after
+cleaning up their internal data structures}
+\end{tableau}
+
+Serialization functions are attached to the custom blocks to which
+they apply. Obviously, deserialization functions cannot be attached
+this way, since the custom block does not exist yet when
+deserialization begins! Thus, the "struct custom_operations" that
+contain deserialization functions must be registered with the
+deserializer in advance, using the "register_custom_operations"
+function declared in "<caml/custom.h>". Deserialization proceeds by
+reading the identifier off the input stream, allocating a custom block
+of the size specified in the input stream, searching the registered
+"struct custom_operation" blocks for one with the same identifier, and
+calling its "deserialize" function to fill the data part of the custom block.
+
+\subsection{ss:c-custom-idents}{Choosing identifiers}
+
+Identifiers in "struct custom_operations" must be chosen carefully,
+since they must identify uniquely the data structure for serialization
+and deserialization operations. In particular, consider including a
+version number in the identifier; this way, the format of the data can
+be changed later, yet backward-compatible deserialisation functions
+can be provided.
+
+Identifiers starting with "_" (an underscore character) are reserved
+for the OCaml runtime system; do not use them for your custom
+data. We recommend to use a URL
+("http://mymachine.mydomain.com/mylibrary/version-number")
+or a Java-style package name
+("com.mydomain.mymachine.mylibrary.version-number")
+as identifiers, to minimize the risk of identifier collision.
+
+\subsection{ss:c-finalized}{Finalized blocks}
+
+Custom blocks generalize the finalized blocks that were present in
+OCaml prior to version 3.00. For backward compatibility, the
+format of custom blocks is compatible with that of finalized blocks,
+and the "alloc_final" function is still available to allocate a custom
+block with a given finalization function, but default comparison,
+hashing and serialization functions. "caml_alloc_final("\var{n}",
+"\var{f}", "\var{used}", "\var{max}")" returns a fresh custom block of
+size \var{n}+1 words, with finalization function \var{f}. The first
+word is reserved for storing the custom operations; the other
+\var{n} words are available for your data. The two parameters
+\var{used} and \var{max} are used to control the speed of garbage
+collection, as described for "caml_alloc_custom".
+
+\section{s:C-Bigarrays}{Advanced topic: Bigarrays and the OCaml-C interface}
+
+This section explains how C stub code that interfaces C or Fortran
+code with OCaml code can use Bigarrays.
+
+\subsection{ss:C-Bigarrays-include}{Include file}
+
+The include file "<caml/bigarray.h>" must be included in the C stub
+file. It declares the functions, constants and macros discussed
+below.
+
+\subsection{ss:C-Bigarrays-access}{Accessing an OCaml bigarray from C or Fortran}
+
+If \var{v} is a OCaml "value" representing a Bigarray, the expression
+"Caml_ba_data_val("\var{v}")" returns a pointer to the data part of the array.
+This pointer is of type "void *" and can be cast to the appropriate C
+type for the array (e.g. "double []", "char [][10]", etc).
+
+Various characteristics of the OCaml Bigarray can be consulted from C
+as follows:
+\begin{tableau}{|l|l|}{C expression}{Returns}
+\entree{"Caml_ba_array_val("\var{v}")->num_dims"}{number of dimensions}
+\entree{"Caml_ba_array_val("\var{v}")->dim["\var{i}"]"}{\var{i}-th dimension}
+\entree{"Caml_ba_array_val("\var{v}")->flags & BIGARRAY_KIND_MASK"}{kind of array elements}
+\end{tableau}
+The kind of array elements is one of the following constants:
+\begin{tableau}{|l|l|}{Constant}{Element kind}
+\entree{"CAML_BA_FLOAT32"}{32-bit single-precision floats}
+\entree{"CAML_BA_FLOAT64"}{64-bit double-precision floats}
+\entree{"CAML_BA_SINT8"}{8-bit signed integers}
+\entree{"CAML_BA_UINT8"}{8-bit unsigned integers}
+\entree{"CAML_BA_SINT16"}{16-bit signed integers}
+\entree{"CAML_BA_UINT16"}{16-bit unsigned integers}
+\entree{"CAML_BA_INT32"}{32-bit signed integers}
+\entree{"CAML_BA_INT64"}{64-bit signed integers}
+\entree{"CAML_BA_CAML_INT"}{31- or 63-bit signed integers}
+\entree{"CAML_BA_NATIVE_INT"}{32- or 64-bit (platform-native) integers}
+\end{tableau}
+%
+\paragraph{Warning:}
+"Caml_ba_array_val("\var{v}")" must always be dereferenced immediately and not stored
+anywhere, including local variables.
+It resolves to a derived pointer: it is not a valid OCaml value but points to
+a memory region managed by the GC. For this reason this value must not be
+stored in any memory location that could be live cross a GC.
+
+The following example shows the passing of a two-dimensional Bigarray
+to a C function and a Fortran function.
+\begin{verbatim}
+ extern void my_c_function(double * data, int dimx, int dimy);
+ extern void my_fortran_function_(double * data, int * dimx, int * dimy);
+
+ CAMLprim value caml_stub(value bigarray)
+ {
+ int dimx = Caml_ba_array_val(bigarray)->dim[0];
+ int dimy = Caml_ba_array_val(bigarray)->dim[1];
+ /* C passes scalar parameters by value */
+ my_c_function(Caml_ba_data_val(bigarray), dimx, dimy);
+ /* Fortran passes all parameters by reference */
+ my_fortran_function_(Caml_ba_data_val(bigarray), &dimx, &dimy);
+ return Val_unit;
+ }
+\end{verbatim}
+
+\subsection{ss:C-Bigarrays-wrap}{Wrapping a C or Fortran array as an OCaml Bigarray}
+
+A pointer \var{p} to an already-allocated C or Fortran array can be
+wrapped and returned to OCaml as a Bigarray using the "caml_ba_alloc"
+or "caml_ba_alloc_dims" functions.
+\begin{itemize}
+\item
+"caml_ba_alloc("\var{kind} "|" \var{layout}, \var{numdims}, \var{p}, \var{dims}")"
+
+Return an OCaml Bigarray wrapping the data pointed to by \var{p}.
+\var{kind} is the kind of array elements (one of the "CAML_BA_"
+kind constants above). \var{layout} is "CAML_BA_C_LAYOUT" for an
+array with C layout and "CAML_BA_FORTRAN_LAYOUT" for an array with
+Fortran layout. \var{numdims} is the number of dimensions in the
+array. \var{dims} is an array of \var{numdims} long integers, giving
+the sizes of the array in each dimension.
+
+\item
+"caml_ba_alloc_dims("\var{kind} "|" \var{layout}, \var{numdims},
+\var{p}, "(long) "\nth{dim}{1}, "(long) "\nth{dim}{2}, \ldots, "(long) "\nth{dim}{numdims}")"
+
+Same as "caml_ba_alloc", but the sizes of the array in each dimension
+are listed as extra arguments in the function call, rather than being
+passed as an array.
+\end{itemize}
+%
+The following example illustrates how statically-allocated C and
+Fortran arrays can be made available to OCaml.
+\begin{verbatim}
+ extern long my_c_array[100][200];
+ extern float my_fortran_array_[300][400];
+
+ CAMLprim value caml_get_c_array(value unit)
+ {
+ long dims[2];
+ dims[0] = 100; dims[1] = 200;
+ return caml_ba_alloc(CAML_BA_NATIVE_INT | CAML_BA_C_LAYOUT,
+ 2, my_c_array, dims);
+ }
+
+ CAMLprim value caml_get_fortran_array(value unit)
+ {
+ return caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_FORTRAN_LAYOUT,
+ 2, my_fortran_array_, 300L, 400L);
+ }
+\end{verbatim}
+
+\section{s:C-cheaper-call}{Advanced topic: cheaper C call}
+
+This section describe how to make calling C functions cheaper.
+
+{\bf Note:} this only applies to the native compiler. So whenever you
+use any of these methods, you have to provide an alternative byte-code
+stub that ignores all the special annotations.
+
+\subsection{ss:c-unboxed}{Passing unboxed values}
+
+We said earlier that all OCaml objects are represented by the C type
+"value", and one has to use macros such as "Int_val" to decode data from
+the "value" type. It is however possible to tell the OCaml native-code
+compiler to do this for us and pass arguments unboxed to the C function.
+Similarly it is possible to tell OCaml to expect the result unboxed and box
+it for us.
+
+The motivation is that, by letting `ocamlopt` deal with boxing, it can
+often decide to suppress it entirely.
+
+For instance let's consider this example:
+
+\begin{verbatim}
+external foo : float -> float -> float = "foo"
+
+let f a b =
+ let len = Array.length a in
+ assert (Array.length b = len);
+ let res = Array.make len 0. in
+ for i = 0 to len - 1 do
+ res.(i) <- foo a.(i) b.(i)
+ done
+\end{verbatim}
+
+Float arrays are unboxed in OCaml, however the C function "foo" expect
+its arguments as boxed floats and returns a boxed float. Hence the
+OCaml compiler has no choice but to box "a.(i)" and "b.(i)" and unbox
+the result of "foo". This results in the allocation of "3 * len"
+temporary float values.
+
+Now if we annotate the arguments and result with "[\@unboxed]", the
+native-code compiler will be able to avoid all these allocations:
+
+\begin{verbatim}
+external foo
+ : (float [@unboxed])
+ -> (float [@unboxed])
+ -> (float [@unboxed])
+ = "foo_byte" "foo"
+\end{verbatim}
+
+In this case the C functions must look like:
+
+\begin{verbatim}
+CAMLprim double foo(double a, double b)
+{
+ ...
+}
+
+CAMLprim value foo_byte(value a, value b)
+{
+ return caml_copy_double(foo(Double_val(a), Double_val(b)))
+}
+\end{verbatim}
+
+For convenience, when all arguments and the result are annotated with
+"[\@unboxed]", it is possible to put the attribute only once on the
+declaration itself. So we can also write instead:
+
+\begin{verbatim}
+external foo : float -> float -> float = "foo_byte" "foo" [@@unboxed]
+\end{verbatim}
+
+The following table summarize what OCaml types can be unboxed, and
+what C types should be used in correspondence:
+
+\begin{tableau}{|l|l|}{OCaml type}{C type}
+\entree{"float"}{"double"}
+\entree{"int32"}{"int32_t"}
+\entree{"int64"}{"int64_t"}
+\entree{"nativeint"}{"intnat"}
+\end{tableau}
+
+Similarly, it is possible to pass untagged OCaml integers between
+OCaml and C. This is done by annotating the arguments and/or result
+with "[\@untagged]":
+
+\begin{verbatim}
+external f : string -> (int [@untagged]) = "f_byte" "f"
+\end{verbatim}
+
+The corresponding C type must be "intnat".
+
+{\bf Note:} do not use the C "int" type in correspondence with "(int
+[\@untagged])". This is because they often differ in size.
+
+\subsection{ss:c-direct-call}{Direct C call}
+
+In order to be able to run the garbage collector in the middle of
+a C function, the OCaml native-code compiler generates some bookkeeping
+code around C calls. Technically it wraps every C call with the C function
+"caml_c_call" which is part of the OCaml runtime.
+
+For small functions that are called repeatedly, this indirection can have
+a big impact on performances. However this is not needed if we know that
+the C function doesn't allocate, doesn't raise exceptions, and doesn't release
+the master lock (see section~\ref{ss:parallel-execution-long-running-c-code}).
+We can instruct the OCaml native-code compiler of this fact by annotating the
+external declaration with the attribute "[\@\@noalloc]":
+
+\begin{verbatim}
+external bar : int -> int -> int = "foo" [@@noalloc]
+\end{verbatim}
+
+In this case calling "bar" from OCaml is as cheap as calling any other
+OCaml function, except for the fact that the OCaml compiler can't
+inline C functions...
+
+\subsection{ss:c-direct-call-example}{Example: calling C library functions without indirection}
+
+Using these attributes, it is possible to call C library functions
+with no indirection. For instance many math functions are defined this
+way in the OCaml standard library:
+
+\begin{verbatim}
+external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+ [@@unboxed] [@@noalloc]
+(** Square root. *)
+
+external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+(** Exponential. *)
+
+external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
+(** Natural logarithm. *)
+\end{verbatim}
+
+\section{s:C-multithreading}{Advanced topic: multithreading}
+
+Using multiple threads (shared-memory concurrency) in a mixed OCaml/C
+application requires special precautions, which are described in this
+section.
+
+\subsection{ss:c-thread-register}{Registering threads created from C}
+
+Callbacks from C to OCaml are possible only if the calling thread is
+known to the OCaml run-time system. Threads created from OCaml (through
+the "Thread.create" function of the system threads library) are
+automatically known to the run-time system. If the application
+creates additional threads from C and wishes to callback into OCaml
+code from these threads, it must first register them with the run-time
+system. The following functions are declared in the include file
+"<caml/threads.h>".
+
+\begin{itemize}
+\item
+"caml_c_thread_register()" registers the calling thread with the OCaml
+run-time system. Returns 1 on success, 0 on error. Registering an
+already-registered thread does nothing and returns 0.
+\item
+"caml_c_thread_unregister()" must be called before the thread
+ terminates, to unregister it from the OCaml run-time system.
+Returns 1 on success, 0 on error. If the calling thread was not
+previously registered, does nothing and returns 0.
+\end{itemize}
+
+\subsection{ss:parallel-execution-long-running-c-code}{Parallel execution of long-running C code}
+
+The OCaml run-time system is not reentrant: at any time, at most one
+thread can be executing OCaml code or C code that uses the OCaml
+run-time system. Technically, this is enforced by a ``master lock''
+that any thread must hold while executing such code.
+
+When OCaml calls the C code implementing a primitive, the master lock
+is held, therefore the C code has full access to the facilities of the
+run-time system. However, no other thread can execute OCaml code
+concurrently with the C code of the primitive.
+
+If a C primitive runs for a long time or performs potentially blocking
+input-output operations, it can explicitly release the master lock,
+enabling other OCaml threads to run concurrently with its operations.
+The C code must re-acquire the master lock before returning to OCaml.
+This is achieved with the following functions, declared in
+the include file "<caml/threads.h>".
+
+\begin{itemize}
+\item
+"caml_release_runtime_system()"
+The calling thread releases the master lock and other OCaml resources,
+enabling other threads to run OCaml code in parallel with the execution
+of the calling thread.
+\item
+"caml_acquire_runtime_system()"
+The calling thread re-acquires the master lock and other OCaml
+resources. It may block until no other thread uses the OCaml run-time
+system.
+\end{itemize}
+
+These functions poll for pending signals by calling asynchronous
+callbacks (section~\ref{ss:c-process-pending-actions}) before releasing and
+after acquiring the lock. They can therefore execute arbitrary OCaml
+code including raising an asynchronous exception.
+
+After "caml_release_runtime_system()" was called and until
+"caml_acquire_runtime_system()" is called, the C code must not access
+any OCaml data, nor call any function of the run-time system, nor call
+back into OCaml code. Consequently, arguments provided by OCaml to the
+C primitive must be copied into C data structures before calling
+"caml_release_runtime_system()", and results to be returned to OCaml
+must be encoded as OCaml values after "caml_acquire_runtime_system()"
+returns.
+
+Example: the following C primitive invokes "gethostbyname" to find the
+IP address of a host name. The "gethostbyname" function can block for
+a long time, so we choose to release the OCaml run-time system while it
+is running.
+\begin{verbatim}
+CAMLprim stub_gethostbyname(value vname)
+{
+ CAMLparam1 (vname);
+ CAMLlocal1 (vres);
+ struct hostent * h;
+ char * name;
+
+ /* Copy the string argument to a C string, allocated outside the
+ OCaml heap. */
+ name = caml_stat_strdup(String_val(vname));
+ /* Release the OCaml run-time system */
+ caml_release_runtime_system();
+ /* Resolve the name */
+ h = gethostbyname(name);
+ /* Free the copy of the string, which we might as well do before
+ acquiring the runtime system to benefit from parallelism. */
+ caml_stat_free(name);
+ /* Re-acquire the OCaml run-time system */
+ caml_acquire_runtime_system();
+ /* Encode the relevant fields of h as the OCaml value vres */
+ ... /* Omitted */
+ /* Return to OCaml */
+ CAMLreturn (vres);
+}
+\end{verbatim}
+
+Callbacks from C to OCaml must be performed while holding the master
+lock to the OCaml run-time system. This is naturally the case if the
+callback is performed by a C primitive that did not release the
+run-time system. If the C primitive released the run-time system
+previously, or the callback is performed from other C code that was
+not invoked from OCaml (e.g. an event loop in a GUI application), the
+run-time system must be acquired before the callback and released
+after:
+\begin{verbatim}
+ caml_acquire_runtime_system();
+ /* Resolve OCaml function vfun to be invoked */
+ /* Build OCaml argument varg to the callback */
+ vres = callback(vfun, varg);
+ /* Copy relevant parts of result vres to C data structures */
+ caml_release_runtime_system();
+\end{verbatim}
+
+Note: the "acquire" and "release" functions described above were
+introduced in OCaml 3.12. Older code uses the following historical
+names, declared in "<caml/signals.h>":
+\begin{itemize}
+\item "caml_enter_blocking_section" as an alias for
+ "caml_release_runtime_system"
+\item "caml_leave_blocking_section" as an alias for
+ "caml_acquire_runtime_system"
+\end{itemize}
+Intuition: a ``blocking section'' is a piece of C code that does not
+use the OCaml run-time system, typically a blocking input/output operation.
+
+\section{s:interfacing-windows-unicode-apis}{Advanced topic: interfacing with Windows Unicode APIs}
+
+This section contains some general guidelines for writing C stubs that use
+Windows Unicode APIs.
+
+The OCaml system under Windows can be configured at build time in one of two
+modes:
+
+\begin{itemize}
+
+\item {\bf legacy mode:} All path names, environment variables, command line
+arguments, etc. on the OCaml side are assumed to be encoded using the current
+8-bit code page of the system.
+
+\item {\bf Unicode mode:} All path names, environment variables, command line
+arguments, etc. on the OCaml side are assumed to be encoded using UTF-8.
+
+\end{itemize}
+
+In what follows, we say that a string has the \emph{OCaml encoding} if it is
+encoded in UTF-8 when in Unicode mode, in the current code page in legacy mode,
+or is an arbitrary string under Unix. A string has the \emph{platform encoding}
+if it is encoded in UTF-16 under Windows or is an arbitrary string under Unix.
+
+From the point of view of the writer of C stubs, the challenges of interacting
+with Windows Unicode APIs are twofold:
+
+\begin{itemize}
+
+\item The Windows API uses the UTF-16 encoding to support Unicode. The runtime
+system performs the necessary conversions so that the OCaml programmer only
+needs to deal with the OCaml encoding. C stubs that call Windows Unicode APIs
+need to use specific runtime functions to perform the necessary conversions in a
+compatible way.
+
+\item When writing stubs that need to be compiled under both Windows and Unix,
+the stubs need to be written in a way that allow the necessary conversions under
+Windows but that also work under Unix, where typically nothing particular needs
+to be done to support Unicode.
+
+\end{itemize}
+
+The native C character type under Windows is "WCHAR", two bytes wide, while
+under Unix it is "char", one byte wide. A type "char_os" is defined in
+"<caml/misc.h>" that stands for the concrete C character type of each
+platform. Strings in the platform encoding are of type "char_os *".
+
+The following functions are exposed to help write compatible C stubs. To use
+them, you need to include both "<caml/misc.h>" and "<caml/osdeps.h>".
+
+\begin{itemize}
+
+\item "char_os* caml_stat_strdup_to_os(const char *)" copies the argument while
+translating from OCaml encoding to the platform encoding. This function is
+typically used to convert the "char *" underlying an OCaml string before passing
+it to an operating system API that takes a Unicode argument. Under Unix, it is
+equivalent to "caml_stat_strdup".
+
+{\bf Note:} For maximum backwards compatibility in Unicode mode, if the argument
+is not a valid UTF-8 string, this function will fall back to assuming that it is
+encoded in the current code page.
+
+\item "char* caml_stat_strdup_of_os(const char_os *)" copies the argument while
+translating from the platform encoding to the OCaml encoding. It is the inverse
+of "caml_stat_strdup_to_os". This function is typically used to convert a string
+obtained from the operating system before passing it on to OCaml code. Under
+Unix, it is equivalent to "caml_stat_strdup".
+
+\item "value caml_copy_string_of_os(char_os *)" allocates an OCaml string with
+contents equal to the argument string converted to the OCaml encoding. This
+function is essentially equivalent to "caml_stat_strdup_of_os" followed by
+"caml_copy_string", except that it avoids the allocation of the intermediate
+string returned by "caml_stat_strdup_of_os". Under Unix, it is equivalent to
+"caml_copy_string".
+
+\end{itemize}
+
+{\bf Note:} The strings returned by "caml_stat_strdup_to_os" and
+"caml_stat_strdup_of_os" are allocated using "caml_stat_alloc", so they need to
+be deallocated using "caml_stat_free" when they are no longer needed.
+
+\paragraph{Example} We want to bind the function "getenv" in a way that works
+both under Unix and Windows. Under Unix this function has the prototype:
+
+\begin{verbatim}
+ char *getenv(const char *);
+\end{verbatim}
+While the Unicode version under Windows has the prototype:
+\begin{verbatim}
+ WCHAR *_wgetenv(const WCHAR *);
+\end{verbatim}
+
+In terms of "char_os", both functions take an argument of type "char_os *" and
+return a result of the same type. We begin by choosing the right implementation
+of the function to bind:
+
+\begin{verbatim}
+#ifdef _WIN32
+#define getenv_os _wgetenv
+#else
+#define getenv_os getenv
+#endif
+\end{verbatim}
+
+The rest of the binding is the same for both platforms:
+
+\begin{verbatim}
+#define CAML_NAME_SPACE
+
+#include <caml/mlvalues.h>
+#include <caml/misc.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+#include <stdlib.h>
+
+CAMLprim value stub_getenv(value var_name)
+{
+ CAMLparam1(var_name);
+ CAMLlocal1(var_value);
+ char_os *var_name_os, *var_value_os;
+
+ var_name_os = caml_stat_strdup_to_os(String_val(var_name));
+ var_value_os = getenv_os(var_name_os);
+ caml_stat_free(var_name_os);
+
+ if (var_value_os == NULL)
+ caml_raise_not_found();
+
+ var_value = caml_copy_string_of_os(var_value_os);
+
+ CAMLreturn(var_value);
+}
+\end{verbatim}
+
+\section{s:ocamlmklib}{Building mixed C/OCaml libraries: \texttt{ocamlmklib}}
+
+The "ocamlmklib" command facilitates the construction of libraries
+containing both OCaml code and C code, and usable both in static
+linking and dynamic linking modes. This command is available under
+Windows since Objective Caml 3.11 and under other operating systems since
+Objective Caml 3.03.
+
+The "ocamlmklib" command takes three kinds of arguments:
+\begin{itemize}
+\item OCaml source files and object files (".cmo", ".cmx", ".ml")
+comprising the OCaml part of the library;
+\item C object files (".o", ".a", respectively, ".obj", ".lib")
+ comprising the C part of the library;
+\item Support libraries for the C part ("-l"\var{lib}).
+\end{itemize}
+It generates the following outputs:
+\begin{itemize}
+\item An OCaml bytecode library ".cma" incorporating the ".cmo" and
+".ml" OCaml files given as arguments, and automatically referencing the
+C library generated with the C object files.
+\item An OCaml native-code library ".cmxa" incorporating the ".cmx" and
+".ml" OCaml files given as arguments, and automatically referencing the
+C library generated with the C object files.
+\item If dynamic linking is supported on the target platform, a
+".so" (respectively, ".dll") shared library built from the C object files given as arguments,
+and automatically referencing the support libraries.
+\item A C static library ".a"(respectively, ".lib") built from the C object files.
+\end{itemize}
+In addition, the following options are recognized:
+\begin{options}
+\item["-cclib", "-ccopt", "-I", "-linkall"]
+These options are passed as is to "ocamlc" or "ocamlopt".
+See the documentation of these commands.
+\item["-rpath", "-R", "-Wl,-rpath", "-Wl,-R"]
+These options are passed as is to the C compiler. Refer to the
+documentation of the C compiler.
+\item["-custom"] Force the construction of a statically linked library
+only, even if dynamic linking is supported.
+\item["-failsafe"] Fall back to building a statically linked library
+if a problem occurs while building the shared library (e.g. some of
+the support libraries are not available as shared libraries).
+\item["-L"\var{dir}] Add \var{dir} to the search path for support
+libraries ("-l"\var{lib}).
+\item["-ocamlc" \var{cmd}] Use \var{cmd} instead of "ocamlc" to call
+the bytecode compiler.
+\item["-ocamlopt" \var{cmd}] Use \var{cmd} instead of "ocamlopt" to call
+the native-code compiler.
+\item["-o" \var{output}] Set the name of the generated OCaml library.
+"ocamlmklib" will generate \var{output}".cma" and/or \var{output}".cmxa".
+If not specified, defaults to "a".
+\item["-oc" \var{outputc}] Set the name of the generated C library.
+"ocamlmklib" will generate "lib"\var{outputc}".so" (if shared
+libraries are supported) and "lib"\var{outputc}".a".
+If not specified, defaults to the output name given with "-o".
+\end{options}
+
+\noindent
+On native Windows, the following environment variable is also consulted:
+
+\begin{options}
+\item["OCAML_FLEXLINK"] Alternative executable to use instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\paragraph{Example} Consider an OCaml interface to the standard "libz"
+C library for reading and writing compressed files. Assume this
+library resides in "/usr/local/zlib". This interface is
+composed of an OCaml part "zip.cmo"/"zip.cmx" and a C part "zipstubs.o"
+containing the stub code around the "libz" entry points. The
+following command builds the OCaml libraries "zip.cma" and "zip.cmxa",
+as well as the companion C libraries "dllzip.so" and "libzip.a":
+\begin{verbatim}
+ocamlmklib -o zip zip.cmo zip.cmx zipstubs.o -lz -L/usr/local/zlib
+\end{verbatim}
+If shared libraries are supported, this performs the following
+commands:
+\begin{verbatim}
+ocamlc -a -o zip.cma zip.cmo -dllib -lzip \
+ -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
+ocamlopt -a -o zip.cmxa zip.cmx -cclib -lzip \
+ -cclib -lzip -cclib -lz -ccopt -L/usr/local/zlib
+gcc -shared -o dllzip.so zipstubs.o -lz -L/usr/local/zlib
+ar rc libzip.a zipstubs.o
+\end{verbatim}
+Note: This example is on a Unix system. The exact command lines
+may be different on other systems.
+
+If shared libraries are not supported, the following commands are
+performed instead:
+\begin{verbatim}
+ocamlc -a -custom -o zip.cma zip.cmo -cclib -lzip \
+ -cclib -lz -ccopt -L/usr/local/zlib
+ocamlopt -a -o zip.cmxa zip.cmx -lzip \
+ -cclib -lz -ccopt -L/usr/local/zlib
+ar rc libzip.a zipstubs.o
+\end{verbatim}
+Instead of building simultaneously the bytecode library, the
+native-code library and the C libraries, "ocamlmklib" can be called
+three times to build each separately. Thus,
+\begin{verbatim}
+ocamlmklib -o zip zip.cmo -lz -L/usr/local/zlib
+\end{verbatim}
+builds the bytecode library "zip.cma", and
+\begin{verbatim}
+ocamlmklib -o zip zip.cmx -lz -L/usr/local/zlib
+\end{verbatim}
+builds the native-code library "zip.cmxa", and
+\begin{verbatim}
+ocamlmklib -o zip zipstubs.o -lz -L/usr/local/zlib
+\end{verbatim}
+builds the C libraries "dllzip.so" and "libzip.a". Notice that the
+support libraries ("-lz") and the corresponding options
+("-L/usr/local/zlib") must be given on all three invocations of "ocamlmklib",
+because they are needed at different times depending on whether shared
+libraries are supported.
+
+
+\section{s:c-internal-guidelines}{Cautionary words: the internal runtime API}
+
+Not all header available in the "caml/" directory were described in previous
+sections. All those unmentioned headers are part of the internal runtime API,
+for which there is \emph{no} stability guarantee. If you really need access
+to this internal runtime API, this section provides some guidelines
+that may help you to write code that might not break on every new version
+of OCaml.
+\paragraph{Note} Programmers which come to rely on the internal API
+for a use-case which they find realistic and useful are encouraged to open
+a request for improvement on the bug tracker.
+
+\subsection{ss:c-internals}{Internal variables and CAML_INTERNALS}
+Since OCaml 4.04, it is possible to get access to every part of the internal
+runtime API by defining the "CAML_INTERNALS" macro before loading caml header files.
+If this macro is not defined, parts of the internal runtime API are hidden.
+
+If you are using internal C variables, do not redefine them by hand. You should
+import those variables by including the corresponding header files. The
+representation of those variables has already changed once in OCaml 4.10, and is
+still under evolution.
+If your code relies on such internal and brittle properties, it will be broken
+at some point in time.
+
+For instance, rather than redefining "caml_young_limit":
+\begin{verbatim}
+extern int caml_young_limit;
+\end{verbatim}
+which breaks in OCaml $\ge$ 4.10, you should include the "minor_gc" header:
+\begin{verbatim}
+#include <caml/minor_gc.h>
+\end{verbatim}
+
+\subsection{ss:c-internal-macros}{OCaml version macros}
+Finally, if including the right headers is not enough, or if you need to support
+version older than OCaml 4.04, the header file "caml/version.h" should help
+you to define your own compatibility layer.
+This file provides few macros defining the current OCaml version.
+In particular, the "OCAML_VERSION" macro describes the current version,
+its format is "MmmPP".
+For example, if you need some specific handling for versions older than 4.10.0,
+you could write
+\begin{verbatim}
+#include <caml/version.h>
+#if OCAML_VERSION >= 41000
+...
+#else
+...
+#endif
+\end{verbatim}
--- /dev/null
+\chapter{Lexer and parser generators (ocamllex, ocamlyacc)}
+\label{c:ocamlyacc}
+%HEVEA\cutname{lexyacc.html}
+
+This chapter describes two program generators: "ocamllex", that
+produces a lexical analyzer from a set of regular expressions with
+associated semantic actions, and "ocamlyacc", that produces a parser
+from a grammar with associated semantic actions.
+
+These program generators are very close to the well-known "lex" and
+"yacc" commands that can be found in most C programming environments.
+This chapter assumes a working knowledge of "lex" and "yacc": while
+it describes the input syntax for "ocamllex" and "ocamlyacc" and the
+main differences with "lex" and "yacc", it does not explain the basics
+of writing a lexer or parser description in "lex" and "yacc". Readers
+unfamiliar with "lex" and "yacc" are referred to ``Compilers:
+principles, techniques, and tools'' by Aho, Lam, Sethi and Ullman
+(Pearson, 2006), or ``Lex $\&$ Yacc'', by Levine, Mason and
+Brown (O'Reilly, 1992).
+
+\section{s:ocamllex-overview}{Overview of \texttt{ocamllex}}
+
+The "ocamllex" command produces a lexical analyzer from a set of regular
+expressions with attached semantic actions, in the style of
+"lex". Assuming the input file is \var{lexer}".mll", executing
+\begin{alltt}
+ ocamllex \var{lexer}.mll
+\end{alltt}
+produces OCaml code for a lexical analyzer in file \var{lexer}".ml".
+This file defines one lexing function per entry point in the lexer
+definition. These functions have the same names as the entry
+points. Lexing functions take as argument a lexer buffer, and return
+the semantic attribute of the corresponding entry point.
+
+Lexer buffers are an abstract data type implemented in the standard
+library module "Lexing". The functions "Lexing.from_channel",
+"Lexing.from_string" and "Lexing.from_function" create
+lexer buffers that read from an input channel, a character string, or
+any reading function, respectively. (See the description of module
+"Lexing" in chapter~\ref{c:stdlib}.)
+
+When used in conjunction with a parser generated by "ocamlyacc", the
+semantic actions compute a value belonging to the type "token" defined
+by the generated parsing module. (See the description of "ocamlyacc"
+below.)
+
+\subsection{ss:ocamllex-options}{Options}
+The following command-line options are recognized by "ocamllex".
+
+\begin{options}
+
+\item["-ml"]
+Output code that does not use OCaml's built-in automata
+interpreter. Instead, the automaton is encoded by OCaml functions.
+This option improves performance when using the native compiler, but
+decreases it when using the bytecode compiler.
+
+\item["-o" \var{output-file}]
+Specify the name of the output file produced by "ocamllex".
+The default is the input file name with its extension replaced by ".ml".
+
+\item["-q"]
+Quiet mode. "ocamllex" normally outputs informational messages
+to standard output. They are suppressed if option "-q" is used.
+
+\item["-v" or "-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamllex-syntax}{Syntax of lexer definitions}
+
+The format of lexer definitions is as follows:
+\begin{alltt}
+\{ \var{header} \}
+let \var{ident} = \var{regexp} \ldots
+[refill \{ \var{refill-handler} \}]
+rule \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
+ parse \var{regexp} \{ \var{action} \}
+ | \ldots
+ | \var{regexp} \{ \var{action} \}
+and \var{entrypoint} [\nth{arg}{1}\ldots{} \nth{arg}{n}] =
+ parse \ldots
+and \ldots
+\{ \var{trailer} \}
+\end{alltt}
+Comments are delimited by "(*" and "*)", as in OCaml.
+The "parse" keyword, can be replaced by the "shortest" keyword, with
+the semantic consequences explained below.
+
+Refill handlers are a recent (optional) feature introduced in 4.02,
+documented below in subsection~\ref{ss:refill-handlers}.
+
+\subsection{ss:ocamllex-header-trailer}{Header and trailer}
+The {\it header} and {\it trailer} sections are arbitrary OCaml
+text enclosed in curly braces. Either or both can be omitted. If
+present, the header text is copied as is at the beginning of the
+output file and the trailer text at the end. Typically, the
+header section contains the "open" directives required
+by the actions, and possibly some auxiliary functions used in the
+actions.
+
+\subsection{ss:ocamllex-named-regexp}{Naming regular expressions}
+
+Between the header and the entry points, one can give names to
+frequently-occurring regular expressions. This is written
+@"let" ident "=" regexp@.
+In regular expressions that follow this declaration, the identifier
+\var{ident} can be used as shorthand for \var{regexp}.
+
+\subsection{ss:ocamllex-entry-points}{Entry points}
+
+The names of the entry points must be valid identifiers for OCaml
+values (starting with a lowercase letter).
+Similarly, the arguments \texttt{\var{arg$_1$}\ldots{}
+\var{arg$_n$}} must be valid identifiers for OCaml.
+Each entry point becomes an
+OCaml function that takes $n+1$ arguments,
+the extra implicit last argument being of type "Lexing.lexbuf".
+Characters are read from the "Lexing.lexbuf" argument and matched
+against the regular expressions provided in the rule, until a prefix
+of the input matches one of the rule. The corresponding action is
+then evaluated and returned as the result of the function.
+
+
+If several regular expressions match a prefix of the input, the
+``longest match'' rule applies: the regular expression that matches
+the longest prefix of the input is selected. In case of tie, the
+regular expression that occurs earlier in the rule is selected.
+
+However, if lexer rules are introduced with the "shortest" keyword in
+place of the "parse" keyword, then the ``shortest match'' rule applies:
+the shortest prefix of the input is selected. In case of tie, the
+regular expression that occurs earlier in the rule is still selected.
+This feature is not intended for use in ordinary lexical analyzers, it
+may facilitate the use of "ocamllex" as a simple text processing tool.
+
+
+
+\subsection{ss:ocamllex-regexp}{Regular expressions}
+
+The regular expressions are in the style of "lex", with a more
+OCaml-like syntax.
+\begin{syntax}
+regexp:
+ \ldots
+\end{syntax}
+\begin{options}
+
+\item[@"'" regular-char || escape-sequence "'"@]
+A character constant, with the same syntax as OCaml character
+constants. Match the denoted character.
+
+\item["_"]
+(underscore) Match any character.
+
+\item[@"eof"@]
+Match the end of the lexer input.\\
+{\bf Note:} On some systems, with interactive input, an end-of-file
+may be followed by more characters. However, "ocamllex" will not
+correctly handle regular expressions that contain "eof" followed by
+something else.
+
+\item[@'"' { string-character } '"'@]
+A string constant, with the same syntax as OCaml string
+constants. Match the corresponding sequence of characters.
+
+\item[@'[' character-set ']'@]
+Match any single character belonging to the given
+character set. Valid character sets are: single
+character constants @"'" @c@ "'"@; ranges of characters
+@"'" @c@_1 "'" "-" "'" @c@_2 "'"@ (all characters between $c_1$ and $c_2$,
+inclusive); and the union of two or more character sets, denoted by
+concatenation.
+
+\item[@'[' '^' character-set ']'@]
+Match any single character not belonging to the given character set.
+
+
+\item[@regexp_1 '#' regexp_2@]
+(difference of character sets)
+Regular expressions @regexp_1@ and @regexp_2@ must be character sets
+defined with @'['\ldots ']'@ (or a single character expression or
+underscore "_").
+Match the difference of the two specified character sets.
+
+
+\item[@regexp '*'@]
+(repetition) Match the concatenation of zero or more
+strings that match @regexp@.
+
+\item[@regexp '+'@]
+(strict repetition) Match the concatenation of one or more
+strings that match @regexp@.
+
+\item[@regexp '?'@]
+(option) Match the empty string, or a string matching @regexp@.
+
+\item[@regexp_1 '|' regexp_2@]
+(alternative) Match any string that matches @regexp_1@ or @regexp_2@
+
+\item[@regexp_1 regexp_2@]
+(concatenation) Match the concatenation of two strings, the first
+matching @regexp_1@, the second matching @regexp_2@.
+
+\item[@'(' regexp ')'@]
+Match the same strings as @regexp@.
+
+\item[@ident@]
+Reference the regular expression bound to @ident@ by an earlier
+@"let" ident "=" regexp@ definition.
+
+\item[@regexp 'as' ident@]
+Bind the substring matched by @regexp@ to identifier @ident@.
+\end{options}
+
+Concerning the precedences of operators, "#" has the highest precedence,
+followed by "*", "+" and "?",
+then concatenation, then "|" (alternation), then "as".
+
+\subsection{ss:ocamllex-actions}{Actions}
+
+The actions are arbitrary OCaml expressions. They are evaluated in
+a context where the identifiers defined by using the "as" construct
+are bound to subparts of the matched string.
+Additionally, "lexbuf" is bound to the current lexer
+buffer. Some typical uses for "lexbuf", in conjunction with the
+operations on lexer buffers provided by the "Lexing" standard library
+module, are listed below.
+
+\begin{options}
+\item["Lexing.lexeme lexbuf"]
+Return the matched string.
+
+\item["Lexing.lexeme_char lexbuf "$n$]
+Return the $n\th$
+character in the matched string. The first character corresponds to $n = 0$.
+
+\item["Lexing.lexeme_start lexbuf"]
+Return the absolute position in the input text of the beginning of the
+matched string (i.e. the offset of the first character of the matched
+string). The first character read from the input text has offset 0.
+
+\item["Lexing.lexeme_end lexbuf"]
+Return the absolute position in the input text of the end of the
+matched string (i.e. the offset of the first character after the
+matched string). The first character read from the input text has
+offset 0.
+
+\newcommand{\sub}[1]{$_{#1}$}%
+\item[\var{entrypoint} {[\var{exp\sub{1}}\ldots{} \var{exp\sub{n}}]} "lexbuf"]
+(Where \var{entrypoint} is the name of another entry point in the same
+lexer definition.) Recursively call the lexer on the given entry point.
+Notice that "lexbuf" is the last argument.
+Useful for lexing nested comments, for example.
+
+\end{options}
+
+\subsection{ss:ocamllex-variables}{Variables in regular expressions}
+The "as" construct is similar to ``\emph{groups}'' as provided by
+numerous regular expression packages.
+The type of these variables can be "string", "char", "string option"
+or "char option".
+
+We first consider the case of linear patterns, that is the case when
+all "as" bound variables are distinct.
+In @regexp 'as' ident@, the type of @ident@ normally is "string" (or
+"string option") except
+when @regexp@ is a character constant, an underscore, a string
+constant of length one, a character set specification, or an
+alternation of those. Then, the type of @ident@ is "char" (or "char
+option").
+Option types are introduced when overall rule matching does not
+imply matching of the bound sub-pattern. This is in particular the
+case of @'(' regexp 'as' ident ')' '?'@ and of
+@regexp_1 '|' '(' regexp_2 'as' ident ')'@.
+
+There is no linearity restriction over "as" bound variables.
+When a variable is bound more than once, the previous rules are to be
+extended as follows:
+\begin{itemize}
+\item A variable is a "char" variable when all its occurrences bind
+"char" occurrences in the previous sense.
+\item A variable is an "option" variable when the overall expression
+can be matched without binding this variable.
+\end{itemize}
+For instance, in
+"('a' as x) | ( 'a' (_ as x) )" the variable "x" is of type
+"char", whereas in
+"(\"ab\" as x) | ( 'a' (_ as x) ? )" the variable "x" is of type
+"string option".
+
+
+In some cases, a successful match may not yield a unique set of bindings.
+For instance the matching of \verb+aba+ by the regular expression
+"(('a'|\"ab\") as x) ((\"ba\"|'a') as y)" may result in binding
+either
+\verb+x+ to \verb+"ab"+ and \verb+y+ to \verb+"a"+, or
+\verb+x+ to \verb+"a"+ and \verb+y+ to \verb+"ba"+.
+The automata produced "ocamllex" on such ambiguous regular
+expressions will select one of the possible resulting sets of
+bindings.
+The selected set of bindings is purposely left unspecified.
+
+\subsection{ss:refill-handlers}{Refill handlers}
+
+By default, when ocamllex reaches the end of its lexing buffer, it
+will silently call the "refill_buff" function of "lexbuf" structure
+and continue lexing. It is sometimes useful to be able to take control
+of refilling action; typically, if you use a library for asynchronous
+computation, you may want to wrap the refilling action in a delaying
+function to avoid blocking synchronous operations.
+
+Since OCaml 4.02, it is possible to specify a \var{refill-handler},
+a function that will be called when refill happens. It is passed the
+continuation of the lexing, on which it has total control. The OCaml
+expression used as refill action should have a type that is an
+instance of
+\begin{verbatim}
+ (Lexing.lexbuf -> 'a) -> Lexing.lexbuf -> 'a
+\end{verbatim}
+where the first argument is the continuation which captures the
+processing ocamllex would usually perform (refilling the buffer, then
+calling the lexing function again), and the result type that
+instantiates ['a] should unify with the result type of all lexing
+rules.
+
+As an example, consider the following lexer that is parametrized over
+an arbitrary monad:
+\begin{verbatim}
+{
+type token = EOL | INT of int | PLUS
+
+module Make (M : sig
+ type 'a t
+ val return: 'a -> 'a t
+ val bind: 'a t -> ('a -> 'b t) -> 'b t
+ val fail : string -> 'a t
+
+ (* Set up lexbuf *)
+ val on_refill : Lexing.lexbuf -> unit t
+ end)
+= struct
+
+let refill_handler k lexbuf =
+ M.bind (M.on_refill lexbuf) (fun () -> k lexbuf)
+
+}
+
+refill {refill_handler}
+
+rule token = parse
+| [' ' '\t']
+ { token lexbuf }
+| '\n'
+ { M.return EOL }
+| ['0'-'9']+ as i
+ { M.return (INT (int_of_string i)) }
+| '+'
+ { M.return PLUS }
+| _
+ { M.fail "unexpected character" }
+{
+end
+}
+\end{verbatim}
+
+\subsection{ss:ocamllex-reserved-ident}{Reserved identifiers}
+
+All identifiers starting with "__ocaml_lex" are reserved for use by
+"ocamllex"; do not use any such identifier in your programs.
+
+
+\section{s:ocamlyacc-overview}{Overview of \texttt{ocamlyacc}}
+
+The "ocamlyacc" command produces a parser from a context-free grammar
+specification with attached semantic actions, in the style of "yacc".
+Assuming the input file is \var{grammar}".mly", executing
+\begin{alltt}
+ ocamlyacc \var{options} \var{grammar}.mly
+\end{alltt}
+produces OCaml code for a parser in the file \var{grammar}".ml",
+and its interface in file \var{grammar}".mli".
+
+The generated module defines one parsing function per entry point in
+the grammar. These functions have the same names as the entry points.
+Parsing functions take as arguments a lexical analyzer (a function
+from lexer buffers to tokens) and a lexer buffer, and return the
+semantic attribute of the corresponding entry point. Lexical analyzer
+functions are usually generated from a lexer specification by the
+"ocamllex" program. Lexer buffers are an abstract data type
+implemented in the standard library module "Lexing". Tokens are values from
+the concrete type "token", defined in the interface file
+\var{grammar}".mli" produced by "ocamlyacc".
+
+\section{s:ocamlyacc-syntax}{Syntax of grammar definitions}
+
+Grammar definitions have the following format:
+\begin{alltt}
+\%\{
+ \var{header}
+\%\}
+ \var{declarations}
+\%\%
+ \var{rules}
+\%\%
+ \var{trailer}
+\end{alltt}
+
+Comments are enclosed between \verb|/*| and \verb|*/| (as in C) in the
+``declarations'' and ``rules'' sections, and between \verb|(*| and
+\verb|*)| (as in OCaml) in the ``header'' and ``trailer'' sections.
+
+\subsection{ss:ocamlyacc-header-trailer}{Header and trailer}
+
+The header and the trailer sections are OCaml code that is copied
+as is into file \var{grammar}".ml". Both sections are optional. The header
+goes at the beginning of the output file; it usually contains
+"open" directives and auxiliary functions required by the semantic
+actions of the rules. The trailer goes at the end of the output file.
+
+\subsection{ss:ocamlyacc-declarations}{Declarations}
+
+Declarations are given one per line. They all start with a \verb"%" sign.
+
+\begin{options}
+
+\item[@"%token" constr \ldots constr@]
+Declare the given symbols @constr \ldots constr@
+as tokens (terminal symbols). These symbols
+are added as constant constructors for the "token" concrete type.
+
+\item[@"%token" "<" typexpr ">" constr \ldots constr@]
+Declare the given symbols @constr \ldots constr@ as tokens with an
+attached attribute of the
+given type. These symbols are added as constructors with arguments of
+the given type for the "token" concrete type. The @typexpr@ part is
+an arbitrary OCaml type expression, except that all type
+constructor names must be fully qualified (e.g. "Modname.typename")
+for all types except standard built-in types, even if the proper
+\verb|open| directives (e.g. \verb|open Modname|) were given in the
+header section. That's because the header is copied only to the ".ml"
+output file, but not to the ".mli" output file, while the @typexpr@ part
+of a \verb"%token" declaration is copied to both.
+
+\item[@"%start" symbol \ldots symbol@]
+Declare the given symbols as entry points for the grammar. For each
+entry point, a parsing function with the same name is defined in the
+output module. Non-terminals that are not declared as entry points
+have no such parsing function. Start symbols must be given a type with
+the \verb|%type| directive below.
+
+\item[@"%type" "<" typexpr ">" symbol \ldots symbol@]
+Specify the type of the semantic attributes for the given symbols.
+This is mandatory for start symbols only. Other nonterminal symbols
+need not be given types by hand: these types will be inferred when
+running the output files through the OCaml compiler (unless the
+\verb"-s" option is in effect). The @typexpr@ part is an arbitrary OCaml
+type expression, except that all type constructor names must be
+fully qualified, as explained above for "%token".
+
+\item[@"%left" symbol \ldots symbol@]
+\item[@"%right" symbol \ldots symbol@]
+\item[@"%nonassoc" symbol \ldots symbol@]
+
+Associate precedences and associativities to the given symbols. All
+symbols on the same line are given the same precedence. They have
+higher precedence than symbols declared before in a \verb"%left",
+\verb"%right" or \verb"%nonassoc" line. They have lower precedence
+than symbols declared after in a \verb"%left", \verb"%right" or
+\verb"%nonassoc" line. The symbols are declared to associate to the
+left (\verb"%left"), to the right (\verb"%right"), or to be
+non-associative (\verb"%nonassoc"). The symbols are usually tokens.
+They can also be dummy nonterminals, for use with the \verb"%prec"
+directive inside the rules.
+
+The precedence declarations are used in the following way to
+resolve reduce/reduce and shift/reduce conflicts:
+\begin{itemize}
+\item Tokens and rules have precedences. By default, the precedence
+ of a rule is the precedence of its rightmost terminal. You
+ can override this default by using the @"%prec"@ directive in the rule.
+\item A reduce/reduce conflict
+ is resolved in favor of the first rule (in the order given by the
+ source file), and "ocamlyacc" outputs a warning.
+\item A shift/reduce conflict
+ is resolved by comparing the precedence of the rule to be
+ reduced with the precedence of the token to be shifted. If the
+ precedence of the rule is higher, then the rule will be reduced;
+ if the precedence of the token is higher, then the token will
+ be shifted.
+\item A shift/reduce conflict between a rule and a token with the
+ same precedence will be resolved using the associativity: if the
+ token is left-associative, then the parser will reduce; if the
+ token is right-associative, then the parser will shift. If the
+ token is non-associative, then the parser will declare a syntax
+ error.
+\item When a shift/reduce conflict cannot be resolved using the above
+ method, then "ocamlyacc" will output a warning and the parser will
+ always shift.
+\end{itemize}
+
+\end{options}
+
+\subsection{ss:ocamlyacc-rules}{Rules}
+
+The syntax for rules is as usual:
+\begin{alltt}
+\var{nonterminal} :
+ \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
+ | \ldots
+ | \var{symbol} \ldots \var{symbol} \{ \var{semantic-action} \}
+;
+\end{alltt}
+%
+Rules can also contain the \verb"%prec "{\it symbol} directive in the
+right-hand side part, to override the default precedence and
+associativity of the rule with the precedence and associativity of the
+given symbol.
+
+Semantic actions are arbitrary OCaml expressions, that
+are evaluated to produce the semantic attribute attached to
+the defined nonterminal. The semantic actions can access the
+semantic attributes of the symbols in the right-hand side of
+the rule with the \verb"$" notation: \verb"$1" is the attribute for the
+first (leftmost) symbol, \verb"$2" is the attribute for the second
+symbol, etc.
+
+The rules may contain the special symbol "error" to indicate
+resynchronization points, as in "yacc".
+
+Actions occurring in the middle of rules are not supported.
+
+Nonterminal symbols are like regular OCaml symbols, except that they
+cannot end with "'" (single quote).
+
+\subsection{ss:ocamlyacc-error-handling}{Error handling}
+
+Error recovery is supported as follows: when the parser reaches an
+error state (no grammar rules can apply), it calls a function named
+"parse_error" with the string "\"syntax error\"" as argument. The default
+"parse_error" function does nothing and returns, thus initiating error
+recovery (see below). The user can define a customized "parse_error"
+function in the header section of the grammar file.
+
+The parser also enters error recovery mode if one of the grammar
+actions raises the "Parsing.Parse_error" exception.
+
+In error recovery mode, the parser discards states from the
+stack until it reaches a place where the error token can be shifted.
+It then discards tokens from the input until it finds three successive
+tokens that can be accepted, and starts processing with the first of
+these. If no state can be uncovered where the error token can be
+shifted, then the parser aborts by raising the "Parsing.Parse_error"
+exception.
+
+Refer to documentation on "yacc" for more details and guidance in how
+to use error recovery.
+
+\section{s:ocamlyacc-options}{Options}
+
+The "ocamlyacc" command recognizes the following options:
+
+\begin{options}
+
+\item["-b"{\it prefix}]
+Name the output files {\it prefix}".ml", {\it prefix}".mli",
+{\it prefix}".output", instead of the default naming convention.
+
+\item["-q"]
+This option has no effect.
+
+\item["-v"]
+Generate a description of the parsing tables and a report on conflicts
+resulting from ambiguities in the grammar. The description is put in
+file \var{grammar}".output".
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-"]
+Read the grammar specification from standard input. The default
+output file names are "stdin.ml" and "stdin.mli".
+
+\item["--" \var{file}]
+Process \var{file} as the grammar specification, even if its name
+starts with a dash (-) character. This option must be the last on the
+command line.
+
+\end{options}
+
+At run-time, the "ocamlyacc"-generated parser can be debugged by
+setting the "p" option in the "OCAMLRUNPARAM" environment variable
+(see section~\ref{s:ocamlrun-options}). This causes the pushdown
+automaton executing the parser to print a trace of its action (tokens
+shifted, rules reduced, etc). The trace mentions rule numbers and
+state numbers that can be interpreted by looking at the file
+\var{grammar}".output" generated by "ocamlyacc -v".
+
+\section{s:lexyacc-example}{A complete example}
+
+The all-time favorite: a desk calculator. This program reads
+arithmetic expressions on standard input, one per line, and prints
+their values. Here is the grammar definition:
+\begin{verbatim}
+ /* File parser.mly */
+ %token <int> INT
+ %token PLUS MINUS TIMES DIV
+ %token LPAREN RPAREN
+ %token EOL
+ %left PLUS MINUS /* lowest precedence */
+ %left TIMES DIV /* medium precedence */
+ %nonassoc UMINUS /* highest precedence */
+ %start main /* the entry point */
+ %type <int> main
+ %%
+ main:
+ expr EOL { $1 }
+ ;
+ expr:
+ INT { $1 }
+ | LPAREN expr RPAREN { $2 }
+ | expr PLUS expr { $1 + $3 }
+ | expr MINUS expr { $1 - $3 }
+ | expr TIMES expr { $1 * $3 }
+ | expr DIV expr { $1 / $3 }
+ | MINUS expr %prec UMINUS { - $2 }
+ ;
+\end{verbatim}
+Here is the definition for the corresponding lexer:
+\begin{verbatim}
+ (* File lexer.mll *)
+ {
+ open Parser (* The type token is defined in parser.mli *)
+ exception Eof
+ }
+ rule token = parse
+ [' ' '\t'] { token lexbuf } (* skip blanks *)
+ | ['\n' ] { EOL }
+ | ['0'-'9']+ as lxm { INT(int_of_string lxm) }
+ | '+' { PLUS }
+ | '-' { MINUS }
+ | '*' { TIMES }
+ | '/' { DIV }
+ | '(' { LPAREN }
+ | ')' { RPAREN }
+ | eof { raise Eof }
+\end{verbatim}
+Here is the main program, that combines the parser with the lexer:
+\begin{verbatim}
+ (* File calc.ml *)
+ let _ =
+ try
+ let lexbuf = Lexing.from_channel stdin in
+ while true do
+ let result = Parser.main Lexer.token lexbuf in
+ print_int result; print_newline(); flush stdout
+ done
+ with Lexer.Eof ->
+ exit 0
+\end{verbatim}
+To compile everything, execute:
+\begin{verbatim}
+ ocamllex lexer.mll # generates lexer.ml
+ ocamlyacc parser.mly # generates parser.ml and parser.mli
+ ocamlc -c parser.mli
+ ocamlc -c lexer.ml
+ ocamlc -c parser.ml
+ ocamlc -c calc.ml
+ ocamlc -o calc lexer.cmo parser.cmo calc.cmo
+\end{verbatim}
+
+\section{s:lexyacc-common-errors}{Common errors}
+
+\begin{options}
+
+\item[ocamllex: transition table overflow, automaton is too big]
+
+The deterministic automata generated by "ocamllex" are limited to at
+most 32767 transitions. The message above indicates that your lexer
+definition is too complex and overflows this limit. This is commonly
+caused by lexer definitions that have separate rules for each of the
+alphabetic keywords of the language, as in the following example.
+\begin{verbatim}
+rule token = parse
+ "keyword1" { KWD1 }
+| "keyword2" { KWD2 }
+| ...
+| "keyword100" { KWD100 }
+| ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
+ { IDENT id}
+\end{verbatim}
+To keep the generated automata small, rewrite those definitions with
+only one general ``identifier'' rule, followed by a hashtable lookup
+to separate keywords from identifiers:
+\begin{verbatim}
+{ let keyword_table = Hashtbl.create 53
+ let _ =
+ List.iter (fun (kwd, tok) -> Hashtbl.add keyword_table kwd tok)
+ [ "keyword1", KWD1;
+ "keyword2", KWD2; ...
+ "keyword100", KWD100 ]
+}
+rule token = parse
+ ['A'-'Z' 'a'-'z'] ['A'-'Z' 'a'-'z' '0'-'9' '_'] * as id
+ { try
+ Hashtbl.find keyword_table id
+ with Not_found ->
+ IDENT id }
+\end{verbatim}
+
+\item[ocamllex: Position memory overflow, too many bindings]
+The deterministic automata generated by "ocamllex" maintain a table of
+positions inside the scanned lexer buffer. The size of this table is
+limited to at most 255 cells. This error should not show up in normal
+situations.
+
+\end{options}
--- /dev/null
+\chapter{Native-code compilation (ocamlopt)} \label{c:nativecomp}
+%HEVEA\cutname{native.html}
+
+This chapter describes the OCaml high-performance
+native-code compiler "ocamlopt", which compiles OCaml source files to
+native code object files and links these object files to produce
+standalone executables.
+
+The native-code compiler is only available on certain platforms.
+It produces code that runs faster than the bytecode produced by
+"ocamlc", at the cost of increased compilation time and executable code
+size. Compatibility with the bytecode compiler is extremely high: the
+same source code should run identically when compiled with "ocamlc" and
+"ocamlopt".
+
+It is not possible to mix native-code object files produced by "ocamlopt"
+with bytecode object files produced by "ocamlc": a program must be
+compiled entirely with "ocamlopt" or entirely with "ocamlc". Native-code
+object files produced by "ocamlopt" cannot be loaded in the toplevel
+system "ocaml".
+
+\section{s:native-overview}{Overview of the compiler}
+
+The "ocamlopt" command has a command-line interface very close to that
+of "ocamlc". It accepts the same types of arguments, and processes them
+sequentially, after all options have been processed:
+
+\begin{itemize}
+\item
+Arguments ending in ".mli" are taken to be source files for
+compilation unit interfaces. Interfaces specify the names exported by
+compilation units: they declare value names with their types, define
+public data types, declare abstract data types, and so on. From the
+file \var{x}".mli", the "ocamlopt" compiler produces a compiled interface
+in the file \var{x}".cmi". The interface produced is identical to that
+produced by the bytecode compiler "ocamlc".
+
+\item
+Arguments ending in ".ml" are taken to be source files for compilation
+unit implementations. Implementations provide definitions for the
+names exported by the unit, and also contain expressions to be
+evaluated for their side-effects. From the file \var{x}".ml", the "ocamlopt"
+compiler produces two files: \var{x}".o", containing native object code,
+and \var{x}".cmx", containing extra information for linking and
+optimization of the clients of the unit. The compiled implementation
+should always be referred to under the name \var{x}".cmx" (when given
+a ".o" or ".obj" file, "ocamlopt" assumes that it contains code compiled from C,
+not from OCaml).
+
+The implementation is checked against the interface file \var{x}".mli"
+(if it exists) as described in the manual for "ocamlc"
+(chapter~\ref{c:camlc}).
+
+\item
+Arguments ending in ".cmx" are taken to be compiled object code. These
+files are linked together, along with the object files obtained
+by compiling ".ml" arguments (if any), and the OCaml standard
+library, to produce a native-code executable program. The order in
+which ".cmx" and ".ml" arguments are presented on the command line is
+relevant: compilation units are initialized in that order at
+run-time, and it is a link-time error to use a component of a unit
+before having initialized it. Hence, a given \var{x}".cmx" file must come
+before all ".cmx" files that refer to the unit \var{x}.
+
+\item
+Arguments ending in ".cmxa" are taken to be libraries of object code.
+Such a library packs in two files (\var{lib}".cmxa" and \var{lib}".a"/".lib")
+a set of object files (".cmx" and ".o"/".obj" files). Libraries are build with
+"ocamlopt -a" (see the description of the "-a" option below). The object
+files contained in the library are linked as regular ".cmx" files (see
+above), in the order specified when the library was built. The only
+difference is that if an object file contained in a library is not
+referenced anywhere in the program, then it is not linked in.
+
+\item
+Arguments ending in ".c" are passed to the C compiler, which generates
+a ".o"/".obj" object file. This object file is linked with the program.
+
+\item
+Arguments ending in ".o", ".a" or ".so" (".obj", ".lib" and ".dll"
+under Windows) are assumed to be C object files and
+libraries. They are linked with the program.
+
+\end{itemize}
+
+The output of the linking phase is a regular Unix or Windows
+executable file. It does not need "ocamlrun" to run.
+
+The compiler is able to emit some information on its internal stages:
+
+\begin{itemize}
+\item
+% The following two paragraphs are a duplicate from the description of the batch compiler.
+".cmt" files for the implementation of the compilation unit
+and ".cmti" for signatures if the option "-bin-annot" is passed to it (see the
+description of "-bin-annot" below).
+Each such file contains a typed abstract syntax tree (AST), that is produced
+during the type checking procedure. This tree contains all available information
+about the location and the specific type of each term in the source file.
+The AST is partial if type checking was unsuccessful.
+
+These ".cmt" and ".cmti" files are typically useful for code inspection tools.
+
+\item
+".cmir-linear" files for the implementation of the compilation unit
+if the option "-save-ir-after scheduling" is passed to it.
+Each such file contains a low-level intermediate representation,
+produced by the instruction scheduling pass.
+
+An external tool can perform low-level optimisations,
+such as code layout, by transforming a ".cmir-linear" file.
+To continue compilation, the compiler can be invoked with (a possibly modified)
+".cmir-linear" file as an argument, instead of the corresponding source file.
+\end{itemize}
+
+\section{s:native-options}{Options}
+
+The following command-line options are recognized by "ocamlopt".
+The options "-pack", "-a", "-shared", "-c", "-output-obj" and
+"-output-complete-obj" are mutually exclusive.
+
+% Configure boolean variables used by the macros in unified-options.etex
+\compfalse
+\nattrue
+\topfalse
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\paragraph{Options for the 32-bit x86 architecture}
+The 32-bit code generator for Intel/AMD x86 processors ("i386"
+architecture) supports the
+following additional option:
+
+\begin{options}
+\item["-ffast-math"] Use the processor instructions to compute
+trigonometric and exponential functions, instead of calling the
+corresponding library routines. The functions affected are:
+"atan", "atan2", "cos", "log", "log10", "sin", "sqrt" and "tan".
+The resulting code runs faster, but the range of supported arguments
+and the precision of the result can be reduced. In particular,
+trigonometric operations "cos", "sin", "tan" have their range reduced to
+$[-2^{64}, 2^{64}]$.
+\end{options}
+
+\paragraph{Options for the 64-bit x86 architecture}
+The 64-bit code generator for Intel/AMD x86 processors ("amd64"
+architecture) supports the following additional options:
+
+\begin{options}
+\item["-fPIC"] Generate position-independent machine code. This is
+the default.
+\item["-fno-PIC"] Generate position-dependent machine code.
+\end{options}
+
+\paragraph{Options for the PowerPC architecture}
+The PowerPC code generator supports the following additional options:
+
+\begin{options}
+\item["-flarge-toc"] Enables the PowerPC large model allowing the TOC (table of
+contents) to be arbitrarily large. This is the default since 4.11.
+\item["-fsmall-toc"] Enables the PowerPC small model allowing the TOC to be up
+to 64 kbytes per compilation unit. Prior to 4.11 this was the default
+behaviour.
+\end{options}
+
+\paragraph{Contextual control of command-line options}
+
+The compiler command line can be modified ``from the outside''
+with the following mechanisms. These are experimental
+and subject to change. They should be used only for experimental and
+development work, not in released packages.
+
+\begin{options}
+\item["OCAMLPARAM" \rm(environment variable)]
+A set of arguments that will be inserted before or after the arguments from
+the command line. Arguments are specified in a comma-separated list
+of "name=value" pairs. A "_" is used to specify the position of
+the command line arguments, i.e. "a=x,_,b=y" means that "a=x" should be
+executed before parsing the arguments, and "b=y" after. Finally,
+an alternative separator can be specified as the
+first character of the string, within the set ":|; ,".
+\item["ocaml_compiler_internal_params" \rm(file in the stdlib directory)]
+A mapping of file names to lists of arguments that
+will be added to the command line (and "OCAMLPARAM") arguments.
+\item["OCAML_FLEXLINK" \rm(environment variable)]
+Alternative executable to use on native
+Windows for "flexlink" instead of the
+configured value. Primarily used for bootstrapping.
+\end{options}
+
+\section{s:native-common-errors}{Common errors}
+
+The error messages are almost identical to those of "ocamlc".
+See section~\ref{s:comp-errors}.
+
+\section{s:native:running-executable}{Running executables produced by ocamlopt}
+
+Executables generated by "ocamlopt" are native, stand-alone executable
+files that can be invoked directly. They do
+not depend on the "ocamlrun" bytecode runtime system nor on
+dynamically-loaded C/OCaml stub libraries.
+
+During execution of an "ocamlopt"-generated executable,
+the following environment variables are also consulted:
+\begin{options}
+\item["OCAMLRUNPARAM"] Same usage as in "ocamlrun"
+ (see section~\ref{s:ocamlrun-options}), except that option "l"
+ is ignored (the operating system's stack size limit
+ is used instead).
+\item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the
+ environment, then "CAMLRUNPARAM" will be used instead. If
+ "CAMLRUNPARAM" is not found, then the default values will be used.
+\end{options}
+
+\section{s:compat-native-bytecode}{Compatibility with the bytecode compiler}
+
+This section lists the known incompatibilities between the bytecode
+compiler and the native-code compiler. Except on those points, the two
+compilers should generate code that behave identically.
+
+\begin{itemize}
+
+\item Signals are detected only when the program performs an
+allocation in the heap. That is, if a signal is delivered while in a
+piece of code that does not allocate, its handler will not be called
+until the next heap allocation.
+
+\item On ARM and PowerPC processors (32 and 64 bits), fused
+ multiply-add (FMA) instructions can be generated for a
+ floating-point multiplication followed by a floating-point addition
+ or subtraction, as in "x *. y +. z". The FMA instruction avoids
+ rounding the intermediate result "x *. y", which is generally
+ beneficial, but produces floating-point results that differ slightly
+ from those produced by the bytecode interpreter.
+
+\item On Intel/AMD x86 processors in 32-bit mode,
+some intermediate results in floating-point computations are
+kept in extended precision rather than being rounded to double
+precision like the bytecode compiler always does. Floating-point
+results can therefore differ slightly between bytecode and native code.
+
+\item The native-code compiler performs a number of optimizations that
+the bytecode compiler does not perform, especially when the Flambda
+optimizer is active. In particular, the native-code compiler
+identifies and eliminates ``dead code'', i.e.\ computations that do
+not contribute to the results of the program. For example,
+\begin{verbatim}
+ let _ = ignore M.f
+\end{verbatim}
+contains a reference to compilation unit "M" when compiled to
+bytecode. This reference forces "M" to be linked and its
+initialization code to be executed. The native-code compiler
+eliminates the reference to "M", hence the compilation unit "M" may
+not be linked and executed. A workaround is to compile "M" with the
+"-linkall" flag so that it will always be linked and executed, even if
+not referenced. See also the "Sys.opaque_identity" function from the
+"Sys" standard library module.
+
+\item Before 4.10, stack overflows, typically caused by excessively
+ deep recursion, are not always turned into a "Stack_overflow"
+ exception like with the bytecode compiler. The runtime system makes
+ a best effort to trap stack overflows and raise the "Stack_overflow"
+ exception, but sometimes it fails and a ``segmentation fault'' or
+ another system fault occurs instead.
+
+\end{itemize}
--- /dev/null
+\chapter{Dependency generator (ocamldep)} \label{c:camldep}
+%HEVEA\cutname{depend.html}
+
+The "ocamldep" command scans a set of OCaml source files
+(".ml" and ".mli" files) for references to external compilation units,
+and outputs dependency lines in a format suitable for the "make"
+utility. This ensures that "make" will compile the source files in the
+correct order, and recompile those files that need to when a source
+file is modified.
+
+The typical usage is:
+\begin{alltt}
+ ocamldep \var{options} *.mli *.ml > .depend
+\end{alltt}
+where "*.mli *.ml" expands to all source files in the current
+directory and ".depend" is the file that should contain the
+dependencies. (See below for a typical "Makefile".)
+
+Dependencies are generated both for compiling with the bytecode
+compiler "ocamlc" and with the native-code compiler "ocamlopt".
+
+\section{s:ocamldep-options}{Options}
+
+The following command-line options are recognized by "ocamldep".
+
+\begin{options}
+
+\item["-absname"]
+Show absolute filenames in error messages.
+
+\item["-all"]
+Generate dependencies on all required files, rather than assuming
+implicit dependencies.
+
+\item["-allow-approx"]
+Allow falling back on a lexer-based approximation when parsing fails.
+
+\item["-args" \var{filename}]
+ Read additional newline-terminated command line arguments from \var{filename}.
+
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from \var{filename}.
+
+\item["-as-map"]
+For the following files, do not include delayed dependencies for
+module aliases.
+This option assumes that they are compiled using options
+"-no-alias-deps -w -49", and that those files or their interface are
+passed with the "-map" option when computing dependencies for other
+files. Note also that for dependencies to be correct in the
+implementation of a map file, its interface should not coerce any of
+the aliases it contains.
+
+\item["-debug-map"]
+Dump the delayed dependency map for each map file.
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+source files. If a source file "foo.ml" mentions an external
+compilation unit "Bar", a dependency on that unit's interface
+"bar.cmi" is generated only if the source for "bar" is found in the
+current directory or in one of the directories specified with "-I".
+Otherwise, "Bar" is assumed to be a module from the standard library,
+and no dependencies are generated. For programs that span multiple
+directories, it is recommended to pass "ocamldep" the same "-I" options
+that are passed to the compiler.
+
+\item["-nocwd"]
+Do not add current working directory to the list of include directories.
+
+\item["-impl" \var{file}]
+Process \var{file} as a ".ml" file.
+
+\item["-intf" \var{file}]
+Process \var{file} as a ".mli" file.
+
+\item["-map" \var{file}]
+Read and propagate the delayed dependencies for module aliases in
+\var{file}, so that the following files will depend on the
+exported aliased modules if they use them. See the example below.
+
+\item["-ml-synonym" \var{.ext}]
+Consider the given extension (with leading dot) to be a synonym for .ml.
+
+\item["-mli-synonym" \var{.ext}]
+Consider the given extension (with leading dot) to be a synonym for .mli.
+
+\item["-modules"]
+Output raw dependencies of the form
+\begin{verbatim}
+ filename: Module1 Module2 ... ModuleN
+\end{verbatim}
+where "Module1", \ldots, "ModuleN" are the names of the compilation
+units referenced within the file "filename", but these names are not
+resolved to source file names. Such raw dependencies cannot be used
+by "make", but can be post-processed by other tools such as "Omake".
+
+\item["-native"]
+Generate dependencies for a pure native-code program (no bytecode
+version). When an implementation file (".ml" file) has no explicit
+interface file (".mli" file), "ocamldep" generates dependencies on the
+bytecode compiled file (".cmo" file) to reflect interface changes.
+This can cause unnecessary bytecode recompilations for programs that
+are compiled to native-code only. The flag "-native" causes
+dependencies on native compiled files (".cmx") to be generated instead
+of on ".cmo" files. (This flag makes no difference if all source files
+have explicit ".mli" interface files.)
+
+\item["-one-line"]
+Output one line per file, regardless of the length.
+
+\item["-open" \var{module}]
+Assume that module \var{module} is opened before parsing each of the
+following files.
+
+\item["-pp" \var{command}]
+Cause "ocamldep" to call the given \var{command} as a preprocessor
+for each source file.
+
+\item["-ppx" \var{command}]
+Pipe abstract syntax trees through preprocessor \var{command}.
+
+\item["-shared"]
+Generate dependencies for native plugin files (.cmxs) in addition to
+native compiled files (.cmx).
+
+\item["-slash"]
+Under Windows, use a forward slash (/) as the path separator instead
+of the usual backward slash ($\backslash$). Under Unix, this option does
+nothing.
+
+\item["-sort"]
+Sort files according to their dependencies.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamldep-makefile}{A typical Makefile}
+
+Here is a template "Makefile" for a OCaml program.
+
+\begin{verbatim}
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+INCLUDES= # all relevant -I options here
+OCAMLFLAGS=$(INCLUDES) # add other options for ocamlc here
+OCAMLOPTFLAGS=$(INCLUDES) # add other options for ocamlopt here
+
+# prog1 should be compiled to bytecode, and is composed of three
+# units: mod1, mod2 and mod3.
+
+# The list of object files for prog1
+PROG1_OBJS=mod1.cmo mod2.cmo mod3.cmo
+
+prog1: $(PROG1_OBJS)
+ $(OCAMLC) -o prog1 $(OCAMLFLAGS) $(PROG1_OBJS)
+
+# prog2 should be compiled to native-code, and is composed of two
+# units: mod4 and mod5.
+
+# The list of object files for prog2
+PROG2_OBJS=mod4.cmx mod5.cmx
+
+prog2: $(PROG2_OBJS)
+ $(OCAMLOPT) -o prog2 $(OCAMLFLAGS) $(PROG2_OBJS)
+
+# Common rules
+
+%.cmo: %.ml
+ $(OCAMLC) $(OCAMLFLAGS) -c $<
+
+%.cmi: %.mli
+ $(OCAMLC) $(OCAMLFLAGS) -c $<
+
+%.cmx: %.ml
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
+
+# Clean up
+clean:
+ rm -f prog1 prog2
+ rm -f *.cm[iox]
+
+# Dependencies
+depend:
+ $(OCAMLDEP) $(INCLUDES) *.mli *.ml > .depend
+
+include .depend
+\end{verbatim}
+
+If you use module aliases to give shorter names to modules, you need
+to change the above definitions. Assuming that your map file is called
+"mylib.mli", here are minimal modifications.
+\begin{verbatim}
+OCAMLFLAGS=$(INCLUDES) -open Mylib
+
+mylib.cmi: mylib.mli
+ $(OCAMLC) $(INCLUDES) -no-alias-deps -w -49 -c $<
+
+depend:
+ $(OCAMLDEP) $(INCLUDES) -map mylib.mli $(PROG1_OBJS:.cmo=.ml) > .depend
+\end{verbatim}
+Note that in this case you should not compute dependencies for
+"mylib.mli" together with the other files, hence the need to pass
+explicitly the list of files to process.
+If "mylib.mli" itself has dependencies, you should compute them using
+"-as-map".
--- /dev/null
+\chapter{The documentation generator (ocamldoc)} \label{c:ocamldoc}
+%HEVEA\cutname{ocamldoc.html}
+
+This chapter describes OCamldoc, a tool that generates documentation from
+special comments embedded in source files. The comments used by OCamldoc
+are of the form "(**"\ldots"*)" and follow the format described
+in section \ref{s:ocamldoc-comments}.
+
+OCamldoc can produce documentation in various formats: HTML, \LaTeX ,
+TeXinfo, Unix man pages, and "dot" dependency graphs. Moreover,
+users can add their own custom generators, as explained in
+section \ref{s:ocamldoc-custom-generators}.
+
+In this chapter, we use the word {\em element} to refer to any of the
+following parts of an OCaml source file: a type declaration, a value,
+a module, an exception, a module type, a type constructor, a record
+field, a class, a class type, a class method, a class value or a class
+inheritance clause.
+
+\section{s:ocamldoc-usage}{Usage}
+
+\subsection{ss:ocamldoc-invocation}{Invocation}
+
+OCamldoc is invoked via the command "ocamldoc", as follows:
+\begin{alltt}
+ ocamldoc \var{options} \var{sourcefiles}
+\end{alltt}
+
+\subsubsection*{sss:ocamldoc-output}{Options for choosing the output format}
+
+The following options determine the format for the generated
+documentation.
+
+\begin{options}
+\item["-html"]
+Generate documentation in HTML default format. The generated HTML pages
+are stored in the current directory, or in the directory specified
+with the {\bf\tt -d} option. You can customize the style of the
+generated pages by editing the generated "style.css" file, or by providing
+your own style sheet using option "-css-style".
+The file "style.css" is not generated if it already exists or if -css-style is used.
+
+\item["-latex"]
+Generate documentation in \LaTeX\ default format. The generated
+\LaTeX\ document is saved in file "ocamldoc.out", or in the file
+specified with the {\bf\tt -o} option. The document uses the style file
+"ocamldoc.sty". This file is generated when using the "-latex" option,
+if it does not already exist.
+You can change this file to customize the style of your \LaTeX\ documentation.
+
+\item["-texi"]
+Generate documentation in TeXinfo default format. The generated
+\LaTeX\ document is saved in file "ocamldoc.out", or in the file
+specified with the {\bf\tt -o} option.
+
+\item["-man"]
+Generate documentation as a set of Unix "man" pages. The generated pages
+are stored in the current directory, or in the directory specified
+with the {\bf\tt -d} option.
+
+\item["-dot"]
+Generate a dependency graph for the toplevel modules, in a format suitable
+for displaying and processing by "dot". The "dot" tool is available from
+\url{https://graphviz.org/}.
+The textual representation of the graph is written to the file
+"ocamldoc.out", or to the file specified with the {\bf\tt -o} option.
+Use "dot ocamldoc.out" to display it.
+
+\item["-g" \var{file.cm[o,a,xs]}]
+Dynamically load the given file, which defines a custom documentation
+generator. See section \ref{ss:ocamldoc-compilation-and-usage}. This
+option is supported by the "ocamldoc" command (to load ".cmo" and ".cma" files)
+and by its native-code version "ocamldoc.opt" (to load ".cmxs" files).
+If the given file is a simple one and does not exist in
+the current directory, then ocamldoc looks for it in the custom
+generators default directory, and in the directories specified with
+optional "-i" options.
+
+\item["-customdir"]
+Display the custom generators default directory.
+
+\item["-i" \var{directory}]
+Add the given directory to the path where to look for custom generators.
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-options}{General options}
+
+\begin{options}
+
+\item["-d" \var{dir}]
+Generate files in directory \var{dir}, rather than the current directory.
+
+\item["-dump" \var{file}]
+Dump collected information into \var{file}. This information can be
+read with the "-load" option in a subsequent invocation of "ocamldoc".
+
+\item["-hide" \var{modules}]
+Hide the given complete module names in the generated documentation.
+\var{modules} is a list of complete module names separated
+ by '","', without blanks. For instance: "Stdlib,M2.M3".
+
+\item["-inv-merge-ml-mli"]
+Reverse the precedence of implementations and interfaces when merging.
+All elements
+in implementation files are kept, and the {\bf\tt -m} option
+indicates which parts of the comments in interface files are merged
+with the comments in implementation files.
+
+\item["-keep-code"]
+Always keep the source code for values, methods and instance variables,
+when available.
+
+\item["-load" \var{file}]
+Load information from \var{file}, which has been produced by
+"ocamldoc -dump". Several "-load" options can be given.
+
+\item["-m" \var{flags}]
+Specify merge options between interfaces and implementations.
+(see section \ref{ss:ocamldoc-merge} for details).
+\var{flags} can be one or several of the following characters:
+\begin{options}
+ \item["d"] merge description
+ \item["a"] merge "\@author"
+ \item["v"] merge "\@version"
+ \item["l"] merge "\@see"
+ \item["s"] merge "\@since"
+ \item["b"] merge "\@before"
+ \item["o"] merge "\@deprecated"
+ \item["p"] merge "\@param"
+ \item["e"] merge "\@raise"
+ \item["r"] merge "\@return"
+ \item["A"] merge everything
+\end{options}
+
+\item["-no-custom-tags"]
+Do not allow custom \@-tags (see section \ref{ss:ocamldoc-tags}).
+
+\item["-no-stop"]
+Keep elements placed after/between the "(**/**)" special comment(s)
+(see section \ref{s:ocamldoc-comments}).
+
+\item["-o" \var{file}]
+Output the generated documentation to \var{file} instead of "ocamldoc.out".
+This option is meaningful only in conjunction with the
+{\bf\tt -latex}, {\bf\tt -texi}, or {\bf\tt -dot} options.
+
+\item["-pp" \var{command}]
+Pipe sources through preprocessor \var{command}.
+
+\item["-impl" \var{filename}]
+Process the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+
+\item["-intf" \var{filename}]
+Process the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+
+\item["-text" \var{filename}]
+Process the file \var{filename} as a text file, even if its
+extension is not ".txt".
+
+\item["-sort"]
+Sort the list of top-level modules before generating the documentation.
+
+\item["-stars"]
+Remove blank characters until the first asterisk ('"*"') in each
+line of comments.
+
+\item["-t" \var{title}]
+Use \var{title} as the title for the generated documentation.
+
+\item["-intro" \var{file}]
+Use content of \var{file} as ocamldoc text to use as introduction (HTML,
+\LaTeX{} and TeXinfo only).
+For HTML, the file is used to create the whole "index.html" file.
+
+\item["-v"]
+Verbose mode. Display progress information.
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-warn-error"]
+Treat Ocamldoc warnings as errors.
+
+\item["-hide-warnings"]
+Do not print OCamldoc warnings.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\subsubsection*{sss:ocamldoc-type-checking}{Type-checking options}
+
+OCamldoc calls the OCaml type-checker to obtain type
+information. The following options impact the type-checking phase.
+They have the same meaning as for the "ocamlc" and "ocamlopt" commands.
+
+\begin{options}
+
+\item["-I" \var{directory}]
+Add \var{directory} to the list of directories search for compiled
+interface files (".cmi" files).
+
+\item["-nolabels"]
+Ignore non-optional labels in types.
+
+\item["-rectypes"]
+Allow arbitrary recursive types. (See the "-rectypes" option to "ocamlc".)
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-html}{Options for generating HTML pages}
+
+The following options apply in conjunction with the "-html" option:
+
+\begin{options}
+\item["-all-params"]
+Display the complete list of parameters for functions and methods.
+
+\item["-charset" \var{charset}]
+Add information about character encoding being \var{charset}
+(default is iso-8859-1).
+
+\item["-colorize-code"]
+Colorize the OCaml code enclosed in "[ ]" and "{[ ]}", using colors
+to emphasize keywords, etc. If the code fragments are not
+syntactically correct, no color is added.
+
+\item["-css-style" \var{filename}]
+Use \var{filename} as the Cascading Style Sheet file.
+
+\item["-index-only"]
+Generate only index files.
+
+\item["-short-functors"]
+Use a short form to display functors:
+\begin{alltt}
+module M : functor (A:Module) -> functor (B:Module2) -> sig .. end
+\end{alltt}
+is displayed as:
+\begin{alltt}
+module M (A:Module) (B:Module2) : sig .. end
+\end{alltt}
+
+\end{options}
+
+\subsubsection*{sss:ocamldoc-latex}{Options for generating \LaTeX\ files}
+
+The following options apply in conjunction with the "-latex" option:
+
+\begin{options}
+\item["-latex-value-prefix" \var{prefix}]
+Give a prefix to use for the labels of the values in the generated
+\LaTeX\ document.
+The default prefix is the empty string. You can also use the options
+{\tt -latex-type-prefix}, {\tt -latex-exception-prefix},
+{\tt -latex-module-prefix},
+{\tt -latex-module-type-prefix}, {\tt -latex-class-prefix},
+{\tt -latex-class-type-prefix},
+{\tt -latex-attribute-prefix} and {\tt -latex-method-prefix}.
+
+These options are useful when you have, for example, a type and a value with
+ the same name. If you do not specify prefixes, \LaTeX\ will complain about
+multiply defined labels.
+
+\item["-latextitle" \var{n,style}]
+Associate style number \var{n} to the given \LaTeX\ sectioning command
+\var{style}, e.g. "section" or "subsection". (\LaTeX\ only.) This is
+useful when including the generated document in another \LaTeX\ document,
+at a given sectioning level. The default association is 1 for "section",
+2 for "subsection", 3 for "subsubsection", 4 for "paragraph" and 5 for
+"subparagraph".
+
+\item["-noheader"]
+Suppress header in generated documentation.
+
+\item["-notoc"]
+Do not generate a table of contents.
+
+\item["-notrailer"]
+Suppress trailer in generated documentation.
+
+\item["-sepfiles"]
+Generate one ".tex" file per toplevel module, instead of the global
+"ocamldoc.out" file.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-info}{Options for generating TeXinfo files}
+
+The following options apply in conjunction with the "-texi" option:
+
+\begin{options}
+\item["-esc8"]
+Escape accented characters in Info files.
+
+\item["-info-entry"]
+Specify Info directory entry.
+
+\item["-info-section"]
+Specify section of Info directory.
+
+\item["-noheader"]
+Suppress header in generated documentation.
+
+\item["-noindex"]
+Do not build index for Info files.
+
+\item["-notrailer"]
+Suppress trailer in generated documentation.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-dot}{Options for generating "dot" graphs}
+
+The following options apply in conjunction with the "-dot" option:
+
+\begin{options}
+\item["-dot-colors" \var{colors}]
+Specify the colors to use in the generated "dot" code.
+When generating module dependencies, "ocamldoc" uses different colors
+for modules, depending on the directories in which they reside.
+When generating types dependencies, "ocamldoc" uses different colors
+for types, depending on the modules in which they are defined.
+\var{colors} is a list of color names separated by '","', as
+in "Red,Blue,Green". The available colors are the ones supported by
+the "dot" tool.
+
+\item["-dot-include-all"]
+Include all modules in the "dot" output, not only modules given
+on the command line or loaded with the {\bf\tt -load} option.
+
+\item["-dot-reduce"]
+Perform a transitive reduction of the dependency graph before
+outputting the "dot" code. This can be useful if there are
+a lot of transitive dependencies that clutter the graph.
+
+\item["-dot-types"]
+Output "dot" code describing the type dependency graph instead of
+the module dependency graph.
+\end{options}
+
+\subsubsection*{sss:ocamldoc-man}{Options for generating man files}
+
+The following options apply in conjunction with the "-man" option:
+
+\begin{options}
+\item["-man-mini"]
+Generate man pages only for modules, module types, classes and class
+types, instead of pages for all elements.
+
+\item["-man-suffix" \var{suffix}]
+Set the suffix used for generated man filenames. Default is '"3o"',
+as in "List.3o".
+
+\item["-man-section" \var{section}]
+Set the section number used for generated man filenames. Default is '"3"'.
+
+\end{options}
+
+\subsection{ss:ocamldoc-merge}{Merging of module information}
+
+Information on a module can be extracted either from the ".mli" or ".ml"
+file, or both, depending on the files given on the command line.
+When both ".mli" and ".ml" files are given for the same module,
+information extracted from these files is merged according to the
+following rules:
+\begin{itemize}
+\item Only elements (values, types, classes, ...) declared in the ".mli"
+file are kept. In other terms, definitions from the ".ml" file that are
+not exported in the ".mli" file are not documented.
+\item Descriptions of elements and descriptions in \@-tags are handled
+as follows. If a description for the same element or in the same
+\@-tag of the same element is present in both files, then the
+description of the ".ml" file is concatenated to the one in the ".mli" file,
+if the corresponding "-m" flag is given on the command line.
+If a description is present in the ".ml" file and not in the
+".mli" file, the ".ml" description is kept.
+In either case, all the information given in the ".mli" file is kept.
+\end{itemize}
+
+\subsection{ss:ocamldoc-rules}{Coding rules}
+The following rules must be respected in order to avoid name clashes
+resulting in cross-reference errors:
+\begin{itemize}
+\item In a module, there must not be two modules, two module types or
+ a module and a module type with the same name.
+ In the default HTML generator, modules "ab" and "AB" will be printed
+ to the same file on case insensitive file systems.
+\item In a module, there must not be two classes, two class types or
+ a class and a class type with the same name.
+\item In a module, there must not be two values, two types, or two
+ exceptions with the same name.
+\item Values defined in tuple, as in "let (x,y,z) = (1,2,3)"
+are not kept by OCamldoc.
+\item Avoid the following construction:
+\begin{caml_eval}
+module Foo = struct module Bar = struct let x = 1 end end;;
+\end{caml_eval}
+\begin{caml_example*}{verbatim}
+open Foo (* which has a module Bar with a value x *)
+module Foo =
+ struct
+ module Bar =
+ struct
+ let x = 1
+ end
+ end
+ let dummy = Bar.x
+\end{caml_example*}
+In this case, OCamldoc will associate "Bar.x" to the "x" of module
+"Foo" defined just above, instead of to the "Bar.x" defined in the
+opened module "Foo".
+\end{itemize}
+
+\section{s:ocamldoc-comments}{Syntax of documentation comments}
+
+Comments containing documentation material are called {\em special
+comments} and are written between "(**" and "*)". Special comments
+must start exactly with "(**". Comments beginning with "(" and more
+than two "*" are ignored.
+
+\subsection{ss:ocamldoc-placement}{Placement of documentation comments}
+OCamldoc can associate comments to some elements of the language
+encountered in the source files. The association is made according to
+the locations of comments with respect to the language elements. The
+locations of comments in ".mli" and ".ml" files are different.
+
+%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-mli}{Comments in ".mli" files}
+A special comment is associated to an element if it is placed before or
+after the element.\\
+A special comment before an element is associated to this element if~:
+\begin{itemize}
+\item There is no blank line or another special comment between the special
+comment and the element. However, a regular comment can occur between
+the special comment and the element.
+\item The special comment is not already associated to the previous element.
+\item The special comment is not the first one of a toplevel module.
+\end{itemize}
+
+A special comment after an element is associated to this element if
+there is no blank line or comment between the special comment and the
+element.
+
+There are two exceptions: for constructors and record fields in
+type definitions, the associated comment can only be placed after the
+constructor or field definition, without blank lines or other comments
+between them. The special comment for a constructor
+with another constructor following must be placed before the '"|"'
+character separating the two constructors.
+
+The following sample interface file "foo.mli" illustrates the
+placement rules for comments in ".mli" files.
+
+\begin{caml_eval}
+class cl = object end
+\end{caml_eval}
+\begin{caml_example*}{signature}
+(** The first special comment of the file is the comment associated
+ with the whole module.*)
+
+
+(** Special comments can be placed between elements and are kept
+ by the OCamldoc tool, but are not associated to any element.
+ @-tags in these comments are ignored.*)
+
+(*******************************************************************)
+(** Comments like the one above, with more than two asterisks,
+ are ignored. *)
+
+(** The comment for function f. *)
+val f : int -> int -> int
+(** The continuation of the comment for function f. *)
+
+(** Comment for exception My_exception, even with a simple comment
+ between the special comment and the exception.*)
+(* Hello, I'm a simple comment :-) *)
+exception My_exception of (int -> int) * int
+
+(** Comment for type weather *)
+type weather =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+
+(** Comment for type weather2 *)
+type weather2 =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+(** I can continue the comment for type weather2 here
+ because there is already a comment associated to the last constructor.*)
+
+(** The comment for type my_record *)
+type my_record = {
+ foo : int ; (** Comment for field foo *)
+ bar : string ; (** Comment for field bar *)
+ }
+ (** Continuation of comment for type my_record *)
+
+(** Comment for foo *)
+val foo : string
+(** This comment is associated to foo and not to bar. *)
+val bar : string
+(** This comment is associated to bar. *)
+
+(** The comment for class my_class *)
+class my_class :
+ object
+ (** A comment to describe inheritance from cl *)
+ inherit cl
+
+ (** The comment for attribute tutu *)
+ val mutable tutu : string
+
+ (** The comment for attribute toto. *)
+ val toto : int
+
+ (** This comment is not attached to titi since
+ there is a blank line before titi, but is kept
+ as a comment in the class. *)
+
+ val titi : string
+
+ (** Comment for method toto *)
+ method toto : string
+
+ (** Comment for method m *)
+ method m : float -> int
+ end
+
+(** The comment for the class type my_class_type *)
+class type my_class_type =
+ object
+ (** The comment for variable x. *)
+ val mutable x : int
+
+ (** The comment for method m. *)
+ method m : int -> int
+end
+
+(** The comment for module Foo *)
+module Foo :
+ sig
+ (** The comment for x *)
+ val x : int
+
+ (** A special comment that is kept but not associated to any element *)
+ end
+
+(** The comment for module type my_module_type. *)
+module type my_module_type =
+ sig
+ (** The comment for value x. *)
+ val x : int
+
+ (** The comment for module M. *)
+ module M :
+ sig
+ (** The comment for value y. *)
+ val y : int
+
+ (* ... *)
+ end
+
+ end
+
+\end{caml_example*}
+
+%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-comments-ml}{Comments in {\tt .ml} files}
+
+A special comment is associated to an element if it is placed before
+the element and there is no blank line between the comment and the
+element. Meanwhile, there can be a simple comment between the special
+comment and the element. There are two exceptions, for
+constructors and record fields in type definitions, whose associated
+comment must be placed after the constructor or field definition,
+without blank line between them. The special comment for a constructor
+with another constructor following must be placed before the '"|"'
+character separating the two constructors.
+
+The following example of file "toto.ml" shows where to place comments
+in a ".ml" file.
+
+\begin{caml_example*}{verbatim}
+(** The first special comment of the file is the comment associated
+ to the whole module. *)
+
+(** The comment for function f *)
+let f x y = x + y
+
+(** This comment is not attached to any element since there is another
+ special comment just before the next element. *)
+
+(** Comment for exception My_exception, even with a simple comment
+ between the special comment and the exception.*)
+(* A simple comment. *)
+exception My_exception of (int -> int) * int
+
+(** Comment for type weather *)
+type weather =
+| Rain of int (** The comment for constructor Rain *)
+| Sun (** The comment for constructor Sun *)
+
+(** The comment for type my_record *)
+type my_record = {
+ foo : int ; (** Comment for field foo *)
+ bar : string ; (** Comment for field bar *)
+ }
+
+(** The comment for class my_class *)
+class my_class =
+ object
+ (** A comment to describe inheritance from cl *)
+ inherit cl
+
+ (** The comment for the instance variable tutu *)
+ val mutable tutu = "tutu"
+ (** The comment for toto *)
+ val toto = 1
+ val titi = "titi"
+ (** Comment for method toto *)
+ method toto = tutu ^ "!"
+ (** Comment for method m *)
+ method m (f : float) = 1
+ end
+
+(** The comment for class type my_class_type *)
+class type my_class_type =
+ object
+ (** The comment for the instance variable x. *)
+ val mutable x : int
+ (** The comment for method m. *)
+ method m : int -> int
+ end
+
+(** The comment for module Foo *)
+module Foo =
+ struct
+ (** The comment for x *)
+ let x = 0
+ (** A special comment in the class, but not associated to any element. *)
+ end
+
+(** The comment for module type my_module_type. *)
+module type my_module_type =
+ sig
+ (* Comment for value x. *)
+ val x : int
+ (* ... *)
+ end
+\end{caml_example}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-stop}{The Stop special comment}
+The special comment "(**/**)" tells OCamldoc to discard
+elements placed after this comment, up to the end of the current
+class, class type, module or module type, or up to the next stop comment.
+For instance:
+\begin{caml_example*}{signature}
+class type foo =
+ object
+ (** comment for method m *)
+ method m : string
+
+ (**/**)
+
+ (** This method won't appear in the documentation *)
+ method bar : int
+ end
+
+(** This value appears in the documentation, since the Stop special comment
+ in the class does not affect the parent module of the class.*)
+val foo : string
+
+(**/**)
+(** The value bar does not appear in the documentation.*)
+val bar : string
+(**/**)
+
+(** The type t appears since in the documentation since the previous stop comment
+toggled off the "no documentation mode". *)
+type t = string
+\end{caml_example*}
+
+The {\bf\tt -no-stop} option to "ocamldoc" causes the Stop special
+comments to be ignored.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-syntax}{Syntax of documentation comments}
+
+The inside of documentation comments "(**"\ldots"*)" consists of
+free-form text with optional formatting annotations, followed by
+optional {\em tags} giving more specific information about parameters,
+version, authors, \ldots\ The tags are distinguished by a leading "\@"
+character. Thus, a documentation comment has the following shape:
+\begin{verbatim}
+(** The comment begins with a description, which is text formatted
+ according to the rules described in the next section.
+ The description continues until the first non-escaped '@' character.
+ @author Mr Smith
+ @param x description for parameter x
+*)
+\end{verbatim}
+Some elements support only a subset of all \@-tags. Tags that are not
+relevant to the documented element are simply ignored. For instance,
+all tags are ignored when documenting type constructors, record
+fields, and class inheritance clauses. Similarly, a "\@param" tag on a
+class instance variable is ignored.
+
+At last, "(**)" is the empty documentation comment.
+
+%%%%%%%%%%%%%
+
+% enable section numbering for subsubsections (PR#6189, item 3)
+\setcounter{secnumdepth}{3}
+
+\subsection{ss:ocamldoc-formatting}{Text formatting}
+
+Here is the BNF grammar for the simple markup language used to format
+text descriptions.
+
+\newpage
+
+\begin{syntax}
+text: {{text-element}}
+;
+\end{syntax}
+
+
+\begin{syntax}
+inline-text: {{inline-text-element}}
+;
+\end{syntax}
+
+
+\noindent
+\begin{syntaxleft}
+\nonterm{text-element}\is{}
+\end{syntaxleft}
+
+\begin{tabular}{rlp{10cm}}
+@||@& @inline-text-element@ & \\
+@||@& \nt{blank-line} & force a new line. \\
+\end{tabular}\\
+
+\noindent
+\begin{syntaxleft}
+\nonterm{inline-text-element}\is{}
+\end{syntaxleft}
+
+\begin{tabular}{rlp{10cm}}
+@||@&@ '{' {{ "0" \ldots "9" }} inline-text '}' @ & format @text@ as a section header;
+ the integer following "{" indicates the sectioning level. \\
+@||@&@ '{' {{ "0" \ldots "9" }} ':' @ \nt{label} @ inline-text '}' @ &
+ same, but also associate the name \nt{label} to the current point.
+ This point can be referenced by its fully-qualified label in a
+ "{!" command, just like any other element. \\
+@||@&@ '{b' inline-text '}' @ & set @text@ in bold. \\
+@||@&@ '{i' inline-text '}' @ & set @text@ in italic. \\
+@||@&@ '{e' inline-text '}' @ & emphasize @text@. \\
+@||@&@ '{C' inline-text '}' @ & center @text@. \\
+@||@&@ '{L' inline-text '}' @ & left align @text@. \\
+@||@&@ '{R' inline-text '}' @ & right align @text@. \\
+@||@&@ '{ul' list '}' @ & build a list. \\
+@||@&@ '{ol' list '}' @ & build an enumerated list. \\
+@||@&@ '{{:' string '}' inline-text '}' @ & put a link to the given address
+(given as @string@) on the given @text@. \\
+@||@&@ '[' string ']' @ & set the given @string@ in source code style. \\
+@||@&@ '{[' string ']}' @ & set the given @string@ in preformatted
+ source code style.\\
+@||@&@ '{v' string 'v}' @ & set the given @string@ in verbatim style. \\
+@||@&@ '{%' string '%}' @ & target-specific content
+ (\LaTeX\ code by default, see details
+ in \ref{sss:ocamldoc-target-specific-syntax}) \\
+@||@&@ '{!' string '}' @ & insert a cross-reference to an element
+ (see section \ref{sss:ocamldoc-crossref} for the syntax of cross-references).\\
+@||@&@ '{!modules:' string string ... '}' @ & insert an index table
+for the given module names. Used in HTML only.\\
+@||@&@ '{!indexlist}' @ & insert a table of links to the various indexes
+(types, values, modules, ...). Used in HTML only.\\
+@||@&@ '{^' inline-text '}' @ & set text in superscript.\\
+@||@&@ '{_' inline-text '}' @ & set text in subscript.\\
+@||@& \nt{escaped-string} & typeset the given string as is;
+special characters ('"{"', '"}"', '"["', '"]"' and '"\@"')
+must be escaped by a '"\\"'\\
+\end{tabular} \\
+
+\subsubsection{sss:ocamldoc-list}{List formatting}
+
+\begin{syntax}
+list:
+| {{ '{-' inline-text '}' }}
+| {{ '{li' inline-text '}' }}
+\end{syntax}
+
+A shortcut syntax exists for lists and enumerated lists:
+\begin{verbatim}
+(** Here is a {b list}
+- item 1
+- item 2
+- item 3
+
+The list is ended by the blank line.*)
+\end{verbatim}
+is equivalent to:
+\begin{verbatim}
+(** Here is a {b list}
+{ul {- item 1}
+{- item 2}
+{- item 3}}
+The list is ended by the blank line.*)
+\end{verbatim}
+
+The same shortcut is available for enumerated lists, using '"+"'
+instead of '"-"'.
+Note that only one list can be defined by this shortcut in nested lists.
+
+\subsubsection{sss:ocamldoc-crossref}{Cross-reference formatting}
+
+Cross-references are fully qualified element names, as in the example
+"{!Foo.Bar.t}". This is an ambiguous reference as it may designate
+a type name, a value name, a class name, etc. It is possible to make
+explicit the intended syntactic class, using "{!type:Foo.Bar.t}" to
+designate a type, and "{!val:Foo.Bar.t}" a value of the same name.
+
+The list of possible syntactic class is as follows:
+\begin{center}
+\begin{tabular}{rl}
+\multicolumn{1}{c}{"tag"} & \multicolumn{1}{c}{syntactic class}\\ \hline
+"module:" & module \\
+"modtype:" & module type \\
+"class:" & class \\
+"classtype:" & class type \\
+"val:" & value \\
+"type:" & type \\
+"exception:" & exception \\
+"attribute:" & attribute \\
+"method:" & class method \\
+"section:" & ocamldoc section \\
+"const:" & variant constructor \\
+"recfield:" & record field
+\end{tabular}
+\end{center}
+
+In the case of variant constructors or record field, the constructor
+or field name should be preceded by the name of the correspond type --
+to avoid the ambiguity of several types having the same constructor
+names. For example, the constructor "Node" of the type "tree" will be
+referenced as "{!tree.Node}" or "{!const:tree.Node}", or possibly
+"{!Mod1.Mod2.tree.Node}" from outside the module.
+
+\subsubsection{sss:ocamldoc-preamble}{First sentence}
+
+In the description of a value, type, exception, module, module type, class
+or class type, the {\em first sentence} is sometimes used in indexes, or
+when just a part of the description is needed. The first sentence
+is composed of the first characters of the description, until
+\begin{itemize}
+\item the first dot followed by a blank, or
+\item the first blank line
+\end{itemize}
+outside of the following text formatting :
+@ '{ul' list '}' @,
+@ '{ol' list '}' @,
+@ '[' string ']' @,
+@ '{[' string ']}' @,
+@ '{v' string 'v}' @,
+@ '{%' string '%}' @,
+@ '{!' string '}' @,
+@ '{^' text '}' @,
+@ '{_' text '}' @.
+
+\subsubsection{sss:ocamldoc-target-specific-syntax}{Target-specific formatting}
+
+The content inside "{%foo: ... %}" is target-specific and will only be
+interpreted by the backend "foo", and ignored by the others. The
+backends of the distribution are "latex", "html", "texi" and "man". If
+no target is specified (syntax "{% ... %}"), "latex" is chosen by
+default. Custom generators may support their own target prefix.
+
+\subsubsection{sss:ocamldoc-html-tags}{Recognized HTML tags}
+The HTML tags "<b>..</b>",
+"<code>..</code>",
+"<i>..</i>",
+"<ul>..</ul>",
+"<ol>..</ol>",
+"<li>..</li>",
+"<center>..</center>" and
+"<h[0-9]>..</h[0-9]>" can be used instead of, respectively,
+@ '{b ..}' @,
+@ '[..]' @,
+@ '{i ..}' @,
+@ '{ul ..}' @,
+@ '{ol ..}' @,
+@ '{li ..}' @,
+@ '{C ..}' @ and
+"{[0-9] ..}".
+
+%disable section numbering for subsubsections
+\setcounter{secnumdepth}{2}
+
+%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-tags}{Documentation tags (\@-tags)}
+
+
+\subsubsection{sss:ocamldoc-builtin-tags}{Predefined tags}
+The following table gives the list of predefined \@-tags, with their
+syntax and meaning.\\
+
+\begin{tabular}{|p{5cm}|p{10cm}|}\hline
+@ "@author" string @ & The author of the element. One author per
+"\@author" tag.
+There may be several "\@author" tags for the same element. \\ \hline
+
+@ "@deprecated" text @ & The @text@ should describe when the element was
+deprecated, what to use as a replacement, and possibly the reason
+for deprecation. \\ \hline
+
+@ "@param" id text @ & Associate the given description (@text@) to the
+given parameter name @id@. This tag is used for functions,
+methods, classes and functors. \\ \hline
+
+@ "@raise" Exc text @ & Explain that the element may raise
+ the exception @Exc@. \\ \hline
+
+@ "@return" text @ & Describe the return value and
+ its possible values. This tag is used for functions
+ and methods. \\ \hline
+
+@ "@see" '<' URL '>' text @ & Add a reference to the @URL@
+with the given @text@ as comment. \\ \hline
+
+@ "@see" "'"@\nt{filename}@"'" text @ & Add a reference to the given file name
+(written between single quotes), with the given @text@ as comment. \\ \hline
+
+@ "@see" '"'@\nt{document-name}@'"' text @ & Add a reference to the given
+document name (written between double quotes), with the given @text@
+as comment. \\ \hline
+
+@ "@since" string @ & Indicate when the element was introduced. \\ \hline
+
+@ "@before" @ \nt{version} @ text @ & Associate the given description (@text@)
+to the given \nt{version} in order to document compatibility issues. \\ \hline
+
+@ "@version" string @ & The version number for the element. \\ \hline
+\end{tabular}
+
+\subsubsection{sss:ocamldoc-custom-tags}{Custom tags}
+You can use custom tags in the documentation comments, but they will
+have no effect if the generator used does not handle them. To use a
+custom tag, for example "foo", just put "\@foo" with some text in your
+comment, as in:
+\begin{verbatim}
+(** My comment to show you a custom tag.
+@foo this is the text argument to the [foo] custom tag.
+*)
+\end{verbatim}
+
+To handle custom tags, you need to define a custom generator,
+as explained in section \ref{ss:ocamldoc-handling-custom-tags}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{s:ocamldoc-custom-generators}{Custom generators}
+
+OCamldoc operates in two steps:
+\begin{enumerate}
+\item analysis of the source files;
+\item generation of documentation, through a documentation generator,
+ which is an object of class "Odoc_args.class_generator".
+\end{enumerate}
+Users can provide their own documentation generator to be used during
+step 2 instead of the default generators.
+All the information retrieved during the analysis step is available through
+the "Odoc_info" module, which gives access to all the types and functions
+ representing the elements found in the given modules, with their associated
+description.
+
+The files you can use to define custom generators are installed in the
+"ocamldoc" sub-directory of the OCaml standard library.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-generators}{The generator modules}
+The type of a generator module depends on the kind of generated documentation.
+Here is the list of generator module types, with the name of the generator
+class in the module~:
+\begin{itemize}
+\item for HTML~: "Odoc_html.Html_generator" (class "html"),
+\item for \LaTeX~: "Odoc_latex.Latex_generator" (class "latex"),
+\item for TeXinfo~: "Odoc_texi.Texi_generator" (class "texi"),
+\item for man pages~: "Odoc_man.Man_generator" (class "man"),
+\item for graphviz (dot)~: "Odoc_dot.Dot_generator" (class "dot"),
+\item for other kinds~: "Odoc_gen.Base" (class "generator").
+\end{itemize}
+That is, to define a new generator, one must implement a module with
+the expected signature, and with the given generator class, providing
+the "generate" method as entry point to make the generator generates
+documentation for a given list of modules~:
+
+\begin{verbatim}
+ method generate : Odoc_info.Module.t_module list -> unit
+\end{verbatim}
+
+\noindent{}This method will be called with the list of analysed and possibly
+merged "Odoc_info.t_module" structures.
+
+It is recommended to inherit from the current generator of the same
+kind as the one you want to define. Doing so, it is possible to
+load various custom generators to combine improvements brought by each one.
+
+This is done using first class modules (see chapter \ref{s:first-class-modules}).
+
+The easiest way to define a custom generator is the following this example,
+here extending the current HTML generator. We don't have to know if this is
+the original HTML generator defined in ocamldoc or if it has been extended
+already by a previously loaded custom generator~:
+
+\begin{verbatim}
+module Generator (G : Odoc_html.Html_generator) =
+struct
+ class html =
+ object(self)
+ inherit G.html as html
+ (* ... *)
+
+ method generate module_list =
+ (* ... *)
+ ()
+
+ (* ... *)
+ end
+end;;
+
+let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
+\end{verbatim}
+
+To know which methods to override and/or which methods are available,
+have a look at the different base implementations, depending on the
+kind of generator you are extending~:
+\newcommand\ocamldocsrc[2]{\href{https://github.com/ocaml/ocaml/blob/{\ocamlversion}/ocamldoc/odoc_#1.ml}{#2}}
+\begin{itemize}
+\item for HTML~: \ocamldocsrc{html}{"odoc_html.ml"},
+\item for \LaTeX~: \ocamldocsrc{latex}{"odoc_latex.ml"},
+\item for TeXinfo~: \ocamldocsrc{texi}{"odoc_texi.ml"},
+\item for man pages~: \ocamldocsrc{man}{"odoc_man.ml"},
+\item for graphviz (dot)~: \ocamldocsrc{dot}{"odoc_dot.ml"}.
+\end{itemize}
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-handling-custom-tags}{Handling custom tags}
+
+Making a custom generator handle custom tags (see
+\ref{sss:ocamldoc-custom-tags}) is very simple.
+
+\subsubsection*{sss:ocamldoc-html-generator}{For HTML}
+Here is how to develop a HTML generator handling your custom tags.
+
+The class "Odoc_html.Generator.html" inherits
+from the class "Odoc_html.info", containing a field "tag_functions" which is a
+list pairs composed of a custom tag (e.g. "\"foo\"") and a function taking
+a "text" and returning HTML code (of type "string").
+To handle a new tag "bar", extend the current HTML generator
+ and complete the "tag_functions" field:
+\begin{verbatim}
+module Generator (G : Odoc_html.Html_generator) =
+struct
+ class html =
+ object(self)
+ inherit G.html
+
+ (** Return HTML code for the given text of a bar tag. *)
+ method html_of_bar t = (* your code here *)
+
+ initializer
+ tag_functions <- ("bar", self#html_of_bar) :: tag_functions
+ end
+end
+let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor);;
+\end{verbatim}
+
+Another method of the class "Odoc_html.info" will look for the
+function associated to a custom tag and apply it to the text given to
+the tag. If no function is associated to a custom tag, then the method
+prints a warning message on "stderr".
+
+\subsubsection{sss:ocamldoc-other-generators}{For other generators}
+You can act the same way for other kinds of generators.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\section{s:ocamldoc-adding-flags}{Adding command line options}
+The command line analysis is performed after loading the module containing the
+documentation generator, thus allowing command line options to be added to the
+ list of existing ones. Adding an option can be done with the function
+\begin{verbatim}
+ Odoc_args.add_option : string * Arg.spec * string -> unit
+\end{verbatim}
+\noindent{}Note: Existing command line options can be redefined using
+this function.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%
+\subsection{ss:ocamldoc-compilation-and-usage}{Compilation and usage}
+
+%%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-generator-class}{Defining a custom generator class in one file}
+Let "custom.ml" be the file defining a new generator class.
+Compilation of "custom.ml" can be performed by the following command~:
+\begin{alltt}
+ ocamlc -I +ocamldoc -c custom.ml
+\end{alltt}
+\noindent{}The file "custom.cmo" is created and can be used this way~:
+\begin{alltt}
+ ocamldoc -g custom.cmo \var{other-options} \var{source-files}
+\end{alltt}
+\noindent{}Options selecting a built-in generator to "ocamldoc", such as
+"-html", have no effect if a custom generator of the same kind is provided using
+"-g". If the kinds do not match, the selected built-in generator is used and the
+custom one is ignored.
+
+%%%%%%%%%%%%%%
+\subsubsection{sss:ocamldoc-modular-generator}{Defining a custom generator class in several files}
+It is possible to define a generator class in several modules, which
+are defined in several files \var{\nth{file}{1}}".ml"["i"],
+\var{\nth{file}{2}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]. A ".cma"
+library file must be created, including all these files.
+
+The following commands create the "custom.cma" file from files
+\var{\nth{file}{1}}".ml"["i"], ..., \var{\nth{file}{n}}".ml"["i"]~:
+\begin{alltt}
+ocamlc -I +ocamldoc -c \var{\nth{file}{1}}.ml\textrm{[}i\textrm{]}
+ocamlc -I +ocamldoc -c \var{\nth{file}{2}}.ml\textrm{[}i\textrm{]}
+...
+ocamlc -I +ocamldoc -c \var{\nth{file}{n}}.ml\textrm{[}i\textrm{]}
+ocamlc -o custom.cma -a \var{\nth{file}{1}}.cmo \var{\nth{file}{2}}.cmo ... \var{\nth{file}{n}}.cmo
+\end{alltt}
+\noindent{}Then, the following command uses "custom.cma" as custom generator:
+\begin{alltt}
+ ocamldoc -g custom.cma \var{other-options} \var{source-files}
+\end{alltt}
--- /dev/null
+\chapter{Profiling (ocamlprof)} \label{c:profiler}
+%HEVEA\cutname{profil.html}
+
+This chapter describes how the execution of OCaml
+programs can be profiled, by recording how many times functions are
+called, branches of conditionals are taken, \ldots
+
+\section{s:ocamlprof-compiling}{Compiling for profiling}
+
+Before profiling an execution, the program must be compiled in
+profiling mode, using the "ocamlcp" front-end to the "ocamlc" compiler
+(see chapter~\ref{c:camlc}) or the "ocamloptp" front-end to the
+"ocamlopt" compiler (see chapter~\ref{c:nativecomp}). When compiling
+modules separately, "ocamlcp" or "ocamloptp" must be used when
+compiling the modules (production of ".cmo" or ".cmx" files), and can
+also be used (though this is not strictly necessary) when linking them
+together.
+
+\lparagraph{p:ocamlprof-warning}{Note} If a module (".ml" file) doesn't have a corresponding
+interface (".mli" file), then compiling it with "ocamlcp" will produce
+object files (".cmi" and ".cmo") that are not compatible with the ones
+produced by "ocamlc", which may lead to problems (if the ".cmi" or
+".cmo" is still around) when switching between profiling and
+non-profiling compilations. To avoid this problem, you should always
+have a ".mli" file for each ".ml" file. The same problem exists with
+"ocamloptp".
+
+\lparagraph{p:ocamlprof-reserved}{Note} To make sure your programs can be compiled in
+profiling mode, avoid using any identifier that begins with
+"__ocaml_prof".
+
+The amount of profiling information can be controlled through the "-P"
+option to "ocamlcp" or "ocamloptp", followed by one or several letters
+indicating which parts of the program should be profiled:
+
+%% description des options
+\begin{options}
+\item["a"] all options
+\item["f"] function calls : a count point is set at the beginning of
+each function body
+\item["i"] {\bf if \ldots then \ldots else \ldots} : count points are set in
+both {\bf then} branch and {\bf else} branch
+\item["l"] {\bf while, for} loops: a count point is set at the beginning of
+the loop body
+\item["m"] {\bf match} branches: a count point is set at the beginning of the
+body of each branch
+\item["t"] {\bf try \ldots with \ldots} branches: a count point is set at the
+beginning of the body of each branch
+\end{options}
+
+For instance, compiling with "ocamlcp -P film" profiles function calls,
+if\ldots then\ldots else\ldots, loops and pattern matching.
+
+Calling "ocamlcp" or "ocamloptp" without the "-P" option defaults to
+"-P fm", meaning that only function calls and pattern matching are
+profiled.
+
+\paragraph{Note} For compatibility with previous releases, "ocamlcp"
+also accepts the "-p" option, with the same arguments and behaviour as
+"-P".
+
+The "ocamlcp" and "ocamloptp" commands also accept all the options of
+the corresponding "ocamlc" or "ocamlopt" compiler, except the "-pp"
+(preprocessing) option.
+
+
+\section{s:ocamlprof-profiling}{Profiling an execution}
+
+Running an executable that has been compiled with "ocamlcp" or
+"ocamloptp" records the execution counts for the specified parts of
+the program and saves them in a file called "ocamlprof.dump" in the
+current directory.
+
+If the environment variable "OCAMLPROF_DUMP" is set when the program
+exits, its value is used as the file name instead of "ocamlprof.dump".
+
+The dump file is written only if the program terminates
+normally (by calling "exit" or by falling through). It is not written
+if the program terminates with an uncaught exception.
+
+If a compatible dump file already exists in the current directory, then the
+profiling information is accumulated in this dump file. This allows, for
+instance, the profiling of several executions of a program on
+different inputs. Note that dump files produced by byte-code
+executables (compiled with "ocamlcp") are compatible with the dump
+files produced by native executables (compiled with "ocamloptp").
+
+\section{s:ocamlprof-printing}{Printing profiling information}
+
+The "ocamlprof" command produces a source listing of the program modules
+where execution counts have been inserted as comments. For instance,
+\begin{verbatim}
+ ocamlprof foo.ml
+\end{verbatim}
+prints the source code for the "foo" module, with comments indicating
+how many times the functions in this module have been called. Naturally,
+this information is accurate only if the source file has not been modified
+after it was compiled.
+
+The following options are recognized by "ocamlprof":
+
+\begin{options}
+
+\item["-args" \var{filename}]
+ Read additional newline-terminated command line arguments from \var{filename}.
+
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from \var{filename}.
+
+\item["-f" \var{dumpfile}]
+Specifies an alternate dump file of profiling information to be read.
+
+\item["-F" \var{string}]
+Specifies an additional string to be output with profiling information.
+By default, "ocamlprof" will annotate programs with comments of the form
+{\tt (* \var{n} *)} where \var{n} is the counter value for a profiling
+point. With option {\tt -F \var{s}}, the annotation will be
+{\tt (* \var{s}\var{n} *)}.
+
+\item["-impl" \var{filename}]
+Process the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+
+\item["-intf" \var{filename}]
+Process the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+%
+\end{options}
+
+\section{s:ocamlprof-time-profiling}{Time profiling}
+
+Profiling with "ocamlprof" only records execution counts, not the actual
+time spent within each function. There is currently no way to perform
+time profiling on bytecode programs generated by "ocamlc". For time
+profiling of native code, users are recommended to use standard tools
+such as perf (on Linux), Instruments (on macOS) and DTrace. Profiling
+with "gprof" is no longer supported.
--- /dev/null
+\chapter{The runtime system (ocamlrun)} \label{c:runtime}
+%HEVEA\cutname{runtime.html}
+
+The "ocamlrun" command executes bytecode files produced by the
+linking phase of the "ocamlc" command.
+
+\section{s:ocamlrun-overview}{Overview}
+
+The "ocamlrun" command comprises three main parts: the bytecode
+interpreter, that actually executes bytecode files; the memory
+allocator and garbage collector; and a set of C functions that
+implement primitive operations such as input/output.
+
+The usage for "ocamlrun" is:
+\begin{alltt}
+ ocamlrun \var{options} \var{bytecode-executable} \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+The first non-option argument is taken to be the name of the file
+containing the executable bytecode. (That file is searched in the
+executable path as well as in the current directory.) The remaining
+arguments are passed to the OCaml program, in the string array
+"Sys.argv". Element 0 of this array is the name of the
+bytecode executable file; elements 1 to \var{n} are the remaining
+arguments \nth{arg}{1} to \nth{arg}{n}.
+
+As mentioned in chapter~\ref{c:camlc}, the bytecode executable files
+produced by the "ocamlc" command are self-executable, and manage to
+launch the "ocamlrun" command on themselves automatically. That is,
+assuming "a.out" is a bytecode executable file,
+\begin{alltt}
+ a.out \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+works exactly as
+\begin{alltt}
+ ocamlrun a.out \nth{arg}{1} ... \nth{arg}{n}
+\end{alltt}
+Notice that it is not possible to pass options to "ocamlrun" when
+invoking "a.out" directly.
+
+\begin{windows}
+Under several versions of Windows, bytecode executable files are
+self-executable only if their name ends in ".exe". It is recommended
+to always give ".exe" names to bytecode executables, e.g. compile
+with "ocamlc -o myprog.exe ..." rather than "ocamlc -o myprog ...".
+\end{windows}
+
+\section{s:ocamlrun-options}{Options}
+The following command-line options are recognized by "ocamlrun".
+
+\begin{options}
+
+\item["-b"]
+When the program aborts due to an uncaught exception, print a detailed
+``back trace'' of the execution, showing where the exception was
+raised and which function calls were outstanding at this point. The
+back trace is printed only if the bytecode executable contains
+debugging information, i.e. was compiled and linked with the "-g"
+option to "ocamlc" set. This is equivalent to setting the "b" flag
+in the "OCAMLRUNPARAM" environment variable (see below).
+\item["-config"]
+Print the version number of "ocamlrun" and a detailed summary of its
+configuration, then exit.
+\item["-I" \var{dir}]
+Search the directory \var{dir} for dynamically-loaded libraries,
+in addition to the standard search path (see
+section~\ref{s:ocamlrun-dllpath}).
+\item["-m"]
+Print the magic number of the bytecode executable given as argument
+and exit.
+\item["-M"]
+Print the magic number expected by this version of the runtime and exit.
+\item["-p"]
+Print the names of the primitives known to this version of
+"ocamlrun" and exit.
+\item["-t"]
+Increments the trace level for the debug runtime (ignored otherwise).
+\item["-v"]
+Direct the memory manager to print some progress messages on
+standard error. This is equivalent to setting "v=61" in the
+"OCAMLRUNPARAM" environment variable (see below).
+\item["-version"]
+Print version string and exit.
+\item["-vnum"]
+Print short version number and exit.
+
+\end{options}
+
+\noindent
+The following environment variables are also consulted:
+
+\begin{options}
+\item["CAML_LD_LIBRARY_PATH"] Additional directories to search for
+ dynamically-loaded libraries (see section~\ref{s:ocamlrun-dllpath}).
+
+\item["OCAMLLIB"] The directory containing the OCaml standard
+ library. (If "OCAMLLIB" is not set, "CAMLLIB" will be used instead.)
+ Used to locate the "ld.conf" configuration file for
+ dynamic loading (see section~\ref{s:ocamlrun-dllpath}). If not set,
+ default to the library directory specified when compiling OCaml.
+
+\item["OCAMLRUNPARAM"] Set the runtime system options
+ and garbage collection parameters.
+ (If "OCAMLRUNPARAM" is not set, "CAMLRUNPARAM" will be used instead.)
+ This variable must be a sequence of parameter specifications separated
+ by commas.
+ For convenience, commas at the beginning of the variable are ignored,
+ and multiple runs of commas are interpreted as a single one.
+ A parameter specification is an option letter followed by an "="
+ sign, a decimal number (or an hexadecimal number prefixed by "0x"),
+ and an optional multiplier. The options are documented below;
+ the last six correspond to the fields of the
+ "control" record documented in
+\ifouthtml
+ \ahref{libref/Gc.html}{Module \texttt{Gc}}.
+\else
+ section~\ref{Gc}.
+\fi
+ \begin{options}
+ \item[b] (backtrace) Trigger the printing of a stack backtrace
+ when an uncaught exception aborts the program. An optional argument can
+ be provided: "b=0" turns backtrace printing off; "b=1" is equivalent to
+ "b" and turns backtrace printing on; "b=2" turns backtrace printing on
+ and forces the runtime system to load debugging information at program
+ startup time instead of at backtrace printing time. "b=2" can be used if
+ the runtime is unable to load debugging information at backtrace
+ printing time, for example if there are no file descriptors available.
+ \item[p] (parser trace) Turn on debugging support for
+ "ocamlyacc"-generated parsers. When this option is on,
+ the pushdown automaton that executes the parsers prints a
+ trace of its actions. This option takes no argument.
+ \item[R] (randomize) Turn on randomization of all hash tables by default
+ (see
+\ifouthtml
+ \ahref{libref/Hashtbl.html}{Module \texttt{Hashtbl}}).
+\else
+ section~\ref{Hashtbl}).
+\fi
+ This option takes no argument.
+ \item[h] The initial size of the major heap (in words).
+ \item[a] ("allocation_policy")
+ The policy used for allocating in the OCaml heap. Possible values
+ are "0" for the next-fit policy, "1" for the first-fit
+ policy, and "2" for the best-fit policy. The default is "2" (best-fit).
+ See the Gc module documentation for details.
+ \item[s] ("minor_heap_size") Size of the minor heap. (in words)
+ \item[i] ("major_heap_increment") Default size increment for the
+ major heap. (in words)
+ \item[o] ("space_overhead") The major GC speed setting.
+ See the Gc module documentation for details.
+ \item[O] ("max_overhead") The heap compaction trigger setting.
+ \item[l] ("stack_limit") The limit (in words) of the stack size. This is only
+ relevant to the byte-code runtime, as the native code runtime uses the
+ operating system's stack.
+ \item[v] ("verbose") What GC messages to print to stderr. This
+ is a sum of values selected from the following:
+ \begin{options}
+ \item[1 (= 0x001)] Start and end of major GC cycle.
+ \item[2 (= 0x002)] Minor collection and major GC slice.
+ \item[4 (= 0x004)] Growing and shrinking of the heap.
+ \item[8 (= 0x008)] Resizing of stacks and memory manager tables.
+ \item[16 (= 0x010)] Heap compaction.
+ \item[32 (= 0x020)] Change of GC parameters.
+ \item[64 (= 0x040)] Computation of major GC slice size.
+ \item[128 (= 0x080)] Calling of finalization functions
+ \item[256 (= 0x100)] Startup messages (loading the bytecode
+ executable file, resolving shared libraries).
+ \item[512 (= 0x200)] Computation of compaction-triggering condition.
+ \item[1024 (= 0x400)] Output GC statistics at program exit.
+ \end{options}
+ \item[c] ("cleanup_on_exit") Shut the runtime down gracefully on exit (see
+ "caml_shutdown" in section~\ref{ss:c-embedded-code}). The option also enables
+ pooling (as in "caml_startup_pooled"). This mode can be used to detect
+ leaks with a third-party memory debugger.
+ % FIXME missing: H, t, w, W see MPR#7870
+ \item[M] ("custom_major_ratio") Target ratio of floating garbage to
+ major heap size for out-of-heap memory held by custom values
+ (e.g. bigarrays) located in the major heap. The GC speed is adjusted
+ to try to use this much memory for dead values that are not yet
+ collected. Expressed as a percentage of major heap size. Default:
+ 44. Note: this only applies to values allocated with
+ "caml_alloc_custom_mem".
+ \item[m] ("custom_minor_ratio") Bound on floating garbage for
+ out-of-heap memory
+ held by custom values in the minor heap. A minor GC is triggered
+ when this much memory is held by custom values located in the minor
+ heap. Expressed as a percentage of minor heap size. Default:
+ 100. Note: this only applies to values allocated with
+ "caml_alloc_custom_mem".
+ \item[n] ("custom_minor_max_size") Maximum amount of out-of-heap
+ memory for each custom value allocated in the minor heap. When a custom
+ value is allocated on the minor heap and holds more than this many
+ bytes, only this value is counted against "custom_minor_ratio" and
+ the rest is directly counted against "custom_major_ratio".
+ Default: 8192 bytes. Note:
+ this only applies to values allocated with "caml_alloc_custom_mem".
+ \end{options}
+ The multiplier is "k", "M", or "G", for multiplication by $2^{10}$,
+ $2^{20}$, and $2^{30}$ respectively.
+
+ If the option letter is not recognized, the whole parameter is ignored;
+ if the equal sign or the number is missing, the value is taken as 1;
+ if the multiplier is not recognized, it is ignored.
+
+ For example, on a 32-bit machine, under "bash" the command
+\begin{verbatim}
+ export OCAMLRUNPARAM='b,s=256k,v=0x015'
+\end{verbatim}
+ tells a subsequent "ocamlrun" to print backtraces for uncaught exceptions,
+ set its initial minor heap size to 1~megabyte and
+ print a message at the start of each major GC cycle, when the heap
+ size changes, and when compaction is triggered.
+
+\item["CAMLRUNPARAM"] If "OCAMLRUNPARAM" is not found in the
+ environment, then "CAMLRUNPARAM" will be used instead. If
+ "CAMLRUNPARAM" is also not found, then the default values will be used.
+
+\item["PATH"] List of directories searched to find the bytecode
+executable file.
+\end{options}
+
+\section{s:ocamlrun-dllpath}{Dynamic loading of shared libraries}
+
+On platforms that support dynamic loading, "ocamlrun" can link
+dynamically with C shared libraries (DLLs) providing additional C primitives
+beyond those provided by the standard runtime system. The names for
+these libraries are provided at link time as described in
+section~\ref{ss:dynlink-c-code}), and recorded in the bytecode executable
+file; "ocamlrun", then, locates these libraries and resolves references
+to their primitives when the bytecode executable program starts.
+
+The "ocamlrun" command searches shared libraries in the following
+directories, in the order indicated:
+\begin{enumerate}
+\item Directories specified on the "ocamlrun" command line with the
+"-I" option.
+\item Directories specified in the "CAML_LD_LIBRARY_PATH" environment
+variable.
+\item Directories specified at link-time via the "-dllpath" option to
+"ocamlc". (These directories are recorded in the bytecode executable
+file.)
+\item Directories specified in the file "ld.conf". This file resides
+in the OCaml standard library directory, and lists directory
+names (one per line) to be searched. Typically, it contains only one
+line naming the "stublibs" subdirectory of the OCaml standard
+library directory. Users can add there the names of other directories
+containing frequently-used shared libraries; however, for consistency
+of installation, we recommend that shared libraries are installed
+directly in the system "stublibs" directory, rather than adding lines
+to the "ld.conf" file.
+\item Default directories searched by the system dynamic loader.
+Under Unix, these generally include "/lib" and "/usr/lib", plus the
+directories listed in the file "/etc/ld.so.conf" and the environment
+variable "LD_LIBRARY_PATH". Under Windows, these include the Windows
+system directories, plus the directories listed in the "PATH"
+environment variable.
+\end{enumerate}
+
+\section{s:ocamlrun-common-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[{\it filename}": no such file or directory"]
+If {\it filename} is the name of a self-executable bytecode file, this
+means that either that file does not exist, or that it failed to run
+the "ocamlrun" bytecode interpreter on itself. The second possibility
+indicates that OCaml has not been properly installed on your
+system.
+
+\item["Cannot exec ocamlrun"]
+(When launching a self-executable bytecode file.) The "ocamlrun"
+ could not be found in the executable path. Check that OCaml
+ has been properly installed on your system.
+
+\item["Cannot find the bytecode file"]
+The file that "ocamlrun" is trying to execute (e.g. the file given as
+first non-option argument to "ocamlrun") either does not exist, or is
+not a valid executable bytecode file.
+
+\item["Truncated bytecode file"]
+The file that "ocamlrun" is trying to execute is not a valid executable
+bytecode file. Probably it has been truncated or mangled since
+created. Erase and rebuild it.
+
+\item["Uncaught exception"]
+The program being executed contains a ``stray'' exception. That is,
+it raises an exception at some point, and this exception is never
+caught. This causes immediate termination of the program. The name of
+the exception is printed, along with its string, byte sequence, and
+integer arguments
+(arguments of more complex types are not correctly printed).
+To locate the context of the uncaught exception, compile the program
+with the "-g" option and either run it again under the "ocamldebug"
+debugger (see chapter~\ref{c:debugger}), or run it with "ocamlrun -b"
+or with the "OCAMLRUNPARAM" environment variable set to "b=1".
+
+\item["Out of memory"]
+The program being executed requires more memory than available. Either
+the program builds excessively large data structures; or the program
+contains too many nested function calls, and the stack overflows. In
+some cases, your program is perfectly correct, it just requires more
+memory than your machine provides. In other cases, the ``out of
+memory'' message reveals an error in your program: non-terminating
+recursive function, allocation of an excessively large array,
+string or byte sequence, attempts to build an infinite list or other
+data structure, \ldots
+
+To help you diagnose this error, run your program with the "-v" option
+to "ocamlrun", or with the "OCAMLRUNPARAM" environment variable set to
+"v=63". If it displays lots of ``"Growing stack"\ldots''
+messages, this is probably a looping recursive function. If it
+displays lots of ``"Growing heap"\ldots'' messages, with the heap size
+growing slowly, this is probably an attempt to construct a data
+structure with too many (infinitely many?) cells. If it displays few
+``"Growing heap"\ldots'' messages, but with a huge increment in the
+heap size, this is probably an attempt to build an excessively large
+array, string or byte sequence.
+
+\end{options}
--- /dev/null
+\chapter{The toplevel system or REPL (ocaml)} \label{c:camllight}
+%HEVEA\cutname{toplevel.html}
+
+This chapter describes the toplevel system for OCaml, that permits
+interactive use of the OCaml system
+through a read-eval-print loop (REPL). In this mode, the system repeatedly
+reads OCaml phrases from the input, then typechecks, compile and
+evaluate them, then prints the inferred type and result value, if
+any. The system prints a "#" (sharp) prompt before reading each
+phrase.
+
+Input to the toplevel can span several lines. It is terminated by @";;"@ (a
+double-semicolon). The toplevel input consists in one or several
+toplevel phrases, with the following syntax:
+
+\begin{syntax}
+toplevel-input:
+ {{ definition }} ';;'
+ | expr ';;'
+ | '#' ident [ directive-argument ] ';;'
+;
+directive-argument:
+ string-literal
+ | integer-literal
+ | value-path
+ | 'true' || 'false'
+\end{syntax}
+
+A phrase can consist of a definition, like those found in
+implementations of compilation units or in @'struct' \ldots 'end'@
+module expressions. The definition can bind value names, type names,
+an exception, a module name, or a module type name. The toplevel
+system performs the bindings, then prints the types and values (if
+any) for the names thus defined.
+
+A phrase may also consist in a value expression
+(section~\ref{s:value-expr}). It is simply evaluated
+without performing any bindings, and its value is
+printed.
+
+Finally, a phrase can also consist in a toplevel directive,
+starting with @"#"@ (the sharp sign). These directives control the
+behavior of the toplevel; they are listed below in
+section~\ref{s:toplevel-directives}.
+
+\begin{unix}
+The toplevel system is started by the command "ocaml", as follows:
+\begin{alltt}
+ ocaml \var{options} \var{objects} # interactive mode
+ ocaml \var{options} \var{objects} \var{scriptfile} # script mode
+\end{alltt}
+\var{options} are described below.
+\var{objects} are filenames ending in ".cmo" or ".cma"; they are
+loaded into the interpreter immediately after \var{options} are set.
+\var{scriptfile} is any file name not ending in ".cmo" or ".cma".
+
+If no \var{scriptfile} is given on the command line, the toplevel system
+enters interactive mode: phrases are read on standard input, results
+are printed on standard output, errors on standard error. End-of-file
+on standard input terminates "ocaml" (see also the "#quit" directive
+in section~\ref{s:toplevel-directives}).
+
+On start-up (before the first phrase is read), if the file
+".ocamlinit" exists in the current directory,
+its contents are read as a sequence of OCaml phrases
+and executed as per the "#use" directive
+described in section~\ref{s:toplevel-directives}.
+The evaluation outcode for each phrase are not displayed.
+If the current directory does not contain an ".ocamlinit" file,
+the file "XDG_CONFIG_HOME/ocaml/init.ml" is looked up according
+to the XDG base directory specification and used instead (on Windows
+this is skipped). If that file doesn't exist then an [.ocamlinit] file
+in the users' home directory (determined via environment variable "HOME") is
+used if existing.
+
+The toplevel system does not perform line editing, but it can
+easily be used in conjunction with an external line editor such as
+"ledit", or "rlwrap". An improved toplevel, "utop", is also available.
+Another option is to use "ocaml" under Gnu Emacs, which gives the
+full editing power of Emacs (command "run-caml" from library "inf-caml").
+
+At any point, the parsing, compilation or evaluation of the current
+phrase can be interrupted by pressing "ctrl-C" (or, more precisely,
+by sending the "INTR" signal to the "ocaml" process). The toplevel
+then immediately returns to the "#" prompt.
+
+If \var{scriptfile} is given on the command-line to "ocaml", the toplevel
+system enters script mode: the contents of the file are read as a
+sequence of OCaml phrases and executed, as per the "#use"
+directive (section~\ref{s:toplevel-directives}). The outcome of the
+evaluation is not printed. On reaching the end of file, the "ocaml"
+command exits immediately. No commands are read from standard input.
+"Sys.argv" is transformed, ignoring all OCaml parameters, and
+starting with the script file name in "Sys.argv.(0)".
+
+In script mode, the first line of the script is ignored if it starts
+with "#!". Thus, it should be possible to make the script
+itself executable and put as first line "#!/usr/local/bin/ocaml",
+thus calling the toplevel system automatically when the script is
+run. However, "ocaml" itself is a "#!" script on most installations
+of OCaml, and Unix kernels usually do not handle nested "#!"
+scripts. A better solution is to put the following as the first line
+of the script:
+\begin{verbatim}
+ #!/usr/local/bin/ocamlrun /usr/local/bin/ocaml
+\end{verbatim}
+
+\end{unix}
+
+\section{s:toplevel-options}{Options}
+
+The following command-line options are recognized by the "ocaml" command.
+% Configure boolean variables used by the macros in unified-options.etex
+\compfalse
+\natfalse
+\toptrue
+% unified-options gathers all options across the native/bytecode
+% compilers and toplevel
+\input{unified-options.tex}
+
+\begin{unix}
+The following environment variables are also consulted:
+\begin{options}
+\item["OCAMLTOP_INCLUDE_PATH"] Additional directories to search for compiled
+ object code files (".cmi", ".cmo" and ".cma"). The specified directories are
+ considered from left to right, after the include directories specified on the
+ command line via "-I" have been searched. Available since OCaml 4.08.
+
+\item["OCAMLTOP_UTF_8"] When printing string values, non-ascii bytes
+($ {} > "\0x7E" $) are printed as decimal escape sequence if "OCAMLTOP_UTF_8" is
+set to false. Otherwise, they are printed unescaped.
+
+\item["TERM"] When printing error messages, the toplevel system
+attempts to underline visually the location of the error. It
+consults the "TERM" variable to determines the type of output terminal
+and look up its capabilities in the terminal database.
+
+\item["XDG_CONFIG_HOME", "HOME"]
+".ocamlinit" lookup procedure (see above).
+\end{options}
+\end{unix}
+
+\section{s:toplevel-directives}{Toplevel directives}
+
+The following directives control the toplevel behavior, load files in
+memory, and trace program execution.
+
+{\bf Note:} all directives start with a "#" (sharp) symbol. This "#"
+must be typed before the directive, and must not be confused with the
+"#" prompt displayed by the interactive loop. For instance,
+typing "#quit;;" will exit the toplevel loop, but typing "quit;;"
+will result in an ``unbound value "quit"'' error.
+
+%
+% Remark: this list of options should be kept synchronized with the documentation
+% in toplevel/topdirs.ml.
+%
+\begin{options}
+\item[General]
+ \begin{options}
+ \item["#help;;"]
+ Prints a list of all available directives, with corresponding argument type
+ if appropriate.
+ \item["#quit;;"]
+ Exit the toplevel loop and terminate the "ocaml" command.
+ \end{options}
+
+\item[Loading codes]
+ \begin{options}
+
+ \item["#cd \""\var{dir-name}"\";;"]
+ Change the current working directory.
+
+ \item["#directory \""\var{dir-name}"\";;"]
+ Add the given directory to the list of directories searched for
+ source and compiled files.
+
+ \item["#remove_directory \""\var{dir-name}"\";;"]
+ Remove the given directory from the list of directories searched for
+ source and compiled files. Do nothing if the list does not contain
+ the given directory.
+
+ \item["#load \""\var{file-name}"\";;"]
+ Load in memory a bytecode object file (".cmo" file) or library file
+ (".cma" file) produced by the batch compiler "ocamlc".
+
+ \item["#load_rec \""\var{file-name}"\";;"]
+ Load in memory a bytecode object file (".cmo" file) or library file
+ (".cma" file) produced by the batch compiler "ocamlc".
+ When loading an object file that depends on other modules
+ which have not been loaded yet, the .cmo files for these modules
+ are searched and loaded as well, recursively. The loading order
+ is not specified.
+
+ \item["#use \""\var{file-name}"\";;"]
+ Read, compile and execute source phrases from the given file.
+ This is textual inclusion: phrases are processed just as if
+ they were typed on standard input. The reading of the file stops at
+ the first error encountered.
+
+ \item["#use_output \""\var{command}"\";;"]
+ Execute a command and evaluate its output as if it had been captured
+ to a file and passed to "#use".
+
+ \item["#mod_use \""\var{file-name}"\";;"]
+ Similar to "#use" but also wrap the code into a top-level module of the
+ same name as capitalized file name without extensions, following
+ semantics of the compiler.
+ \end{options}
+
+For directives that take file names as arguments, if the given file
+name specifies no directory, the file is searched in the following
+directories:
+\begin{enumerate}
+ \item In script mode, the directory containing the script currently
+ executing; in interactive mode, the current working directory.
+ \item Directories added with the "#directory" directive.
+ \item Directories given on the command line with "-I" options.
+ \item The standard library directory.
+\end{enumerate}
+
+\item[Environment queries]
+ \begin{options}
+ \item["#show_class "\var{class-path}";;"]\vspace{-4.7ex}
+ \item["#show_class_type "\var{class-path}";;"]\vspace{-4.7ex}
+ \item["#show_exception "\var{ident}";;"]\vspace{-4.7ex}
+ \item["#show_module "\var{module-path}";;"]\vspace{-4.7ex}
+ \item["#show_module_type "\var{modtype-path}";;"]\vspace{-4.7ex}
+ \item["#show_type "\var{typeconstr}";;"]\vspace{-4.7ex}
+ \item["#show_val "\var{value-path}";;"]
+ Print the signature of the corresponding component.
+
+ \item["#show "\var{ident}";;"]
+ Print the signatures of components with name \var{ident} in all the
+ above categories.
+ \end{options}
+
+\item[Pretty-printing]
+ \begin{options}
+
+ \item["#install_printer "\var{printer-name}";;"]
+ This directive registers the function named \var{printer-name} (a
+ value path) as a printer for values whose types match the argument
+ type of the function. That is, the toplevel loop will call
+ \var{printer-name} when it has such a value to print.
+
+ The printing function \var{printer-name} should have type
+ @"Format.formatter" "->" @t@ "->" "unit"@, where @@t@@ is the
+ type for the values to be printed, and should output its textual
+ representation for the value of type @@t@@ on the given formatter,
+ using the functions provided by the "Format" library. For backward
+ compatibility, \var{printer-name} can also have type
+ @@t@ "->" "unit"@ and should then output on the standard
+ formatter, but this usage is deprecated.
+
+ \item["#print_depth "\var{n}";;"]
+ Limit the printing of values to a maximal depth of \var{n}.
+ The parts of values whose depth exceeds \var{n} are printed as "..."
+ (ellipsis).
+
+ \item["#print_length "\var{n}";;"]
+ Limit the number of value nodes printed to at most \var{n}.
+ Remaining parts of values are printed as "..." (ellipsis).
+
+ \item["#remove_printer "\var{printer-name}";;"]
+ Remove the named function from the table of toplevel printers.
+\end{options}
+
+\item[Tracing]
+ \begin{options}
+ \item["#trace "\var{function-name}";;"]
+ After executing this directive, all calls to the function named
+ \var{function-name} will be ``traced''. That is, the argument and the
+ result are displayed for each call, as well as the exceptions escaping
+ out of the function, raised either by the function itself or by
+ another function it calls. If the function is curried, each argument
+ is printed as it is passed to the function.
+
+ \item["#untrace "\var{function-name}";;"]
+ Stop tracing the given function.
+
+ \item["#untrace_all;;"]
+ Stop tracing all functions traced so far.
+ \end{options}
+
+\item[Compiler options]
+ \begin{options}
+ \item["#labels "\var{bool}";;"]
+ Ignore labels in function types if argument is "false", or switch back
+ to default behaviour (commuting style) if argument is "true".
+
+ \item["#ppx \""\var{file-name}"\";;"]
+ After parsing, pipe the abstract syntax tree through the preprocessor
+ command.
+
+ \item["#principal "\var{bool}";;"]
+ If the argument is "true", check information paths during
+ type-checking, to make sure that all types are derived in a principal
+ way. If the argument is "false", do not check information paths.
+
+ \item["#rectypes;;"]
+ Allow arbitrary recursive types during type-checking. Note: once
+ enabled, this option cannot be disabled because that would lead to
+ unsoundness of the type system.
+
+ \item["#warn_error \""\var{warning-list}"\";;"]
+ Treat as errors the warnings enabled by the argument and as normal
+ warnings the warnings disabled by the argument.
+
+ \item["#warnings \""\var{warning-list}"\";;"]
+ Enable or disable warnings according to the argument.
+
+ \end{options}
+
+\end{options}
+
+\section{s:toplevel-modules}{The toplevel and the module system}
+
+Toplevel phrases can refer to identifiers defined in compilation units
+with the same mechanisms as for separately compiled units: either by
+using qualified names ("Modulename.localname"), or by using
+the "open" construct and unqualified names (see section~\ref{s:names}).
+
+However, before referencing another compilation unit, an
+implementation of that unit must be present in memory.
+At start-up, the toplevel system contains implementations for all the
+modules in the the standard library. Implementations for user modules
+can be entered with the "#load" directive described above. Referencing
+a unit for which no implementation has been provided
+results in the error "Reference to undefined global `...'".
+
+Note that entering "open "\var{Mod} merely accesses the compiled
+interface (".cmi" file) for \var{Mod}, but does not load the
+implementation of \var{Mod}, and does not cause any error if no
+implementation of \var{Mod} has been loaded. The error
+``reference to undefined global \var{Mod}'' will occur only when
+executing a value or module definition that refers to \var{Mod}.
+
+\section{s:toplevel-common-errors}{Common errors}
+
+This section describes and explains the most frequently encountered
+error messages.
+
+\begin{options}
+
+\item[Cannot find file \var{filename}]
+The named file could not be found in the current directory, nor in the
+directories of the search path.
+
+If \var{filename} has the format \var{mod}".cmi", this
+means you have referenced the compilation unit \var{mod}, but its
+compiled interface could not be found. Fix: compile \var{mod}".mli" or
+\var{mod}".ml" first, to create the compiled interface \var{mod}".cmi".
+
+If \var{filename} has the format \var{mod}".cmo", this
+means you are trying to load with "#load" a bytecode object file that
+does not exist yet. Fix: compile \var{mod}".ml" first.
+
+If your program spans several directories, this error can also appear
+because you haven't specified the directories to look into. Fix: use
+the "#directory" directive to add the correct directories to the
+search path.
+
+\item[This expression has type \nth{t}{1}, but is used with type \nth{t}{2}]
+See section~\ref{s:comp-errors}.
+
+\item[Reference to undefined global \var{mod}]
+You have neglected to load in memory an implementation for a module
+with "#load". See section~\ref{s:toplevel-modules} above.
+
+\end{options}
+
+\section{s:custom-toplevel}{Building custom toplevel systems: \texttt{ocamlmktop}}
+
+The "ocamlmktop" command builds OCaml toplevels that
+contain user code preloaded at start-up.
+
+The "ocamlmktop" command takes as argument a set of ".cmo" and ".cma"
+files, and links them with the object files that implement the OCaml toplevel.
+The typical use is:
+\begin{verbatim}
+ ocamlmktop -o mytoplevel foo.cmo bar.cmo gee.cmo
+\end{verbatim}
+This creates the bytecode file "mytoplevel", containing the OCaml toplevel
+system, plus the code from the three ".cmo"
+files. This toplevel is directly executable and is started by:
+\begin{verbatim}
+ ./mytoplevel
+\end{verbatim}
+This enters a regular toplevel loop, except that the code from
+"foo.cmo", "bar.cmo" and "gee.cmo" is already loaded in memory, just as
+if you had typed:
+\begin{verbatim}
+ #load "foo.cmo";;
+ #load "bar.cmo";;
+ #load "gee.cmo";;
+\end{verbatim}
+on entrance to the toplevel. The modules "Foo", "Bar" and "Gee" are
+not opened, though; you still have to do
+\begin{verbatim}
+ open Foo;;
+\end{verbatim}
+yourself, if this is what you wish.
+
+\subsection{ss:ocamlmktop-options}{Options}
+
+The following command-line options are recognized by "ocamlmktop".
+
+\begin{options}
+
+\item["-cclib" \var{libname}]
+Pass the "-l"\var{libname} option to the C linker when linking in
+``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-ccopt" \var{option}]
+Pass the given option to the C compiler and linker, when linking in
+``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-custom"]
+Link in ``custom runtime'' mode. See the corresponding option for
+"ocamlc", in chapter~\ref{c:camlc}.
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+compiled object code files (".cmo" and ".cma").
+
+\item["-o" \var{exec-file}]
+Specify the name of the toplevel file produced by the linker.
+The default is "a.out".
+
+\end{options}
+
+\section{s:ocamlnat}{The native toplevel: \texttt{ocamlnat}\ (experimental)}
+
+{\bf This section describes a tool that is not yet officially supported %
+but may be found useful.}
+
+OCaml code executing in the traditional toplevel system uses the bytecode
+interpreter. When increased performance is required, or for testing
+programs that will only execute correctly when compiled to native code,
+the {\em native toplevel} may be used instead.
+
+For the majority of installations the native toplevel will not have been
+installed along with the rest of the OCaml toolchain. In such circumstances
+it will be necessary to build the OCaml distribution from source.
+From the built source tree of the distribution you may use
+{\tt make natruntop} to build and execute a native toplevel. (Alternatively
+{\tt make ocamlnat} can be used, which just performs the build step.)
+
+If the {\tt make install} command is run after having built the native
+toplevel then the {\tt ocamlnat} program (either from the source or the
+installation directory) may be invoked directly rather than using
+{\tt make natruntop}.
--- /dev/null
+%
+% This file describes the native/bytecode compiler and toplevel
+% options. Since specific options can exist in only a subset of
+% \{toplevel, bytecode compiler, native compiler \} and their description
+% might differ across this subset, this file uses macros to adapt the
+% description tool by tool:
+\long\def\comp#1{\ifcomp#1\else\fi}
+% \long is needed for multiparagraph macros
+\long\def\nat#1{\ifnat#1\else\fi}
+\long\def\top#1{\iftop#1\else\fi}
+\long\def\notop#1{\iftop\else#1\fi}
+% ( Note that the previous definitions relies on the three boolean values
+% \top, \nat and \comp. The manual section must therefore
+% set these boolean values accordingly.
+% )
+% The macros (\comp, \nat, \top) adds a supplementary text
+% if we are respectively in the (bytecode compiler, native compiler, toplevel)
+% section.
+% The toplevel options are quite different from the compilers' options.
+% It is therefore useful to have also a substractive \notop macro
+% that prints its content only outside of the topvel section
+%
+% For instance, to add an option "-foo" that applies to the native and
+% bytecode compiler, one can write
+% \notop{\item["-foo"]
+% ...
+% }
+%
+% Similarly, an option "-bar" only available in the native compiler
+% can be introduced with
+% \nat{\item["-bar"]
+% ...
+% }
+% These macros can be also used to add information that are only relevant to
+% some tools or differ slightly from one tool to another. For instance, we
+% define the following macro for the pairs cma/cmxa cmo/cmxo and ocamlc/ocamlopt
+%
+\def\cma{\comp{.cma}\nat{.cmxa}}
+\def\cmo{\comp{.cmo}\nat{.cmx}}
+\def\qcmo{{\machine\cmo}}
+\def\qcma{{\machine\cma}}
+\def\ocamlx{\comp{ocamlc}\nat{ocamlopt}}
+%
+%
+\begin{options}
+\notop{%
+\item["-a"]
+Build a library(\nat{".cmxa" and ".a"/".lib" files}\comp{".cma" file})
+with the object files (\nat{".cmx" and ".o"/".obj" files}\comp{ ".cmo" files})
+given on the command line, instead of linking them into an executable file.
+The name of the library must be set with the "-o" option.
+
+If \comp{"-custom", }"-cclib" or "-ccopt" options are passed on the command
+line, these options are stored in the resulting \qcma library. Then,
+linking with this library automatically adds back the \comp{"-custom", }
+"-cclib" and "-ccopt" options as if they had been provided on the
+command line, unless the "-noautolink" option is given.
+}%notop
+
+\item["-absname"]
+Force error messages to show absolute paths for file names.
+
+\notop{\item["-annot"]
+Deprecated since OCaml 4.11. Please use "-bin-annot" instead.
+}%notop
+
+\item["-args" \var{filename}]
+Read additional newline-terminated command line arguments from \var{filename}.
+\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
+}%top
+\item["-args0" \var{filename}]
+ Read additional null character terminated command line arguments from
+ \var{filename}.
+\top{It is not possible to pass a \var{scriptfile} via file to the toplevel.
+}%top
+
+
+\notop{\item["-bin-annot"]
+Dump detailed information about the compilation (types, bindings,
+tail-calls, etc) in binary format. The information for file \var{src}".ml"
+(resp. \var{src}".mli") is put into file \var{src}".cmt"
+(resp. \var{src}".cmti"). In case of a type error, dump
+all the information inferred by the type-checker before the error.
+The "*.cmt" and "*.cmti" files produced by "-bin-annot" contain
+more information and are much more compact than the files produced by
+"-annot".
+}%notop
+
+\notop{\item["-c"]
+Compile only. Suppress the linking phase of the
+compilation. Source code files are turned into compiled files, but no
+executable file is produced. This option is useful to
+compile modules separately.
+}%notop
+
+\notop{%
+\item["-cc" \var{ccomp}]
+Use \var{ccomp} as the C linker \nat{called to build the final executable }
+\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}
+and as the C compiler for compiling ".c" source files.
+}%notop
+
+\notop{%
+\item["-cclib" "-l"\var{libname}]
+Pass the "-l"\var{libname} option to the \comp{C} linker
+\comp{when linking in ``custom runtime'' mode (see the "-custom" option)}.
+This causes the given C library to be linked with the program.
+}%notop
+
+\notop{%
+\item["-ccopt" \var{option}]
+Pass the given option to the C compiler and linker.
+\comp{When linking in ``custom runtime'' mode, for instance}%
+\nat{For instance,}%
+"-ccopt -L"\var{dir} causes the C linker to search for C libraries in
+directory \var{dir}.\comp{(See the "-custom" option.)}
+}%notop
+
+\notop{%
+\item["-color" \var{mode}]
+Enable or disable colors in compiler messages (especially warnings and errors).
+The following modes are supported:
+\begin{description}
+ \item["auto"] use heuristics to enable colors only if the output supports them
+ (an ANSI-compatible tty terminal);
+ \item["always"] enable colors unconditionally;
+ \item["never"] disable color output.
+\end{description}
+The default setting is 'auto', and the current heuristic
+checks that the "TERM" environment variable exists and is
+not empty or "dumb", and that 'isatty(stderr)' holds.
+
+The environment variable "OCAML_COLOR" is considered if "-color" is not
+provided. Its values are auto/always/never as above.
+}%notop
+
+\notop{%
+\item["-error-style" \var{mode}]
+Control the way error messages and warnings are printed.
+The following modes are supported:
+\begin{description}
+ \item["short"] only print the error and its location;
+ \item["contextual"] like "short", but also display the source code snippet
+ corresponding to the location of the error.
+ \end{description}
+The default setting is "contextual".
+
+The environment variable "OCAML_ERROR_STYLE" is considered if "-error-style" is
+not provided. Its values are short/contextual as above.
+}%notop
+
+\comp{%
+\item["-compat-32"]
+Check that the generated bytecode executable can run on 32-bit
+platforms and signal an error if it cannot. This is useful when
+compiling bytecode on a 64-bit machine.
+}%comp
+
+\nat{%
+\item["-compact"]
+Optimize the produced code for space rather than for time. This
+results in slightly smaller but slightly slower programs. The default is to
+optimize for speed.
+}%nat
+
+\notop{%
+\item["-config"]
+Print the version number of {\machine\ocamlx} and a detailed
+summary of its configuration, then exit.
+}%notop
+
+\notop{%
+\item["-config-var" \var{var}]
+Print the value of a specific configuration variable from the
+"-config" output, then exit. If the variable does not exist, the exit
+code is non-zero. This option is only available since OCaml 4.08,
+so script authors should have a fallback for older versions.
+}%notop
+
+\comp{%
+\item["-custom"]
+Link in ``custom runtime'' mode. In the default linking mode, the
+linker produces bytecode that is intended to be executed with the
+shared runtime system, "ocamlrun". In the custom runtime mode, the
+linker produces an output file that contains both the runtime system
+and the bytecode for the program. The resulting file is larger, but it
+can be executed directly, even if the "ocamlrun" command is not
+installed. Moreover, the ``custom runtime'' mode enables static
+linking of OCaml code with user-defined C functions, as described in
+chapter~\ref{c:intf-c}.
+\begin{unix}
+Never use the "strip" command on executables produced by "ocamlc -custom",
+this would remove the bytecode part of the executable.
+\end{unix}
+\begin{unix}
+Security warning: never set the ``setuid'' or ``setgid'' bits on executables
+produced by "ocamlc -custom", this would make them vulnerable to attacks.
+\end{unix}
+}%comp
+
+\notop{%
+\item["-depend" \var{ocamldep-args}]
+Compute dependencies, as the "ocamldep" command would do. The remaining
+arguments are interpreted as if they were given to the "ocamldep" command.
+}%notop
+
+\comp{
+\item["-dllib" "-l"\var{libname}]
+Arrange for the C shared library "dll"\var{libname}".so"
+("dll"\var{libname}".dll" under Windows) to be loaded dynamically
+by the run-time system "ocamlrun" at program start-up time.
+}%comp
+
+\comp{\item["-dllpath" \var{dir}]
+Adds the directory \var{dir} to the run-time search path for shared
+C libraries. At link-time, shared libraries are searched in the
+standard search path (the one corresponding to the "-I" option).
+The "-dllpath" option simply stores \var{dir} in the produced
+executable file, where "ocamlrun" can find it and use it as
+described in section~\ref{s:ocamlrun-dllpath}.
+}%comp
+
+\notop{%
+\item["-for-pack" \var{module-path}]
+Generate an object file (\qcmo\nat{ and ".o"/".obj" files})
+that can later be included
+as a sub-module (with the given access path) of a compilation unit
+constructed with "-pack". For instance,
+{\machine\ocamlx\ -for-pack\ P\ -c\ A.ml}
+will generate {\machine a.\cmo}\nat{ and "a.o" files} that can
+later be used with {\machine \ocamlx\ -pack\ -o\ P\cmo\ a\cmo}.
+Note: you can still pack a module that was compiled without
+"-for-pack" but in this case exceptions will be printed with the wrong
+names.
+}%notop
+
+\notop{%
+\item["-g"]
+Add debugging information while compiling and linking. This option is
+required in order to \comp{be able to debug the program with "ocamldebug"
+(see chapter~\ref{c:debugger}), and to} produce stack backtraces when
+the program terminates on an uncaught exception (see
+section~\ref{s:ocamlrun-options}).
+}%notop
+
+\notop{%
+\item["-i"]
+Cause the compiler to print all defined names (with their inferred
+types or their definitions) when compiling an implementation (".ml"
+file). No compiled files (".cmo" and ".cmi" files) are produced.
+This can be useful to check the types inferred by the
+compiler. Also, since the output follows the syntax of interfaces, it
+can help in writing an explicit interface (".mli" file) for a file:
+just redirect the standard output of the compiler to a ".mli" file,
+and edit that file to remove all declarations of unexported names.
+}%notop
+
+\item["-I" \var{directory}]
+Add the given directory to the list of directories searched for
+\nat{compiled interface files (".cmi"), compiled object code files (".cmx"),
+and libraries (".cmxa").}
+\comp{compiled interface files (".cmi"), compiled object code files ".cmo",
+libraries (".cma") and C libraries specified with "-cclib -lxxx".}
+\top{source and compiled files.}
+By default, the current directory is searched first, then the standard
+library directory. Directories added with "-I" are searched after the
+current directory, in the order in which they were given on the command line,
+but before the standard library directory. See also option "-nostdlib".
+
+If the given directory starts with "+", it is taken relative to the
+standard library directory. For instance, "-I +unix" adds the
+subdirectory "unix" of the standard library to the search path.
+
+\top{%
+Directories can also be added to the list once
+the toplevel is running with the "#directory" directive
+(section~\ref{s:toplevel-directives}).
+}%top
+
+\top{%
+\item["-init" \var{file}]
+Load the given file instead of the default initialization file.
+The default file is ".ocamlinit" in the current directory if it
+exists, otherwise "XDG_CONFIG_HOME/ocaml/init.ml" or
+".ocamlinit" in the user's home directory.
+}%top
+
+\notop{%
+\item["-impl" \var{filename}]
+Compile the file \var{filename} as an implementation file, even if its
+extension is not ".ml".
+}%notop
+
+\nat{%
+\item["-inline" \var{n}]
+Set aggressiveness of inlining to \var{n}, where \var{n} is a positive
+integer. Specifying "-inline 0" prevents all functions from being
+inlined, except those whose body is smaller than the call site. Thus,
+inlining causes no expansion in code size. The default aggressiveness,
+"-inline 1", allows slightly larger functions to be inlined, resulting
+in a slight expansion in code size. Higher values for the "-inline"
+option cause larger and larger functions to become candidate for
+inlining, but can result in a serious increase in code size.
+}%nat
+
+\notop{%
+\item["-intf" \var{filename}]
+Compile the file \var{filename} as an interface file, even if its
+extension is not ".mli".
+}%notop
+
+\notop{%
+\item["-intf-suffix" \var{string}]
+Recognize file names ending with \var{string} as interface files
+(instead of the default ".mli").
+}%\notop
+
+\item["-labels"]
+Labels are not ignored in types, labels may be used in applications,
+and labelled parameters can be given in any order. This is the default.
+
+\notop{%
+\item["-linkall"]
+Force all modules contained in libraries to be linked in. If this
+flag is not given, unreferenced modules are not linked in. When
+building a library (option "-a"), setting the "-linkall" option forces all
+subsequent links of programs involving that library to link all the
+modules contained in the library. When compiling a module (option
+"-c"), setting the "-linkall" option ensures that this module will
+always be linked if it is put in a library and this library is linked.
+}%notop
+
+\nat{%
+\item["-linscan"]
+Use linear scan register allocation. Compiling with this allocator is faster
+than with the usual graph coloring allocator, sometimes quite drastically so for
+long functions and modules. On the other hand, the generated code can be a bit
+slower.
+}%nat
+
+\comp{%
+\item["-make-runtime"]
+Build a custom runtime system (in the file specified by option "-o")
+incorporating the C object files and libraries given on the command
+line. This custom runtime system can be used later to execute
+bytecode executables produced with the
+"ocamlc -use-runtime" \var{runtime-name} option.
+See section~\ref{ss:custom-runtime} for more information.
+}%comp
+
+\notop{%
+\item["-match-context-rows"]
+Set the number of rows of context used for optimization during
+pattern matching compilation. The default value is 32. Lower values
+cause faster compilation, but less optimized code. This advanced
+option is meant for use in the event that a pattern-match-heavy
+program leads to significant increases in compilation time.
+}%notop
+
+\notop{%
+\item["-no-alias-deps"]
+Do not record dependencies for module aliases. See
+section~\ref{s:module-alias} for more information.
+}%notop
+
+\item["-no-app-funct"]
+Deactivates the applicative behaviour of functors. With this option,
+each functor application generates new types in its result and
+applying the same functor twice to the same argument yields two
+incompatible structures.
+
+\nat{%
+\item["-no-float-const-prop"]
+Deactivates the constant propagation for floating-point operations.
+This option should be given if the program changes the float rounding
+mode during its execution.
+}%nat
+
+\item["-noassert"]
+Do not compile assertion checks. Note that the special form
+"assert false" is always compiled because it is typed specially.
+\notop{This flag has no effect when linking already-compiled files.}
+
+\notop{%
+\item["-noautolink"]
+When linking \qcma libraries, ignore \comp{"-custom",} "-cclib" and "-ccopt"
+options potentially contained in the libraries (if these options were
+given when building the libraries). This can be useful if a library
+contains incorrect specifications of C libraries or C options; in this
+case, during linking, set "-noautolink" and pass the correct C
+libraries and options on the command line.
+}%
+
+\nat{%
+\item["-nodynlink"]
+Allow the compiler to use some optimizations that are valid only for
+code that is statically linked to produce a non-relocatable
+executable. The generated code cannot be linked to produce a shared
+library nor a position-independent executable (PIE). Many operating
+systems produce PIEs by default, causing errors when linking code
+compiled with "-nodynlink". Either do not use "-nodynlink" or pass
+the option "-ccopt -no-pie" at link-time.
+}%nat
+
+\item["-nolabels"]
+Ignore non-optional labels in types. Labels cannot be used in
+applications, and parameter order becomes strict.
+
+\top{%
+\item["-noprompt"]
+Do not display any prompt when waiting for input.
+}%top
+
+\top{%
+\item["-nopromptcont"]
+Do not display the secondary prompt when waiting for continuation
+lines in multi-line inputs. This should be used e.g. when running
+"ocaml" in an "emacs" window.
+}%top
+
+\item["-nostdlib"]
+\top{%
+Do not include the standard library directory in the list of
+directories searched for source and compiled files.
+}%top
+\comp{%
+Do not include the standard library directory in the list of
+directories searched for
+compiled interface files (".cmi"), compiled object code files
+(".cmo"), libraries (".cma"), and C libraries specified with
+"-cclib -lxxx". See also option "-I".
+}%comp
+\nat{%
+Do not automatically add the standard library directory to the list of
+directories searched for compiled interface files (".cmi"), compiled
+object code files (".cmx"), and libraries (".cmxa"). See also option
+"-I".
+}%nat
+
+\notop{%
+\item["-o" \var{exec-file}]
+Specify the name of the output file produced by the
+\nat{linker}\comp{compiler}. The
+default output name is "a.out" under Unix and "camlprog.exe" under
+Windows. If the "-a" option is given, specify the name of the library
+produced. If the "-pack" option is given, specify the name of the
+packed object file produced. If the "-output-obj" or "-output-complete-obj"
+options are given, specify the name of the output file produced.
+\nat{If the "-shared" option is given, specify the name of plugin
+file produced.}
+\comp{If the "-c" option is given, specify the name of the object
+file produced for the {\em next} source file that appears on the
+command line.}
+}%notop
+
+\notop{%
+\item["-opaque"]
+When the native compiler compiles an implementation, by default it
+produces a ".cmx" file containing information for cross-module
+optimization. It also expects ".cmx" files to be present for the
+dependencies of the currently compiled source, and uses them for
+optimization. Since OCaml 4.03, the compiler will emit a warning if it
+is unable to locate the ".cmx" file of one of those dependencies.
+
+The "-opaque" option, available since 4.04, disables cross-module
+optimization information for the currently compiled unit. When
+compiling ".mli" interface, using "-opaque" marks the compiled ".cmi"
+interface so that subsequent compilations of modules that depend on it
+will not rely on the corresponding ".cmx" file, nor warn if it is
+absent. When the native compiler compiles a ".ml" implementation,
+using "-opaque" generates a ".cmx" that does not contain any
+cross-module optimization information.
+
+Using this option may degrade the quality of generated code, but it
+reduces compilation time, both on clean and incremental
+builds. Indeed, with the native compiler, when the implementation of
+a compilation unit changes, all the units that depend on it may need
+to be recompiled -- because the cross-module information may have
+changed. If the compilation unit whose implementation changed was
+compiled with "-opaque", no such recompilation needs to occur. This
+option can thus be used, for example, to get faster edit-compile-test
+feedback loops.
+}%notop
+
+\notop{%
+\item["-open" \var{Module}]
+Opens the given module before processing the interface or
+implementation files. If several "-open" options are given,
+they are processed in order, just as if
+the statements "open!" \var{Module1}";;" "..." "open!" \var{ModuleN}";;"
+were added at the top of each file.
+}%notop
+
+\notop{%
+\item["-output-obj"]
+Cause the linker to produce a C object file instead of
+\comp{a bytecode executable file}\nat{an executable file}.
+This is useful to wrap OCaml code as a C library,
+callable from any C program. See chapter~\ref{c:intf-c},
+section~\ref{ss:c-embedded-code}. The name of the output object file
+must be set with the "-o" option.
+This option can also be used to produce a \comp{C source file (".c" extension)
+or a} compiled shared/dynamic library (".so" extension, ".dll" under Windows).
+}%notop
+
+\comp{%
+\item["-output-complete-exe"]
+Build a self-contained executable by linking a C object file containing the
+bytecode program, the OCaml runtime system and any other static C code given to
+"ocamlc". The resulting effect is similar to "-custom", except that the bytecode
+is embedded in the C code so it is no longer accessible to tools such as
+"ocamldebug". On the other hand, the resulting binary is resistant to "strip".
+}%comp
+
+\notop{%
+\item["-output-complete-obj"]
+Same as "-output-obj" options except the object file produced includes the
+runtime and autolink libraries.
+}%notop
+
+\nat{%
+\item["-pack"]
+Build an object file (".cmx" and ".o"/".obj" files) and its associated compiled
+interface (".cmi") that combines the ".cmx" object
+files given on the command line, making them appear as sub-modules of
+the output ".cmx" file. The name of the output ".cmx" file must be
+given with the "-o" option. For instance,
+\begin{verbatim}
+ ocamlopt -pack -o P.cmx A.cmx B.cmx C.cmx
+\end{verbatim}
+generates compiled files "P.cmx", "P.o" and "P.cmi" describing a
+compilation unit having three sub-modules "A", "B" and "C",
+corresponding to the contents of the object files "A.cmx", "B.cmx" and
+"C.cmx". These contents can be referenced as "P.A", "P.B" and "P.C"
+in the remainder of the program.
+
+The ".cmx" object files being combined must have been compiled with
+the appropriate "-for-pack" option. In the example above,
+"A.cmx", "B.cmx" and "C.cmx" must have been compiled with
+"ocamlopt -for-pack P".
+
+Multiple levels of packing can be achieved by combining "-pack" with
+"-for-pack". Consider the following example:
+\begin{verbatim}
+ ocamlopt -for-pack P.Q -c A.ml
+ ocamlopt -pack -o Q.cmx -for-pack P A.cmx
+ ocamlopt -for-pack P -c B.ml
+ ocamlopt -pack -o P.cmx Q.cmx B.cmx
+\end{verbatim}
+The resulting "P.cmx" object file has sub-modules "P.Q", "P.Q.A"
+and "P.B".
+}%nat
+
+\comp{%
+\item["-pack"]
+Build a bytecode object file (".cmo" file) and its associated compiled
+interface (".cmi") that combines the object
+files given on the command line, making them appear as sub-modules of
+the output ".cmo" file. The name of the output ".cmo" file must be
+given with the "-o" option. For instance,
+\begin{verbatim}
+ ocamlc -pack -o p.cmo a.cmo b.cmo c.cmo
+\end{verbatim}
+generates compiled files "p.cmo" and "p.cmi" describing a compilation
+unit having three sub-modules "A", "B" and "C", corresponding to the
+contents of the object files "a.cmo", "b.cmo" and "c.cmo". These
+contents can be referenced as "P.A", "P.B" and "P.C" in the remainder
+of the program.
+}%comp
+
+\notop{%
+\item["-pp" \var{command}]
+Cause the compiler to call the given \var{command} as a preprocessor
+for each source file. The output of \var{command} is redirected to
+an intermediate file, which is compiled. If there are no compilation
+errors, the intermediate file is deleted afterwards.
+}%notop
+
+\item["-ppx" \var{command}]
+After parsing, pipe the abstract syntax tree through the preprocessor
+\var{command}. The module "Ast_mapper", described in
+\ifouthtml
+chapter~\ref{c:parsinglib}:
+\ahref{compilerlibref/Ast\_mapper.html}{ \texttt{Ast_mapper} }
+\else section~\ref{Ast-underscoremapper}\fi,
+implements the external interface of a preprocessor.
+
+\item["-principal"]
+Check information path during type-checking, to make sure that all
+types are derived in a principal way. When using labelled arguments
+and/or polymorphic methods, this flag is required to ensure future
+versions of the compiler will be able to infer types correctly, even
+if internal algorithms change.
+All programs accepted in "-principal" mode are also accepted in the
+default mode with equivalent types, but different binary signatures,
+and this may slow down type checking; yet it is a good idea to
+use it once before publishing source code.
+
+\item["-rectypes"]
+Allow arbitrary recursive types during type-checking. By default,
+only recursive types where the recursion goes through an object type
+are supported. \notop{Note that once you have created an interface using this
+flag, you must use it again for all dependencies.}
+
+\notop{%
+\item["-runtime-variant" \var{suffix}]
+Add the \var{suffix} string to the name of the runtime library used by
+the program. Currently, only one such suffix is supported: "d", and
+only if the OCaml compiler was configured with option
+"-with-debug-runtime". This suffix gives the debug version of the
+runtime, which is useful for debugging pointer problems in low-level
+code such as C stubs.
+}%notop
+
+\notop{
+\item["-stop-after" \var{pass}]
+Stop compilation after the given compilation pass. The currently
+supported passes are:
+"parsing", "typing"\nat{, "scheduling", "emit"}.
+}%notop
+
+\nat{
+\item["-save-ir-after" \var{pass}]
+Save intermediate representation after the given compilation pass
+to a file.
+The currently supported passes and the corresponding file extensions are:
+"scheduling" (".cmir-linear").
+
+This experimental feature enables external tools to inspect and manipulate
+compiler's intermediate representation of the program
+using "compiler-libs" library (see
+\ifouthtml chapter~\ref{c:parsinglib} and
+\ahref{compilerlibref/Compiler\_libs.html}{ \texttt{Compiler_libs} }
+\else section~\ref{Compiler-underscorelibs}\fi
+).
+}%nat
+
+\nat{%
+\item["-S"]
+Keep the assembly code produced during the compilation. The assembly
+code for the source file \var{x}".ml" is saved in the file \var{x}".s".
+}%nat
+
+\nat{%
+\item["-shared"]
+Build a plugin (usually ".cmxs") that can be dynamically loaded with
+the "Dynlink" module. The name of the plugin must be
+set with the "-o" option. A plugin can include a number of OCaml
+modules and libraries, and extra native objects (".o", ".obj", ".a",
+".lib" files). Building native plugins is only supported for some
+operating system. Under some systems (currently,
+only Linux AMD 64), all the OCaml code linked in a plugin must have
+been compiled without the "-nodynlink" flag. Some constraints might also
+apply to the way the extra native objects have been compiled (under
+Linux AMD 64, they must contain only position-independent code).
+}%nat
+
+\item["-safe-string"]
+Enforce the separation between types "string" and "bytes",
+thereby making strings read-only. This is the default.
+
+\item["-short-paths"]
+When a type is visible under several module-paths, use the shortest
+one when printing the type's name in inferred interfaces and error and
+warning messages. Identifier names starting with an underscore "_" or
+containing double underscores "__" incur a penalty of $+10$ when computing
+their length.
+
+\top{
+\item["-stdin"]
+Read the standard input as a script file rather than starting an
+interactive session.
+}%top
+
+\item["-strict-sequence"]
+Force the left-hand part of each sequence to have type unit.
+
+\item["-strict-formats"]
+Reject invalid formats that were accepted in legacy format
+implementations. You should use this flag to detect and fix such
+invalid formats, as they will be rejected by future OCaml versions.
+
+\notop{%
+\item["-unboxed-types"]
+When a type is unboxable (i.e. a record with a single argument or a
+concrete datatype with a single constructor of one argument) it will
+be unboxed unless annotated with "[\@\@ocaml.boxed]".
+}%notop
+
+\notop{%
+\item["-no-unboxed-types"]
+When a type is unboxable it will be boxed unless annotated with
+"[\@\@ocaml.unboxed]". This is the default.
+}%notop
+
+\item["-unsafe"]
+Turn bound checking off for array and string accesses (the "v.(i)" and
+"s.[i]" constructs). Programs compiled with "-unsafe" are therefore
+\comp{slightly} faster, but unsafe: anything can happen if the program
+accesses an array or string outside of its bounds.
+\notop{%
+Additionally, turn off the check for zero divisor in integer division
+ and modulus operations. With "-unsafe", an integer division
+(or modulus) by zero can halt the program or continue with an
+unspecified result instead of raising a "Division_by_zero" exception.
+}%notop
+
+\item["-unsafe-string"]
+Identify the types "string" and "bytes", thereby making strings writable.
+This is intended for compatibility with old source code and should not
+be used with new software.
+
+\comp{%
+\item["-use-runtime" \var{runtime-name}]
+Generate a bytecode executable file that can be executed on the custom
+runtime system \var{runtime-name}, built earlier with
+"ocamlc -make-runtime" \var{runtime-name}.
+See section~\ref{ss:custom-runtime} for more information.
+}%comp
+
+\item["-v"]
+Print the version number of the compiler and the location of the
+standard library directory, then exit.
+
+\item["-verbose"]
+Print all external commands before they are executed,
+\nat{in particular invocations of the assembler, C compiler, and linker.}
+\comp{in particular invocations of the C compiler and linker in "-custom" mode.}
+Useful to debug C library problems.
+
+\notop{%
+\item["-version" or "-vnum"]
+Print the version number of the compiler in short form (e.g. "3.11.0"),
+then exit.
+}%notop
+
+\top{%
+\item["-version"]
+Print version string and exit.
+
+\item["-vnum"]
+Print short version number and exit.
+
+\item["-no-version"]
+Do not print the version banner at startup.
+}%top
+
+\item["-w" \var{warning-list}]
+Enable, disable, or mark as fatal the warnings specified by the argument
+\var{warning-list}.
+Each warning can be {\em enabled} or {\em disabled}, and each warning
+can be {\em fatal} or {\em non-fatal}.
+If a warning is disabled, it isn't displayed and doesn't affect
+compilation in any way (even if it is fatal). If a warning is
+enabled, it is displayed normally by the compiler whenever the source
+code triggers it. If it is enabled and fatal, the compiler will also
+stop with an error after displaying it.
+
+The \var{warning-list} argument is a sequence of warning specifiers,
+with no separators between them. A warning specifier is one of the
+following:
+
+\begin{options}
+\item["+"\var{num}] Enable warning number \var{num}.
+\item["-"\var{num}] Disable warning number \var{num}.
+\item["\@"\var{num}] Enable and mark as fatal warning number \var{num}.
+\item["+"\var{num1}..\var{num2}] Enable warnings in the given range.
+\item["-"\var{num1}..\var{num2}] Disable warnings in the given range.
+\item["\@"\var{num1}..\var{num2}] Enable and mark as fatal warnings in
+the given range.
+\item["+"\var{letter}] Enable the set of warnings corresponding to
+\var{letter}. The letter may be uppercase or lowercase.
+\item["-"\var{letter}] Disable the set of warnings corresponding to
+\var{letter}. The letter may be uppercase or lowercase.
+\item["\@"\var{letter}] Enable and mark as fatal the set of warnings
+corresponding to \var{letter}. The letter may be uppercase or
+lowercase.
+\item[\var{uppercase-letter}] Enable the set of warnings corresponding
+to \var{uppercase-letter}.
+\item[\var{lowercase-letter}] Disable the set of warnings corresponding
+to \var{lowercase-letter}.
+\end{options}
+
+Alternatively, \var{warning-list} can specify a single warning using its
+mnemonic name (see below), as follows:
+
+\begin{options}
+\item["+"\var{name}] Enable warning \var{name}.
+\item["-"\var{name}] Disable warning \var{name}.
+\item["\@"\var{name}] Enable and mark as fatal warning \var{name}.
+\end{options}
+
+Warning numbers, letters and names which are not currently defined are
+ignored. The warnings are as follows (the name following each number specifies
+the mnemonic for that warning).
+\begin{options}
+\input{warnings-help.tex}
+\end{options}
+
+The default setting is "-w +a-4-6-7-9-27-29-32..42-44-45-48-50-60".
+It is displayed by {\machine\ocamlx\ -help}.
+Note that warnings 5 and 10 are not always triggered, depending on
+the internals of the type checker.
+
+
+\item["-warn-error" \var{warning-list}]
+Mark as fatal the warnings specified in the argument \var{warning-list}.
+The compiler will stop with an error when one of these warnings is
+emitted. The \var{warning-list} has the same meaning as for
+the "-w" option: a "+" sign (or an uppercase letter) marks the
+corresponding warnings as fatal, a "-"
+sign (or a lowercase letter) turns them back into non-fatal warnings,
+and a "\@" sign both enables and marks as fatal the corresponding
+warnings.
+
+Note: it is not recommended to use warning sets (i.e. letters) as
+arguments to "-warn-error"
+in production code, because this can break your build when future versions
+of OCaml add some new warnings.
+
+The default setting is "-warn-error -a+31" (only warning 31 is fatal).
+
+\item["-warn-help"]
+Show the description of all available warning numbers.
+
+\notop{%
+\item["-where"]
+Print the location of the standard library, then exit.
+}%notop
+
+\notop{%
+\item["-with-runtime"]
+Include the runtime system in the generated program. This is the default.
+}
+
+\notop{%
+\item["-without-runtime"]
+The compiler does not include the runtime system (nor a reference to it) in the
+generated program; it must be supplied separately.
+}
+
+\item["-" \var{file}]
+\notop{Process \var{file} as a file name, even if it starts with a dash ("-")
+character.}
+\top{Use \var{file} as a script file name, even when it starts with a
+hyphen (-).}
+
+\item["-help" or "--help"]
+Display a short usage summary and exit.
+
+\end{options}
+%
--- /dev/null
+\chapter*{Foreword}
+\markboth{Foreword}{}
+%HEVEA\cutname{foreword.html}
+
+This manual documents the release \ocamlversion\ of the OCaml
+system. It is organized as follows.
+\begin{itemize}
+\item Part~\ref{p:tutorials}, ``An introduction to OCaml'',
+gives an overview of the language.
+\item Part~\ref{p:refman}, ``The OCaml language'', is the
+reference description of the language.
+\item Part~\ref{p:commands}, ``The OCaml tools'', documents
+the compilers, toplevel system, and programming utilities.
+\item Part~\ref{p:library}, ``The OCaml library'', describes the
+modules provided in the standard library.
+\begin{latexonly}
+\item Part~\ref{p:indexes}, ``Indexes'', contains an
+index of all identifiers defined in the standard library, and an
+index of keywords.
+\end{latexonly}
+\end{itemize}
+
+\section*{conventions}{Conventions}
+
+OCaml runs on several operating systems. The parts of
+this manual that are specific to one operating system are presented as
+shown below:
+
+\begin{unix} This is material specific to the Unix family of operating
+systems, including Linux and macOS.
+\end{unix}
+
+\begin{windows} This is material specific to Microsoft Windows
+ (Vista, 7, 8, 10).
+\end{windows}
+
+\section*{license}{License}
+
+The OCaml system is copyright \copyright\ 1996--\number\year\
+Institut National de Recherche en Informatique et en
+Automatique (INRIA).
+INRIA holds all ownership rights to the OCaml system.
+
+The OCaml system is open source and can be freely
+redistributed. See the file "LICENSE" in the distribution for
+licensing information.
+
+The OCaml documentation and user's manual is
+copyright \copyright\ \number\year\
+Institut National de Recherche en Informatique et en
+Automatique (INRIA).
+
+\begin{latexonly}
+The OCaml documentation and user's manual is licensed under a Creative
+Commons Attribution-ShareAlike 4.0 International License (CC BY-SA
+4.0), \url{https://creativecommons.org/licenses/by-sa/4.0/}.
+\end{latexonly}
+
+\begin{htmlonly}
+\begin{rawhtml}
+<a id="cc_license_logo" rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/"><img alt="Creative Commons License" style="border-width:0" src="https://i.creativecommons.org/l/by-sa/4.0/88x31.png"></a>
+The OCaml documentation and user's manual is licensed under a
+<a rel="license" href="http://creativecommons.org/licenses/by-sa/4.0/">Creative Commons Attribution-ShareAlike 4.0 International License</a>.
+\end{rawhtml}
+\end{htmlonly}
+
+\section*{availability}{Availability}
+
+\begin{latexonly}
+The complete OCaml distribution can be accessed via the website
+\url{https://ocaml.org/}. This site contains a lot of additional
+information on OCaml.
+\end{latexonly}
+
+\begin{htmlonly}
+The complete OCaml distribution can be accessed via the
+\href{https://ocaml.org/}{ocaml.org website}.
+This site contains a lot of additional information on OCaml.
+\end{htmlonly}
--- /dev/null
+dune
+markup.ml
+uchar
+uutf
+lambdasoup
+ocaml-re
+.sass-cache
--- /dev/null
+DUNE_CMD := $(if $(wildcard dune/dune.exe),dune/dune.exe,dune)
+DUNE ?= $(DUNE_CMD)
+
+DEBUG ?= 0
+ifeq ($(DEBUG), 1)
+ DBG=
+else
+ DBG=quiet
+endif
+
+WEBDIR = ../webman
+WEBDIRMAN = $(WEBDIR)/manual
+WEBDIRAPI = $(WEBDIR)/api
+WEBDIRCOMP = $(WEBDIRAPI)/compilerlibref
+
+# The "all" target generates the Web Manual in the directories
+# ../webman/manual, ../webman/api, and ../webman/api/compilerlibref
+all: css js img
+ $(DUNE) exec --root=. src/process_manual.exe $(DBG)
+ $(DUNE) exec --root=. src/process_api.exe overwrite $(DBG)
+ $(DUNE) exec --root=. src/process_api.exe compiler overwrite $(DBG)
+
+$(WEBDIR)/%:
+ mkdir -p $@
+
+$(WEBDIRMAN)/manual.css: scss/_common.scss scss/manual.scss | $(WEBDIRMAN)
+ sass scss/manual.scss > $(WEBDIRMAN)/manual.css
+
+$(WEBDIRAPI)/style.css: scss/_common.scss scss/style.scss | $(WEBDIRAPI) $(WEBDIRCOMP)
+ sass scss/style.scss > $(WEBDIRAPI)/style.css
+ cp $(WEBDIRAPI)/style.css $(WEBDIRCOMP)/style.css
+
+css: $(WEBDIRMAN)/manual.css $(WEBDIRAPI)/style.css
+
+# Just copy the JS files:
+#
+JS_FILES0 := scroll.js navigation.js
+JS_FILES1 := $(JS_FILES0) search.js
+JS_FILES := $(addprefix $(WEBDIRAPI)/, $(JS_FILES1)) $(addprefix $(WEBDIRCOMP)/, $(JS_FILES1)) $(addprefix $(WEBDIRMAN)/, $(JS_FILES0))
+
+# There must be a more clever way
+$(WEBDIRAPI)/%.js: js/%.js | $(WEBDIRAPI)
+ cp $< $@
+
+$(WEBDIRMAN)/%.js: js/%.js | $(WEBDIRMAN)
+ cp $< $@
+
+$(WEBDIRCOMP)/%.js: js/%.js | $(WEBDIRCOMP)
+ cp $< $@
+
+js: $(JS_FILES)
+
+CURL = curl -s
+# download images for local use
+SEARCH := search_icon.svg
+$(WEBDIRAPI)/search_icon.svg: | $(WEBDIRAPI)
+ $(CURL) "https://ocaml.org/img/search.svg" > $(WEBDIRAPI)/$(SEARCH)
+
+$(WEBDIRCOMP)/%: $(WEBDIRAPI)/% | $(WEBDIRCOMP)
+ cp $< $@
+
+$(WEBDIRMAN)/%: $(WEBDIRAPI)/% | $(WEBDIRMAN)
+ cp $< $@
+
+LOGO := colour-logo.svg
+$(WEBDIRAPI)/colour-logo.svg: | $(WEBDIRAPI) $(WEBDIRMAN) $(WEBDIRCOMP)
+ $(CURL) "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/SVG/colour-logo.svg" > $(WEBDIRAPI)/$(LOGO)
+
+ICON := favicon.ico
+$(WEBDIRAPI)/favicon.ico: | $(WEBDIRAPI) $(WEBDIRMAN) $(WEBDIRCOMP)
+ $(CURL) "https://raw.githubusercontent.com/ocaml/ocaml-logo/master/Colour/Favicon/32x32.ico" > $(WEBDIRAPI)/$(ICON)
+
+IMG_FILES0 := colour-logo.svg
+IMG_FILES := $(addprefix $(WEBDIRAPI)/, $(IMG_FILES0)) $(addprefix $(WEBDIRCOMP)/, $(IMG_FILES0)) $(addprefix $(WEBDIRMAN)/, $(IMG_FILES0))
+
+img: $(WEBDIRAPI)/search_icon.svg $(WEBDIRAPI)/favicon.ico $(WEBDIRCOMP)/search_icon.svg $(WEBDIRCOMP)/favicon.ico $(IMG_FILES)
+
+clean:
+ rm -rf $(WEBDIR) src/.merlin _build
+
+.PHONY: distclean
+distclean:: clean
+
+distclean::
+ rm -rf .sass-cache
+
+# We need Dune and Lambda Soup; Markup.ml and Uutf are dependencies
+DUNE_TAG = 2.6.2
+LAMBDASOUP_TAG = 0.7.1
+MARKUP_TAG = 0.8.2
+UUTF_TAG = v1.0.2
+RE_TAG = 1.9.0
+
+# Duniverse rules - set-up dune and the dependencies in-tree for CI
+duniverse: dune/dune.exe re markup.ml uutf lambdasoup
+
+dune/dune.exe: dune
+ cd dune; ocaml bootstrap.ml
+
+GIT_CHECKOUT = git -c advice.detachedHead=false checkout
+
+dune:
+ git clone https://github.com/ocaml/dune.git -n -o upstream
+ cd dune; $(GIT_CHECKOUT) $(DUNE_TAG)
+
+distclean::
+ rm -rf dune
+
+re:
+ git clone https://github.com/ocaml/ocaml-re.git -n -o upstream
+ cd ocaml-re; $(GIT_CHECKOUT) $(RE_TAG)
+
+distclean::
+ rm -rf ocaml-re
+
+lambdasoup:
+ git clone https://github.com/aantron/lambdasoup.git -n -o upstream
+ cd lambdasoup; $(GIT_CHECKOUT) $(LAMBDASOUP_TAG)
+
+distclean::
+ rm -rf lambdasoup
+
+markup.ml:
+ git clone https://github.com/aantron/markup.ml.git -n -o upstream
+ cd markup.ml; $(GIT_CHECKOUT) $(MARKUP_TAG)
+
+distclean::
+ rm -rf markup.ml
+
+uutf:
+ git clone https://github.com/dbuenzli/uutf.git -n -o upstream
+ cd uutf; $(GIT_CHECKOUT) $(UUTF_TAG)
+ cd uutf; \
+ mv opam uutf.opam; \
+ echo '(lang dune 1.0)' > dune-project; \
+ echo '(name uutf)' >> dune-project; \
+ echo '(library (name uutf)(public_name uutf)(flags (:standard -w -3-27))(wrapped false))' > src/dune
+
+distclean::
+ rm -rf uutf
+
+.PHONY: css js img duniverse
--- /dev/null
+# HTML post-processing
+
+This directory contains material for enhancing the html of the manual
+and the API (from the `../htmlman` directory), including a quick
+search widget for the API.
+
+The process will create the `../webman` dir, and output the new html
+files (and assets) in `../webman/manual` (the manual) and `../webman/api` (the
+API).
+
+## manual and api
+
+There are two different scripts, `process_manual.ml` and
+`process_api.ml`. The first one deals with all the chapters of the
+manual, while the latter deals with the api generated with `ocamldoc`.
+They both use a common module `common.ml`.
+
+## How to build
+
+With dependencies to build the whole manual:
+```
+cd ..
+make web
+```
+
+Or, much faster if you know that `htmlman` is already up-to-date, from
+within the `html_processing` dir:
+
+```
+make
+```
+
+You need a working
+[`sass`](https://sass-lang.com/) CSS processor (tested with version
+"3.4.23").
+
+## How to browse
+
+From the `html_processing` directory:
+
+`firefox ../webman/api/index.html`
+
+`firefox ../webman/manual/index.html`
+
+## Debug
+
+```
+make DEBUG=1
+```
+
+By default all html files are re-created by `make`, but the javascript
+index `webman/api/index.js` and `webman/api/compilerlibref/index.js`
+are kept if they already exist. You can use `make clean` to delete all
+generated files.
+
+The javascript files in the `html_processing/js` dir add functionality
+but the web-manual is still browsable without them:
+
+- `scroll.js`: adds smooth scrolling in the html page, but only for
+ near targets. The reason is that when you jump to another place in a
+ text, if the jump is immediate (no scrolling), you easily get lost;
+ for instance you usually don't even realize that the target of the
+ link is just half a page below! Thus smooth scrolling helps
+ _understanding the structure_ of the document. However, when the
+ target is very far, the browser will scroll a huge amount of text
+ very quickly, and this becomes useless, and even painful for the
+ eye. Hence we disable smooth scrolling for far targets.
+
+- `search.js`: adds an 'as-you-type quick search widget', which
+ recognize values, modules, and type signatures. It is very useful,
+ but of course not strictly necessary.
--- /dev/null
+(lang dune 1.11)
--- /dev/null
+// NaVigation helpers for the manual, especially in mobile mode.
+
+// copyright 2020 San Vu Ngoc
+//
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+// In mobile mode, both left navigation bar and top part menu are
+// closed by default.
+
+var MENU_HEIGHT = 0;
+
+function closeSidebarExceptSearch (event) {
+ if ( event && event.target && event.target.classList.contains("api_search") ) {
+ false;
+ } else {
+ closeSidebar ();
+ true;
+ }
+}
+
+// This closes the sidebar in mobile mode. This should have no effect
+// in desktop mode.
+function closeSidebar () {
+ let bar = document.getElementById("sidebar");
+ let w = getComputedStyle(bar).width;
+ bar.style.left = "-" + w;
+ document.body.removeEventListener("click", closeSidebarExceptSearch);
+}
+
+function toggleSidebar () {
+ let bar = document.getElementById("sidebar");
+ let l = getComputedStyle(bar).left;
+ if (l == "0px") {
+ closeSidebar ();
+ } else {
+ bar.style.left = "0px";
+ setTimeout(function(){
+ // Any click anywhere but in search widget will close the sidebar
+ document.body.addEventListener("click", closeSidebarExceptSearch);
+ }, 1000);
+ }
+}
+
+function togglePartMenu () {
+ let pm = document.getElementById("part-menu");
+ let h = pm.offsetHeight;
+ if ( h == 0 ) {
+ pm.style.height = MENU_HEIGHT.toString() + "px";
+ } else {
+ pm.style.height = "0px";
+ }
+}
+
+function partMenu () {
+ let pm = document.getElementById("part-menu");
+ if ( pm != null ) {
+ MENU_HEIGHT = pm.scrollHeight; // This should give the true
+ // height of the menu, even if
+ // it was initialized to 0 in
+ // the CSS (mobile view).
+ // In desktop mode, the height is initially on "auto"; we
+ // have to detect it in
+ // order for the css animmations to work.
+ // TODO update this when window is resized
+ let currentHeight = pm.offsetHeight;
+ pm.style.height = currentHeight.toString() + "px";
+ let p = document.getElementById("part-title");
+ if ( p != null ) {
+ p.onclick = togglePartMenu;
+ }
+ }
+}
+
+function sideBar () {
+ closeSidebar();
+ let btn = document.getElementById("sidebar-button");
+ btn.onclick = toggleSidebar;
+}
+
+// We add it to the chain of window.onload
+window.onload=(function(previousLoad){
+ return function (){
+ previousLoad && previousLoad ();
+ partMenu ();
+ sideBar ();
+ }
+})(window.onload);
+
+
--- /dev/null
+// Smooth scrolling only for near targets
+// copyright 2019-2020 San Vu Ngoc
+//
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+
+// Goal: if a link is located at distance larger than MAX_DISTANCE, we
+// don't use a smooth scrolling.
+//
+// usage: to activate this, run setSmooth within window.onload:
+// window.onload = setSmooth
+// Here instead we create a loading chain because we have other things
+// to add window.onload later.
+
+const MAX_DISTANCE = 1000;
+const SCROLL_DURATION = 600;
+
+const url = window.location.pathname;
+var filename = url.substring(url.lastIndexOf('/')+1);
+if (filename == "") { filename = "index.html"; }
+
+function localLink (link) {
+ return (link.length > 0 &&
+ (link.charAt(0) == '#'
+ || link.substring(0,filename.length) == filename));
+}
+
+//aaa.html#s%3Adatatypes --> s:datatypes
+function getId (link) {
+ let uri = link.substring(link.lastIndexOf('#')+1);
+ return decodeURIComponent(uri)
+ // for instance decodeURIComponent("s%3Adatatypes") == 's:datatypes'
+}
+
+// Get absolute y position of element.
+// modified from:
+// https://www.kirupa.com/html5/get_element_position_using_javascript.htm
+// assuming effective licence CC0, see
+// https://forum.kirupa.com/t/get-an-elements-position-using-javascript/352186/3
+function getPosition(el) {
+ let yPos = 0;
+ while (el) {
+ yPos += (el.offsetTop + el.clientTop);
+ el = el.offsetParent;
+ }
+ return yPos;
+}
+
+// This function scans all "a" tags with a valid "href", and for those
+// that are local links (links within the same file) it adds a special
+// onclick function for smooth scrolling.
+function setSmooth () {
+ let a = document.getElementsByTagName("a");
+ let container = document.body.parentNode;
+ let i;
+ for (i = 0; i < a.length; i++) {
+ let href = a[i].getAttribute("href");
+ if (href != null && localLink(href)) {
+ a[i].onclick = function () {
+ let id = getId(href);
+ let target = "";
+ if ( id == "" ) {
+ target = container;
+ } else {
+ target = document.getElementById(id); }
+ if (! target) {
+ console.log ("Error, no target for id=" + id);
+ target = container; }
+ let top = container.scrollTop;
+ let dist = top - getPosition(target)
+ if (Math.abs(dist) < MAX_DISTANCE) {
+ target.scrollIntoView({ block: "start", inline: "nearest", behavior: 'smooth' });
+ setTimeout(function () {
+ location.href = href;
+ // this will set the "target" property.
+ }, SCROLL_DURATION);
+ return false;
+ // so we don't follow the link immediately
+ }
+ }
+ }
+ }
+}
+
+// We add it to the chain of window.onload
+window.onload=(function(previousLoad){
+ return function (){
+ previousLoad && previousLoad ();
+ setSmooth ();
+ }
+})(window.onload);
--- /dev/null
+// Searching the OCAML API.
+// Copyright 2019-2020 San VU NGOC
+
+// Permission to use, copy, modify, and/or distribute this software
+// for any purpose with or without fee is hereby granted, provided
+// that the above copyright notice and this permission notice appear
+// in all copies.
+
+// THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+// WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+// WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+// AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+// CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+// OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+// NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+// CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+// Thanks @steinuil for help on deferred loading.
+// Thanks @osener, @UnixJunkie, @Armael for very helpful suggestions
+// Thanks to all testers!
+
+const MAX_RESULTS = 20;
+const MAX_ERROR = 10;
+const DESCR_INDEX = 4; // index of HTML description in index.js
+const SIG_INDEX = 6; // index of HTML signature in index.js
+const ERR_INDEX = 8; // length of each line in index.js. This is used
+ // for storing the computed error, except if we
+ // don't want description and type signature,
+ // then ERR_INDEX becomes DESCR_INDEX.
+
+let indexState = 'NOT_LOADED';
+
+// return true if we are loading the index file
+function loadingIndex (includeDescr) {
+ switch (indexState) {
+ case 'NOT_LOADED':
+ indexState = 'LOADING';
+
+ const script = document.createElement('script');
+ script.src = 'index.js';
+ script.addEventListener('load', () => {
+ indexState = 'HAS_LOADED';
+ mySearch(includeDescr);
+ });
+ document.head.appendChild(script);
+ return true;
+
+ case 'LOADING':
+ return true;
+
+ case 'HAS_LOADED':
+ return false;
+ }
+}
+
+// line is a string array. We check if sub is a substring of one of
+// the elements of the array. The start/end of the string s are marked
+// by "^" and "$", and hence these chars can be used in sub to refine
+// the search. Case sensitive is better for OCaml modules. Searching
+// within line.join() is slightly more efficient that iterating 'line'
+// with .findIndex (my benchmarks show about 15% faster; except if we
+// search for the value at the beginning of line). However it might
+// use more memory.
+function hasSubString (sub, line) {
+ let lineAll = "^" + line.join("$^") + "$";
+ return (lineAll.includes(sub));
+}
+
+// Check if one of the strings in subs is a substring of one of the
+// strings in line.
+function hasSubStrings (subs, line) {
+ let lineAll = "^" + line.join("$^") + "$";
+ return (subs.findIndex(function (sub) {
+ return (lineAll.includes(sub))}) !== -1);
+}
+// Error of sub being a substring of s. Best if starts at 0. Except
+// for strings containing "->", which is then best if the substring is
+// at the most right-hand position (representing the "return type").
+// markers "^" and "$" for start/end of string can be used: if they
+// are not satisfied, the MAX_ERROR is returned.
+function subError (sub, s) {
+ let StartOnly = false;
+ let EndOnly = false;
+ if (sub.length>1) {
+ if (sub[0] == "^") {
+ StartOnly = true;
+ sub = sub.substring(1);
+ }
+ if (sub[sub.length - 1] == "$") {
+ EndOnly = true;
+ sub = sub.substring(0, sub.length - 1);
+ }
+ }
+ let err = s.indexOf(sub);
+ if (err == -1 ||
+ (StartOnly && err != 0) ||
+ (EndOnly && err != s.length - sub.length)) {
+ err = MAX_ERROR;
+ } else {
+ if ( sub.includes("->") ) {
+ err = Math.min(s.length - sub.length - err,1); // 0 or 1
+ // err = 0 if the substring is right-aligned
+ } else {
+ err = Math.min(err,1); // 0 or 1
+ // err = 0 if the substring
+ }
+ err += Math.abs((s.length - sub.length) / s.length);}
+ return (err)
+ // between 0 and 2, except if MAX_ERROR
+}
+
+// Minimal substring error. In particular, it returns 0 if the string
+// 'sub' has an exact match with one of the strings in 'line'.
+function subMinError (sub, line) {
+ let errs = line.map(function (s) { return subError (sub, s); });
+ return Math.min(...errs); // destructuring assignment
+}
+
+
+function add (acc, a) {
+ return acc + a;
+}
+
+// for each sub we compute the minimal error within 'line', and then
+// take the average over all 'subs'. Thus it returns 0 if each sub has
+// an exact match with one of the strings in 'line'.
+function subsAvgMinError (subs, line) {
+ let errs = subs.map(function (sub) { return subMinError (sub, line); });
+ return errs.reduce(add,0) / subs.length;
+}
+
+function formatLine (line) {
+ let li = '<li>';
+ let html = `<code class="code"><a href="${line[1]}"><span class="constructor">${line[0]}</span></a>.<a href="${line[3]}">${line[2]}</a></code>`;
+ if (line.length > 5) {
+ if ( line[ERR_INDEX] == 0 ) {
+ li = '<li class="match">';
+ }
+ html = `<pre>${html} : ${line[SIG_INDEX]}</pre>${line[DESCR_INDEX]}`; }
+ return (li + html + "</li>\n");
+}
+
+// Split a string into an array of non-empty words, or phrases
+// delimited by quotes ("")
+function splitWords (s) {
+ let phrases = s.split('"');
+ let words = [];
+ phrases.forEach(function (phrase,i) {
+ if ( i%2 == 0 ) {
+ words.push(...phrase.split(" "));
+ } else {
+ words.push(phrase);
+ }
+ });
+ return (words.filter(function (s) {
+ return (s !== "")}));
+}
+
+// The initial format of an entry of the GENERAL_INDEX array is
+// [ module, module_link,
+// value, value_link,
+// html_description, bare_description,
+// html_signature, bare_signature ]
+
+// If includeDescr is false, the line is truncated to its first 4
+// elements. When searching, the search error is added at the end of
+// each line.
+
+// In order to reduce the size of the index.js file, one could create
+// the bare_description on-the-fly using .textContent, see
+// https://stackoverflow.com/questions/28899298/extract-the-text-out-of-html-string-using-javascript,
+// but it would probably make searching slower (haven't tested).
+function mySearch (includeDescr) {
+ if (loadingIndex (includeDescr)) {
+ return;
+ }
+ let text = document.getElementById('api_search').value;
+ let results = [];
+ let html = "";
+ let count = 0;
+ let err_index = DESCR_INDEX;
+
+ if (text !== "") {
+ if ( includeDescr ) {
+ err_index = ERR_INDEX;
+ }
+
+ let t0 = performance.now();
+ let exactMatches = 0;
+ results = GENERAL_INDEX.filter(function (line) {
+ // We remove the html hrefs and add the Module.value complete name:
+ let cleanLine = [line[0], line[2], line[0] + '.' + line[2]];
+ line.length = err_index; // This truncates the line:
+ // this removes the description part if includeDescr =
+ // false (which modifies the lines of the GENERAL_INDEX.)
+ if ( includeDescr ) {
+ cleanLine.push(line[DESCR_INDEX+1]);
+ cleanLine.push(line[SIG_INDEX+1]);
+ // add the description and signature (txt format)
+ }
+ let error = MAX_ERROR;
+ if ( exactMatches <= MAX_RESULTS ) {
+ // We may stop searching when exactMatches >
+ // MAX_RESULTS because the ranking between all exact
+ // matches is unspecified (depends on the construction
+ // of the GENERAL_INDEX array)
+ if ( hasSubString(text, cleanLine) ) {
+ error = subMinError(text, cleanLine);
+ // one could merge hasSubString and subMinError
+ // for efficiency
+ }
+ if ( error != 0 && includeDescr ) {
+ let words = splitWords(text);
+ if ( hasSubStrings(words, cleanLine) ) {
+ // if there is no exact match for text and
+ // includeDescr=true, we also search for all separated
+ // words
+ error = subsAvgMinError(words, cleanLine);
+ }
+ }
+ if ( error == 0 ) { exactMatches += 1; }
+ }
+ line[err_index] = error;
+ // we add the error as element #err_index
+ return ( error != MAX_ERROR );
+ });
+ // We sort the results by relevance:
+ results.sort(function(line1, line2) {
+ return (line1[err_index] - line2[err_index])});
+ count = results.length;
+ console.log("Search results = " + (count.toString()));
+ results.length = Math.min(results.length, MAX_RESULTS);
+ html = "no results";
+ }
+ // inject new html
+ if (results.length > 0) {
+ html = "<ul>";
+ function myIter(line, index, array) {
+ html = html + formatLine(line);
+ }
+ results.forEach(myIter);
+ html += "</ul>";
+ if (count > results.length) {
+ html += "(...)";
+ }
+ }
+ document.getElementById("search_results").innerHTML = html;
+}
--- /dev/null
+// SCSS Module for manual.scss and style.scss
+
+// set this to true for integration into the ocaml.org wesite
+$ocamlorg:false;
+/* ocaml logo color */
+$logocolor:#ec6a0d;
+$logo_height:67px;
+
+@if $ocamlorg {
+ .container {
+ margin-left:0;
+ margin-right:0;
+ }
+}
+
+
+/* Fonts */
+@import url(https://fonts.googleapis.com/css?family=Fira+Mono:400,500);
+@import url(https://fonts.googleapis.com/css?family=Noticia+Text:400,400i,700);
+@import url(https://fonts.googleapis.com/css?family=Fira+Sans:400,400i,500,500i,600,600i,700,700i);
+
+$font-sans: "Fira Sans", Helvetica, Arial, sans-serif;
+$font-mono: "Fira Mono", courier, monospace;
+$font-serif: "Noticia Text", Georgia, serif;
+
+/* Reset */
+.pre,a,b,body,code,div,em,form,h1,h2,h3,h4,h5,h6,header,html,i,img,li,mark,menu,nav,object,output,p,pre,s,section,span,time,ul,td,var{
+ margin:0;
+ padding:0;
+ border:0;
+ font-size:inherit;
+ font:inherit;
+ line-height:inherit;
+ vertical-align:baseline;
+ text-align:inherit;
+ color:inherit;
+ background:0 0
+}
+*,:after,:before{
+ box-sizing:border-box
+}
+
+html.smooth-scroll {
+ scroll-behavior:smooth;
+}
+
+@media (prefers-reduced-motion: reduce) {
+ html {
+ scroll-behavior:auto;
+ }
+}
+
+body{
+ font-family: $font-sans;
+ text-align:left;
+ color:#333;
+ background:#fff
+}
+
+html {
+ font-size: 16px;
+ .dt-thefootnotes{
+ height:1ex;
+ }
+ .footnotetext{
+ font-size: 13px;
+ }
+}
+
+#sidebar-button{
+ float:right;
+ cursor: context-menu;
+ span{
+ font-size:28px;
+ }
+ display:none;
+ }
+
+.content, .api {
+ &>header {
+ margin-bottom: 30px;
+ nav {
+ font-family: $font-sans;
+ }
+ }
+}
+
+@mixin content-frame {
+ max-width:90ex;
+ margin-left:calc(10vw + 20ex);
+ margin-right:4ex;
+ margin-top:20px;
+ margin-bottom:50px;
+ font-family: $font-serif;
+ line-height:1.5
+}
+
+/* Menu in the left bar */
+@mixin nav-toc {
+ display: block;
+ padding-top: 10px;
+ position:fixed;
+ @if $ocamlorg {
+ top:0;
+ } @else {
+ top:$logo_height;
+ }
+ bottom:0;
+ left:0;
+ max-width:30ex;
+ min-width:26ex;
+ width:20%;
+ background:linear-gradient(to left,#ccc,transparent);
+ overflow:auto;
+ color:#1F2D3D;
+ padding-left:2ex;
+ padding-right:2ex;
+ .toc_version {
+ font-size:smaller;
+ text-align:right;
+ a {
+ color:#888;
+ }
+ }
+ ul{
+ list-style-type:none;
+ li{
+ margin:0;
+ ul{
+ margin:0
+ }
+ li{
+ border-left:1px solid #ccc;
+ margin-left:5px;
+ padding-left:12px;
+ }
+ a {
+ font-family: $font-sans;
+ font-size:.95em;
+ color:#333;
+ font-weight:400;
+ line-height:1.6em;
+ display:block;
+ &:hover {
+ box-shadow:none;
+ background-color: #edbf84;}
+ }
+ &.top a {
+ color: #848484;
+ &:hover {
+ background-color: unset;
+ text-decoration: underline;
+ }
+ }
+ }
+ }
+ &>ul>li {
+ margin-bottom:.3em;
+ &>a { /* First level titles */
+ font-weight:500;}
+ }
+}
+
+/* OCaml Logo */
+@mixin brand {
+ @if $ocamlorg {
+ display:none;
+ }
+ top:0;
+ height:$logo_height;
+ img{
+ margin-top:14px;
+ height:36px
+ }
+}
+
+@mixin mobile {
+ .api, .content{
+ margin:auto;
+ padding:2em;
+ h1 {
+ margin-top:0;
+ }
+ }
+}
+
+@mixin nav-toc-mobile {
+ position:static;
+ width:auto;
+ min-width:unset;
+ border:none;
+ padding:.2em 1em;
+ border-radius:5px 0;
+ &.brand {border-radius: 0 5px;}
+}
+
+/* Header is used as a side-bar */
+@mixin header-mobile {
+ margin-bottom:0;
+ position:fixed;
+ left:-10000px; /* initially hidden */
+ background-color:#ffefe7;
+ transition:left 0.4s;
+ top:0;
+ max-width:calc(100% - 2em);
+ max-height: 100%;
+ overflow-y: auto;
+ box-shadow:0.4rem 0rem 0.8rem #bbb;
+}
+
+@mixin sidebar-button {
+ #sidebar-button{
+ display:inline-block;
+ position:fixed;
+ top:1.5em;
+ right:1ex;
+ }
+}
+
+/* Print adjustements. */
+/* This page can be nicely printed or saved to PDF (local version) */
+
+@media print {
+ body {
+ color: black;
+ background: white;
+ }
+ body nav:first-child {
+ position: absolute;
+ background: transparent;
+ }
+ .content, .api {
+ nav.toc {
+ margin-right: 1em;
+ float: left;
+ position: initial;
+ background: #eee;
+ }
+ margin-left: 3em;
+ margin-right: 3em;
+ }
+}
+
+@mixin caret {
+ content:"▶";
+ color:$logocolor;
+ font-size:smaller;
+ margin-right:4px;
+ margin-left:-1em
+}
+
+@mixin disc {
+ content:"●";
+ color:$logocolor;
+ margin-right:4px;
+ margin-left:-1em;
+ font-family: $font-sans;
+ font-size:13px;
+ vertical-align:1px;
+}
+
+@mixin diamond {
+ content:"◆";
+ color:$logocolor;
+ margin-right:4px;
+ margin-left:-1em;
+ font-family: $font-sans;
+ font-size:14px;
+ vertical-align:1px;
+}
--- /dev/null
+// SOURCE FILE
+
+/* If the above line does not say "SOURCE FILE", then do not edit. It */
+/* means this file is generated from [sass manual.scss] */
+
+/* CSS file for the Ocaml manual */
+
+/* San Vu Ngoc, 2019-2020 */
+
+@import "common";
+@charset "UTF-8";
+
+.content{
+ @include content-frame;
+ #part-title{
+ float:left;
+ color:#777;
+ cursor: context-menu;
+ font-family: $font-sans;
+ span{ /* menu icon */
+ font-size:22px;
+ margin-right:1ex;
+ }
+ }
+ ul{list-style:none;}
+ ul.itemize li::before{@include disc;}
+
+ /* When the TOC is repeated in the main content */
+ ul.ul-content {
+ }
+ /* navigation links at the bottom of page */
+ .bottom-navigation {
+ margin-bottom:1em;
+ a.next {
+ float: right;
+ }
+ }
+ .copyright{
+ font-size:smaller;
+ display:inline-block;
+ }
+}
+.index{ /* index.html */
+ ul{
+ list-style: none;
+ li {
+ margin-left: 0.5ex;
+ span {
+ color:#c88b5f;
+ }
+ span.syntax-token{
+ color:#564233;
+ }
+ }
+ }
+ /* only for Contents/Foreword in index.html: */
+ ul.ul-content li::before{
+ @include disc;
+ margin-left: 0;
+ }
+ /* table of contents: (manual.001.html): */
+ ul.toc ul.toc ul.toc{
+ font-size:smaller;
+ }
+ section>ul>li>a{ /* for Parts title */
+ font-family: $font-sans;
+ font-size:larger;
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+ }
+ section>ul>li>ul>li:hover{ /* Chapters */
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%);
+ }
+ section>ul>li>ul>li{
+ transition: background 0.5s;
+ }
+}
+b{
+ font-weight:500
+}
+em,i{
+ font-style:italic
+}
+.ocaml {
+ background:#f7f5f4;
+}
+.ocaml,pre{
+ margin-top:.8em;
+ margin-bottom:1.2em
+}
+.ocaml .pre{
+ white-space:pre
+}
+p,ul{
+ margin-top:.5em;
+ margin-bottom:1em
+}
+ul{
+ list-style-position:outside
+}
+ul>li{
+ margin-left:22px
+}
+li>:first-child{
+ margin-top:0
+}
+.left{
+ text-align:left
+}
+.right{
+ text-align:right
+}
+a{
+ text-decoration:none;
+ color:#92370a
+}
+a:hover{
+ box-shadow:0 1px 0 0 #92370a
+}
+:target{
+ background-color:rgba(255,215,181,.3)!important;
+ box-shadow:0 0 0 1px rgba(255,215,181,.8)!important;
+ border-radius:1px
+}
+:hover>a.section-anchor{
+ visibility:visible
+}
+a.section-anchor:before{
+ content:"#"
+}
+a.section-anchor:hover{
+ box-shadow:none;
+ text-decoration:none;
+ color:#555
+}
+a.section-anchor{
+ visibility:hidden;
+ position:absolute;
+ margin-left:-1.3em;
+ font-weight:400;
+ font-style:normal;
+ padding-right:.4em;
+ padding-left:.4em;
+ color:#d5d5d5
+}
+.h10,.h7,.h8,.h9,h1,h2,h3,h4,h5,h6{
+ font-family: $font-sans;
+ font-weight:400;
+ margin:.5em 0 .5em 0;
+ padding-top:.1em;
+ line-height:1.2;
+ overflow-wrap:break-word
+}
+h1{
+ font-weight:500;
+ font-size:2.441em;
+ margin-top:1.214em
+}
+h1{
+ font-weight:500;
+ font-size:1.953em;
+ box-shadow:0 1px 0 0 #ddd
+}
+h2{
+ font-size:1.563em
+}
+h3{
+ font-size:1.25em
+}
+h1 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h2 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h3 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h3 code{
+ font-size:inherit;
+ font-weight:inherit
+}
+h4{
+ font-size:1.12em
+}
+h2, h3, h4, h5 {
+ font-weight: 500;
+}
+.ocaml,.pre,code,pre,tt{
+ font-family: $font-mono;
+ font-weight:400
+}
+.pre,pre{
+ border-left:4px solid #e69c7f;
+ overflow-x:auto;
+ padding-left:1ex
+}
+.ocaml .pre{
+ overflow-x:initial;
+}
+.caml-example .ocaml{
+ overflow-x:auto;
+}
+li code,p code{
+ background-color:#f6f8fa;
+ color:#0d2b3e;
+ border-radius:3px;
+ padding:0 .3ex
+}
+.pre .code,.pre.code,pre code{
+ background-color:inherit
+}
+p a>code{
+ color:#92370a}
+.pre code.ocaml,.pre.code.ocaml,pre code.ocaml{
+ font-size:.893rem}
+.keyword,.ocamlkeyword{
+ font-weight:500}
+section+section{
+ margin-top:25px}
+
+/* Table of Contents in the Left-hand sidebar */
+nav.toc{
+ @include nav-toc;
+ &.brand{
+ @include brand;
+ }
+ .toc_title{
+ display:block;
+ margin:.5em 0 1.414em}
+/* .toc_title a{ */
+/* color:#777; */
+/* font-size:1em; */
+/* line-height:1.2; */
+ /* font-weight:500} */
+
+}
+.tableau {
+ table {
+ border-collapse: collapse;
+ }
+ td {
+ background:#f8f7f6;
+ border:1px solid #ccc;
+ padding-left:3px;
+ padding-right:3px;
+ }
+}
+
+pre{
+ background:linear-gradient(to left,#fff 0,#ede8e5 100%)
+}
+code.caml-output.ok,div.caml-output.ok{
+ color:#045804
+}
+code.caml-output.error,div.caml-output.error{
+ color:#ff4500
+}
+.chapter span,.tutorial span,.maintitle h1 span{
+ color:$logocolor
+}
+h1 span{
+ color: #d28853;
+}
+blockquote.quote{
+ /*font-size: smaller;*/
+ hr{
+ display:none;
+ }
+}
+#part-menu{
+ font-family: $font-sans;
+ text-align:right;
+ list-style:none;
+ overflow-y:hidden;
+ transition:height 0.3s;
+}
+#part-menu li.active a{
+ color:#000;
+ &::before{@include diamond}
+}
+.center {
+ text-align: center;
+ margin-left: auto;
+ margin-right: auto;
+}
+.display {
+ margin: 0 auto;
+}
+.c001 {
+ border-spacing: 6px;
+ border-collapse: separate;
+}
+span.syntax-token{
+ color:#564233;
+ font-family: $font-mono;
+ border-radius:6px
+}
+div.caml-example.toplevel code.caml-input::before,
+div.caml-example.toplevel div.caml-input::before{
+ /* content:"#"; */ /* pre-4.11 */
+ color:#888
+}
+span.number{
+ padding-right: 1ex;
+}
+span.syntax-token {
+ font-family: $font-mono;
+}
+span.syntax-token {
+ color: rgba(91, 33, 6, 0.87);
+}
+span.ocamlprompt{
+ color:#888
+}
+span.font-bold .machine{
+ font-weight:700;
+ color:#564233;
+}
+.osvariant {
+ font-family: $font-sans;
+}
+.font-it {
+ font-style: italic;
+}
+.font-tt {
+ font-family: $font-mono;
+}
+span.authors{
+ font-style:italic;
+ background-color:inherit
+}
+span.nonterminal {
+ font-style: oblique;
+}
+.font-sl {
+ font-style: oblique;
+}
+.center table {
+ margin-left: inherit;
+ margin-right: inherit;
+}
+td .font-bold {
+ font-weight: bold;
+}
+.c003 {
+ text-align: center;
+}
+.cellpadding1 tr td {
+ padding: 1px 4px;
+}
+.caml-input{
+ span.ocamlkeyword{
+ font-weight:500;
+ color:#444
+ }
+ span.ocamlhighlight{
+ font-weight:500;
+ text-decoration:underline
+ }
+ span.id{
+ color:#523b74
+ }
+ span.ocamlstring,.caml-input span.string{
+ color:#df5000
+ }
+ span.comment, .caml-input span.ocamlcomment{
+ color:#969896
+ }
+}
+.ocaml span.ocamlerror{
+ font-weight:500
+}
+
+
+/* Mobile */
+@media only screen and (max-width:95ex){
+ @include mobile;
+ @include sidebar-button;
+ .content #part-menu{
+ display:inline-block;
+ height:0;
+ width:100%;
+ }
+ nav.toc{
+ @include nav-toc-mobile;
+ }
+ header{
+ @include header-mobile;
+ }
+}
--- /dev/null
+// SOURCE FILE
+
+/* If the above line does not say "SOURCE FILE", then do not edit. It */
+/* means this file is generated from [sass style.scss] */
+
+/* CSS file for the Ocaml API. San Vu Ngoc 2019 */
+
+// TODO: the ocamldoc output of Functors like in
+// compilerlibref/4.08/Arg_helper.Make.html
+// is not easy to style... without breaking other tables.
+
+@import "common";
+@charset "UTF-8";
+
+// tables are difficult to style, be careful.
+// These settings should apply to the main index tables
+// (like "index_values.html"), which do not have any particular class.
+// These tables have two columns.
+.api>table {
+ word-break: break-word;
+ // this is unfortunately due to some very long names in Internal modules
+ td.module,
+ td:first-child {
+ width: 33%;
+ }
+ td:nth-child(2) {
+ width: 65%;
+ }
+ td[align="left"] {
+ // for the "Parameter" column of module signatures like
+ // Arg_helper.Make.html, which unfortunately have no class
+ // either.
+ word-break: normal;
+ }
+ td[align="left"]:first-child {
+ width: 1%;
+ }
+}
+
+.api {
+ // font-size: 16px;
+ // font-family: $font-sans;
+ // text-align: left;
+ // color: #333;
+ // background: #FFFFFF;
+ table {
+ // tables are difficult to style, be careful
+ border-collapse: collapse;
+ border-spacing: 0;
+ thead {
+ background: rgb(228, 217, 211);
+ }
+ /* must be same as <pre>: */
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ width: 100%;
+ td {
+ padding-left: 1ex;
+ padding-right: 1ex;
+ /*float: left;*/
+ }
+ /* add some room at the end of the table */
+ tr:last-child td {
+ padding-bottom: 7px;
+ }
+ }
+ // Tables are used for describing types, in particular union types:
+ table.typetable {
+ width: 100%;
+ word-break: normal;
+ box-shadow: none;
+ td {
+ float: left;
+ }
+ td:nth-child(2) {
+ width: 37%;
+ code {
+ white-space: pre-line;
+ }
+ }
+ td:last-child {
+ width: calc(100% - 1.3em);
+ // cf: CamlinternalFormatBasics.html
+ // the 1.3em is related to the 1em below
+ }
+ td:first-child {
+ width: 1em;
+ }
+ td:nth-child(4).typefieldcomment {
+ /* this should be the column with the type */
+ width: 60%;
+ /* not optimal, see: Format.html#symbolic
+ but leaving it automatic is not always good either: see: Arg.html */
+ }
+ }
+
+ // for functor signature
+ table.paramstable {
+ word-break: normal;
+ td {
+ code {
+ white-space: pre-wrap;
+ }
+ }
+ td:first-child, td:nth-child(2) {
+ width: 1em; // second column should contain only
+ // ":". First one will adapt to size.
+ }
+ }
+
+ .sig_block {
+ border-left: 4px solid #e69c7f;
+ padding-left: 1em;
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ // PROBLEM the sig_block ends too soon, it should actually
+ // include the "end)" line ==> REPORT THIS
+ // (eg: compilerlibref/Arg_helper.html)
+ pre {
+ margin-top: 0;
+ background: none;
+ border-left: 0;
+ }
+ }
+ pre .sig_block {
+ margin-bottom: 0; // see above
+ border-left: 0;
+ }
+
+ *, *:before, *:after {
+ box-sizing: border-box;
+ }
+
+ @include content-frame;
+
+ /* Basic markup elements */
+
+ b, strong {
+ font-weight: 600;
+ }
+ i, em {
+ font-style: italic;
+ }
+ sup {
+ vertical-align: super;
+ }
+ sub {
+ vertical-align: sub;
+ }
+ sup, sub {
+ font-size: 12px;
+ line-height: 0;
+ margin-left: 0.2ex;
+ }
+ pre {
+ margin-top: 0.8em;
+ margin-bottom: 0;
+ }
+ p, ul, ol {
+ margin-top: 0.5em;
+ margin-bottom: 1em;
+ }
+ ul, ol {
+ list-style-position: outside
+ }
+ ul>li {
+ margin-left: 22px;
+ }
+ ol>li {
+ margin-left: 27.2px;
+ }
+ li>*:first-child {
+ margin-top: 0
+ }
+
+ /* Text alignements, this should be forbidden. */
+
+ .left {
+ text-align: left;
+ }
+ .right {
+ text-align: right;
+ }
+ .center {
+ text-align: center;
+ }
+ /* Links and anchors */
+ a {
+ text-decoration: none;
+ color: #92370A;
+ /* box-shadow: 0 1px 0 0 #d8b68b; */
+ }
+ a:hover {
+ box-shadow: 0 1px 0 0 #92370A;
+ }
+ td a:hover {
+ background: white;
+ }
+ /* Linked highlight */
+ *:target {
+ /*box-shadow: 0 0px 0 1px rgba(255, 215, 181, 0.8) !important;*/
+ border-radius: 1px;
+ /*border-bottom: 4px solid rgb(255, 215, 181);*/
+ box-shadow: 0 4px 0 0px rgb(255, 215, 181);
+ z-index: 0;
+ @if $ocamlorg {
+ /* Because of fixed banner in the ocaml.org site, we have to offset the targets. See https://stackoverflow.com/questions/10732690/offsetting-an-html-anchor-to-adjust-for-fixed-header */
+ padding-top: 85px;
+ margin-top: -85px;
+ }
+ }
+
+
+ h2:target {
+ /* background: linear-gradient(to bottom, rgb(253, 252, 252) 0%, rgba(255, 215, 181, 0.3) 100%) !important; */
+ /* transition: 300ms; this prevents margin-top:-80 to work... */
+ }
+
+ *:hover>a.section-anchor {
+ visibility: visible;
+ }
+
+ a.section-anchor:before {
+ content: "#"
+ }
+
+ a.section-anchor:hover {
+ box-shadow: none;
+ text-decoration: none;
+ color: #555;
+ }
+
+ a.section-anchor {
+ visibility: hidden;
+ position: absolute;
+ /* top: 0px; */
+ /* margin-left: -3ex; */
+ margin-left: -1.3em;
+ font-weight: normal;
+ font-style: normal;
+ padding-right: 0.4em;
+ padding-left: 0.4em;
+ /* To remain selectable */
+ color: #d5d5d5;
+ }
+
+ .spec > a.section-anchor {
+ margin-left: -2.3em;
+ padding-right: 0.9em;
+ }
+
+ .xref-unresolved {
+ color: #92370A
+ }
+ .xref-unresolved:hover {
+ box-shadow: 0 1px 0 0 #CC6666;
+ }
+
+ /* Section and document divisions.
+ Until at least 4.03 many of the modules of the stdlib start at .h7,
+ we restart the sequence there like h2 */
+
+ h1, h2, h3, h4, h5, h6, .h7, .h8, .h9, .h10 {
+ font-family: $font-sans;
+ font-weight: 400;
+ margin: 0.5em 0 0.5em 0;
+ padding-top: 0.1em;
+ line-height: 1.2;
+ overflow-wrap: break-word;
+ }
+
+ h1 {
+ margin-top: 1.214em;
+ margin-bottom: 19px;
+ font-weight: 500;
+ font-size: 1.953em;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+
+ h2 {
+ font-size: 1.563em;
+ margin: 1em 0 1em 0
+ }
+
+ h3 {
+ font-size: 1.25em;
+ }
+
+ small, .font_small {
+ font-size: 0.8em;
+ }
+
+ h1 code, h1 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h2 code, h2 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h3 code, h3 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h3 code, h3 tt {
+ font-size: inherit;
+ font-weight: inherit;
+ }
+
+ h4 {
+ font-size: 1.12em;
+ }
+
+
+ /* Preformatted and code */
+
+ tt, code, pre {
+ font-family: $font-mono;
+ font-weight: 400;
+ }
+
+ pre {
+ border-left: 4px solid #e69c7f;
+ white-space: pre-wrap;
+ word-wrap: break-word;
+ padding-left: 1ex;
+ }
+
+ p code, li code { /* useful ? */
+ background-color: #ebf2f9; /*#f6f8fa;*/
+ color: #0d2b3e;
+ border-radius: 3px;
+ padding: 0 0.3ex;
+ white-space: pre-wrap; // utile seulement dans la table index_values? (attention à bootstrap.css)
+ }
+
+ pre code {
+ background-color: inherit;
+ }
+
+ p a > code {
+ color: #92370A;
+ }
+
+ /* Code blocks (e.g. Examples) */
+
+ pre code.ocaml {
+ font-size: 0.893rem;
+ }
+
+ /* Code lexemes */
+
+ .keyword {
+ font-weight: 500;
+ color: inherit;
+ }
+
+ /* Module member specification */
+
+ .spec:not(.include), .spec.include details summary {
+ background: linear-gradient(to left, rgb(253, 252, 252) 0%, rgb(234, 246, 250) 100%);
+ border-radius: 3px;
+ border-left: 4px solid #5c9cf5;
+ border-right: 5px solid transparent;
+ padding: 0.35em 0.5em;
+ }
+
+ .spec.include details summary:hover {
+ background-color: #ebeff2;
+ }
+
+ dl, div.spec, .doc, aside {
+ margin-bottom: 20px;
+ }
+
+ dl > dd {
+ padding: 0.5em;
+ }
+
+ dd> :first-child {
+ margin-top: 0;
+ }
+
+ dd > p:first-child > code:first-child {
+ color: teal;
+ }
+
+ dl:last-child, dd> :last-child, aside:last-child, article:last-child {
+ margin-bottom: 0;
+ }
+
+ dt+dt {
+ margin-top: 15px;
+ }
+
+ section+section, section > header + dl {
+ margin-top: 25px;
+ }
+
+ .spec.type .variant {
+ margin-left: 2ch;
+ }
+ .spec.type .variant p {
+ margin: 0;
+ font-style: italic;
+ }
+ .spec.type .record {
+ margin-left: 2ch;
+ }
+ .spec.type .record p {
+ margin: 0;
+ font-style: italic;
+ }
+
+ div.def {
+ margin-top: 0;
+ text-indent: -2ex;
+ padding-left: 2ex;
+ }
+
+ div.def+div.doc {
+ margin-left: 1ex;
+ margin-top: 2.5px
+ }
+
+ div.doc>*:first-child {
+ margin-top: 0;
+ }
+
+ /* The elements other than heading should be wrapped in <aside> elements. */
+ /* heading, body>p, body>ul, body>ol, h3, h4, body>pre { */
+ /* margin-bottom: 30px; */
+ /* } */
+
+ /* Collapsible inlined include and module */
+
+ .spec.include details {
+ position: relative;
+ }
+
+ .spec.include details:after {
+ z-index: -100;
+ display: block;
+ content: " ";
+ position: absolute;
+ border-radius: 0 1ex 1ex 0;
+ right: -20px;
+ top: 1px;
+ bottom: 1px;
+ width: 15px;
+ background: rgba(0, 4, 15, 0.05);
+ box-shadow: 0 0px 0 1px rgba(204, 204, 204, 0.53);
+ }
+
+ .spec.include details summary {
+ position: relative;
+ margin-bottom: 20px;
+ cursor: pointer;
+ outline: none;
+ }
+
+ /* FIXME: Does not work in Firefox. */
+ details summary::-webkit-details-marker {
+ color: #888;
+ transform: scaleX(-1);
+ position: absolute;
+ top: calc(50% - 5px);
+ height: 11px;
+ right: -29px;
+ }
+
+ td.doc *:first-child {
+ margin-top: 0em
+ }
+
+ /* @ tags */
+
+ ul.at-tag {
+ list-style-type: none;
+ margin-left: 0;
+ padding: 0;
+ }
+
+ ul.at-tag li {
+ margin-left: 0;
+ padding: 0;
+ }
+
+ ul.at-tag li p:first-child {
+ margin-top: 0
+ }
+
+ /* FIXME remove */
+
+ span.at-tag {
+ font-weight: bold
+ }
+
+ span.warning,
+ .at-tag.deprecated {
+ font-weight: normal;
+ color: #8eaf20;
+ }
+
+ span.warning {
+ margin-right: 1ex;
+ }
+
+ .at-tag.raise {
+ font-weight: bold;
+ }
+
+ /* FIXME random other things to review. */
+
+ .heading {
+ margin-top: 10px;
+ border-bottom: solid;
+ border-width: 1px;
+ border-color: #DDD;
+ text-align: right;
+ font-weight: normal;
+ font-style: italic;
+ }
+
+ .heading+.sig {
+ margin-top: -20px;
+ }
+
+ .heading+.parameters {
+ margin-top: -20px;
+ }
+
+ /* Odig package index */
+
+ .by-name ol, .by-tag ol, .errors ol {
+ list-style-type: none;
+ margin-left: 0;
+ }
+
+ .by-name ol ol, .by-tag ol ol {
+ margin-top: 0;
+ margin-bottom: 0
+ }
+
+ .by-name li, .by-tag li, .errors li {
+ margin-left: 0;
+ }
+
+ .by-name .version {
+ font-size: 10px;
+ color: #AAA
+ }
+
+ .by-name nav {
+ margin-bottom: 10px
+ }
+
+ .by-name nav a {
+ text-transform: uppercase;
+ font-size: 18px;
+ margin-right: 1ex;
+ color: #222;
+ display: inline-block;
+ }
+
+ .by-tag nav a {
+ margin-right: 1ex;
+ color: #222;
+ display: inline-block;
+ }
+
+ .by-tag>ol>li {
+ margin-top: 10px;
+ }
+
+ .by-tag>ol>li>span, .by-tag>ol>li>ol, .by-tag>ol>li>ol>li {
+ display: inline-block;
+ margin-right: 1ex;
+ }
+
+ /* Odig package page */
+
+ .package nav {
+ display: inline;
+ font-size: 14px;
+ font-weight: normal;
+ }
+
+ .package .version {
+ font-size: 14px;
+ }
+
+ h1+.modules, h1+.sel {
+ margin-top: 10px
+ }
+
+ .sel {
+ font-weight: normal;
+ font-style: italic;
+ font-size: 14px;
+ margin-top: 20px;
+ }
+
+ .sel+.modules {
+ margin-top: 10px;
+ margin-bottom: 20px;
+ margin-left: 1ex;
+ }
+
+ .modules {
+ margin: 0;
+ }
+
+ .modules .module {
+ min-width: 8ex;
+ padding-right: 2ex
+ }
+
+ .package.info {
+ margin: 0;
+ }
+
+ .package.info td:first-child {
+ font-style: italic;
+ padding-right: 2ex;
+ }
+
+ .package.info ul {
+ list-style-type: none;
+ display: inline;
+ margin: 0;
+ }
+
+ .package.info li {
+ display: inline-block;
+ margin: 0;
+ margin-right: 1ex;
+ }
+
+ #info-authors li, #info-maintainers li {
+ display: block;
+ }
+
+ /* lists in the main text */
+ ul.itemize {
+ list-style: none;
+ }
+
+ ul.itemize li::before {
+ content: "▶";
+ color: $logocolor;
+ margin-right: 4px;
+ margin-left: -1em;
+ }
+
+ /* Sidebar and TOC */
+
+ /*.toc ul:before */
+ .toc_title
+ {
+ display: block;
+ /*content: "Contents";*/
+ /* text-transform: uppercase; */
+ margin: 1.414em 0 0.5em;
+ }
+
+ .toc_title a {
+ color: #777;
+ font-size: 1em;
+ line-height: 1.2;
+ font-weight: 500;
+ }
+
+ .toc {
+ @include nav-toc;
+ &.brand {
+ @include brand;
+ }
+ }
+
+ .toc input#api_search {
+ width: 85%;
+ font-family: inherit;
+ }
+
+ .toc #search_results {
+ font-size: smaller;
+ ul {
+ li {
+ margin-bottom: 0;
+
+ }
+ a {
+ display: inline-block;
+ padding-left: 0;
+ }
+ }
+ }
+
+ .ocaml {
+ background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%);
+ }
+
+ span.arrow {
+ font-size: 20px;
+ line-height: 8pt;
+ font-family: $font-mono;
+ }
+ header dl dd, header dl dt {
+ display: inline-block;
+ }
+ pre {
+ background: linear-gradient(to left, white 0%, rgb(237, 232, 229) 100%);
+ }
+
+ #search_results li.match::before {
+ content: "▶";
+ font-size: smaller;
+ color: $logocolor;
+ float: left;
+ margin-left: -3ex;
+ }
+
+ code.caml-example,
+ div.caml-example, div.toplevel {
+ /* background: linear-gradient(to left, white 0%, rgb(243, 247, 246) 100%); */
+ }
+
+ div.caml-output.ok,
+ code.caml-output.ok,
+ span.c006 {
+ color: #045804;
+ }
+
+ code.caml-output.error,
+ div.caml-output.error {
+ color: orangered;
+ }
+ .tutorial span {
+ color: $logocolor;
+ }
+
+ ul.tutos_menu {
+ font-family: $font-sans;
+ text-align: right;
+ list-style: none;
+ }
+
+ ul.tutos_menu li.active a {
+ color: black;
+ }
+
+ nav.toc {
+
+ }
+
+ span.c003 {
+ font-family: $font-mono;
+ background-color: #f3ece6;
+ border-radius: 6px;
+ }
+
+ div.caml-example.toplevel div.caml-input::before,
+ div.caml-example.toplevel code.caml-input::before
+ {
+ content:"#";
+ color:#888;
+ }
+
+ span.c004 {
+ color: #888;
+ }
+
+ span.c009 {
+ font-style: italic;
+ }
+
+ code span.keyword,
+ .caml-input span.kw {
+ font-weight: 500;
+ color: #444;
+ }
+
+ code span.keywordsign {
+ color:#92370a;
+ }
+
+ .caml-input span.kw1 {
+ font-weight: 500;
+ color: #777;
+ }
+
+ code span.constructor,
+ .caml-input span.kw2 {
+ color: #8d543c;
+ }
+
+ .caml-input span.numeric {
+ color: #0086b3;
+ }
+
+ .caml-input span.id {
+ color: #523b74;
+ }
+
+ code span.string,
+ .caml-input span.string {
+ color: #df5000;
+ }
+
+ .caml-input span.comment {
+ color: #969896;
+ }
+
+ .copyright {
+ margin-top: 1em;
+ font-size: smaller;
+ }
+
+ .dt-thefootnotes {
+ float: left;
+ }
+
+ ul.info-attributes {
+ margin-top: 0ex;
+ margin-bottom: 1.5em;
+ list-style: none;
+ }
+
+ /* pour l'API */
+ hr {
+ margin-bottom: 2em;
+ visibility: hidden;
+ }
+
+ code.type {
+ color: #8d543c;
+ }
+
+ td div.info p {
+ margin: 0;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+ td div.info { /* index page */
+ padding-left: 0;
+ }
+
+ > #search_results {
+ margin-top: 2em;
+ }
+
+ input#api_search {
+ font-family: inherit;
+ }
+
+ #search_results {
+ ul {
+ list-style: none;
+ li {
+ margin-bottom: 4px;
+ }
+ }
+
+ li div.info { /* index page */
+ display: block;
+ max-width: 70%;
+ padding-left: 4em;
+ margin-bottom: 1ex;
+ }
+
+ li div.info p { /* index page */
+ margin: 0;
+ }
+ }
+
+ span.search_comment {
+ vertical-align: bottom;
+ }
+
+ .search_comment .search_help {
+ height: 0;
+ opacity: 0;
+ font-size: 10px;
+ overflow: hidden;
+ transition: all 0.5s;
+ ul {
+ margin-top: 0;
+ }
+ }
+ .search_comment:hover .search_help {
+ height: auto;
+ margin-top:-1px;
+ opacity: 0.8;
+ background: linear-gradient(to bottom, white 0%, rgb(237, 232, 229) 100%);
+ transition: all 0.5s;
+ }
+ .search_comment .search_help:hover {
+ font-size: 14px;
+ }
+
+
+ td div.info div.info-desc {
+ margin-bottom: 0;
+ }
+
+ div.info div.info-desc {
+ margin-bottom: 2ex;
+ padding-left: 2em;
+ }
+
+ div.info.top div.info-desc {
+ padding-left: 0;
+ padding-bottom: 1em;
+ box-shadow: 0 1px 0 0 #ddd;
+ }
+
+ td div.info {
+ margin: 0;
+ }
+
+ div.info-deprecated {
+ padding-top: 0.5em;
+ }
+
+ .info-desc p {
+ margin-bottom: 0;
+ code {
+ white-space: normal;
+ }
+ }
+
+ td.typefieldcomment > code {
+ display: none; /* this only applies to "(*" and "*)" */
+ }
+
+ td.typefieldcomment {
+ padding: 0;
+ }
+
+ td.typefieldcomment p {
+ color: #776558;
+ }
+
+ td.typefieldcomment:nth-child(3), /* should apply to "(*" */
+ td.typefieldcomment:last-child /* should apply to "*)" */
+ {
+ display: none;
+ }
+
+ .api_search img {
+ height: 1em;
+ vertical-align: middle;
+ margin-right: 1em;
+ }
+
+ nav .api_search img {
+ margin-right: 0;
+ }
+
+}
+
+
+#footer {
+ margin-left: 26ex;
+}
+
+
+/* When the navigation bar is collapsed */
+// this should match with ocamlorg.css
+@media only screen and (max-width: 979px) {
+ @include mobile;
+ .container, .api {
+ margin-left: auto;
+ margin-right: auto;
+ }
+ @include sidebar-button;
+ header {
+ @include header-mobile;
+ }
+
+ .api>table {
+ box-shadow: 0px 3px 9px 3px #ddd;
+ margin-bottom: 1em;
+ padding-bottom: 2px;
+ td:nth-child(2) {
+ width: 59%;
+ }
+ }
+
+ .api {
+ *:target {
+ padding-top: 0px;
+ margin-top: 0px;
+ }
+
+ .toc {
+ @include nav-toc-mobile;
+ }
+
+ table td {
+ padding-left: 2%;
+ }
+
+ table td:first-child {
+ padding-right: 0;
+ }
+
+ table.typetable {
+ box-shadow: none;
+ td:nth-child(2) {
+ white-space: normal;
+ /*width: 41%;*/
+ width: auto;
+ max-width: calc(100% - 3ex);
+ }
+ tr td:nth-child(4).typefieldcomment {
+ /*width: 50%;*/
+ width: auto;
+ margin-left: 3ex;
+ word-break: break-word;
+ float: right;
+ }
+ td:last-child {
+ width: auto;
+ }
+ tr td:first-child {
+ padding-right: 0;
+ width: auto;
+ }
+ }
+
+ .info-desc p code {
+ word-break: break-word;
+ }
+
+ td div.info div.info-desc {
+ padding-left: 0;
+ }
+ span.search_comment {
+ display: block;
+ }
+ }
+ .api>table td:first-child {
+ width: 40%;
+ }
+
+ .api {
+ code {
+ word-break: break-word;
+ white-space: pre-wrap;
+ }
+ }
+
+ #footer {
+ margin-left: auto;
+ }
+}
+
+
+
+/* When the navigation bar has reduced size */
+@if $ocamlorg {
+ @media (max-height: 600px) and (min-width: 980px) {
+ .api *:target {
+ padding-top: 60px;
+ margin-top: -60px;
+ }
+ .api nav.toc {
+ top: 46px;
+ }
+ }
+}
+
--- /dev/null
+(* ------------ Ocaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: common.ml
+
+ This file contains functions that are used by process_api.ml and
+ process_manual.ml *)
+
+open Soup
+open Printf
+
+let debug = not (Array.mem "quiet" Sys.argv)
+
+let dbg =
+ let printf = Printf.(if debug then kfprintf else ikfprintf) in
+ let flush =
+ if debug then
+ fun ch -> output_char ch '\n'; flush ch
+ else
+ ignore
+ in
+ fun fmt -> printf flush stdout fmt
+
+let ( // ) = Filename.concat
+
+let process_dir = Filename.current_dir_name
+
+(* Output directory *)
+let web_dir = Filename.parent_dir_name // "webman"
+
+(* Output for manual *)
+let docs_maindir = web_dir // "manual"
+let docs_file = ( // ) docs_maindir
+
+(* Ouput for API *)
+let api_dir = web_dir // "api"
+
+(* How to go from manual to api *)
+let api_page_url = "../api"
+
+(* How to go from api to manual *)
+ let manual_page_url = "../manual"
+
+(* Set this to the directory where to find the html sources of all versions: *)
+let html_maindir = "../htmlman"
+
+(* Where to get the original html files *)
+let html_file = ( // ) html_maindir
+
+let releases_url = "https://ocaml.org/releases/"
+
+let favicon = "favicon.ico"
+
+(**** utilities ****)
+
+let flat_option f o = Option.bind o f
+
+let (<<) f g x = f (g x)
+
+let string_of_opt = Option.value ~default:""
+
+let starts_with substring s =
+ let l = String.length substring in
+ l <= String.length s &&
+ String.sub s 0 l = substring
+
+(**** html processing ****)
+
+(* Return next html element. *)
+let rec next node =
+ match next_element node with
+ | Some n -> n
+ | None -> match parent node with
+ | Some p -> next p
+ | None -> raise Not_found
+
+let logo_html url =
+ "<nav class=\"toc brand\"><a class=\"brand\" href=\"" ^ url ^
+ "\" ><img src=\"colour-logo.svg\" class=\"svg\" alt=\"OCaml\" /></a></nav>"
+ |> parse
+
+let wrap_body ~classes soup =
+ let body = soup $ "body" in
+ set_name "div" body;
+ List.iter (fun c -> add_class c body) classes;
+ wrap body (create_element "body");
+ body
+
+(* Add favicon *)
+let add_favicon head =
+ parse ({|<link rel="shortcut icon" type="image/x-icon" href="|} ^
+ favicon ^ {|">|})
+ |> append_child head
+
+(* Update html <head> element with javascript and favicon *)
+let update_head ?(search = false) soup =
+ let head = soup $ "head" in
+ if search then begin
+ create_element "script" ~attributes:["src","search.js"]
+ |> append_child head
+ end;
+ create_element "script" ~attributes:["src","scroll.js"]
+ |> append_child head;
+ create_element "script" ~attributes:["src","navigation.js"]
+ |> append_child head;
+ add_favicon head
+
+(* Add version number *)
+let add_version_link nav text url =
+ let vnum = create_element "div" ~class_:"toc_version" in
+ let a = create_element "a" ~inner_text:text
+ ~attributes:["href", url; "id", "version-select"] in
+ append_child vnum a;
+ prepend_child nav vnum
+
+let add_sidebar_button body =
+ let btn = create_element "div" ~id:"sidebar-button" in
+ create_element "span" ~inner_text:"☰"
+ |> prepend_child btn;
+ prepend_child body btn
+
+(* Detect OCaml version from VERSION file *)
+let find_version () =
+ let pp = Filename.parent_dir_name in
+ let version_file = pp // pp // pp // "VERSION" in
+ let major, minor = Scanf.bscanf (Scanf.Scanning.from_file version_file) "%u.%u" (fun x y -> x,y) in
+ sprintf "%u.%u" major minor
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
--- /dev/null
+(library
+ (name common)
+ (modules common)
+ (libraries lambdasoup))
+
+(executable
+ (name process_api)
+ (modules process_api)
+ (libraries unix re lambdasoup common))
+
+(executable
+ (name process_manual)
+ (modules process_manual)
+ (libraries re lambdasoup common))
--- /dev/null
+(* ------------ Ocaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: process_api.ml
+
+ Post-processing the HTML of the OCaml API. *)
+
+open Soup
+open Printf
+open Common
+
+let compiler_libref = ref false
+(* set this to true to process compilerlibref instead of libref *)
+
+type config = {
+ src_dir : string;
+ dst_dir : string;
+ title : string
+}
+
+(* HTML code for the search widget. We don't add the "onchange" event because it
+ forces to click twice to an external link after entering text. *)
+let search_widget with_description =
+ let search_decription = if with_description
+ then {|<span class="search_comment">(search values, type signatures, and descriptions - case sensitive)<div class="search_help"><ul><li>You may search bare values, like <code>map</code>, or indicate the module, like <code>List.map</code>, or type signatures, like <code>int -> float</code>.</li><li>To combine several keywords, just separate them by a space. Quotes "like this" can be used to prevent from splitting words at spaces.</li><li>You may use the special chars <code>^</code> and <code>$</code> to indicate where the matched string should start or end, respectively.</li></ul></div></span>|}
+ else "" in
+ sprintf {|<div class="api_search"><input type="text" name="apisearch" id="api_search" class="api_search"
+ oninput = "mySearch(%b);"
+ onkeypress = "this.oninput();"
+ onclick = "this.oninput();"
+ onpaste = "this.oninput();">
+<img src="search_icon.svg" alt="Search" class="api_search svg" onclick="mySearch(%b)">%s</div>
+<div id="search_results"></div>|} with_description with_description search_decription
+ |> parse
+
+(* We save parsed files in a table; this is just for speed optimization,
+ especially for make_index (18sec instead of 50sec for the whole index); it
+ can be removed. Although if we really wanted a fast make_index, we would use
+ Scanf all over the place ==> 1sec. Warning: the parsed files will be mutated
+ by processing, so one should never process the same file twice. *)
+
+let parsed_files = Hashtbl.create 50
+
+let parse_file ?(original=false) file =
+ match Hashtbl.find_opt parsed_files file with
+ | Some soup ->
+ if original then failwith (sprintf "File %s was already processed" file)
+ else soup
+ | None ->
+ let soup = read_file file |> parse in
+ Hashtbl.add parsed_files file soup;
+ soup
+
+(* Create TOC with H2 and H3 elements *)
+(* Cf Scanf for an example with H3 elements *)
+let make_toc ~version ~search file config title body =
+ let header = create_element ~id:"sidebar" "header" in
+ prepend_child body header;
+ let nav = create_element "nav" ~class_:"toc" in
+ append_child header nav;
+ let ul = create_element "ul" in
+ append_child nav ul;
+ (* Create a "li" element inside "ul" from a header "h" (h2 or h3 typically) *)
+ let li_of_h ul h =
+ let li_current = create_element "li" in
+ append_child ul li_current;
+ let () = match attribute "id" h with
+ | Some id ->
+ let href = "#" ^ id in
+ let a = create_element "a" ~inner_text:(texts h |> String.concat "")
+ ~attributes:["href", href] in
+ append_child li_current a
+ | None -> () in
+ li_current in
+
+ descendants body
+ |> elements
+ |> fold (fun (li_current, h3_current) h -> match name h with
+ | "h2" ->
+ li_of_h ul h, None
+ | "h3" -> begin match h3_current with
+ | Some h3 ->
+ li_of_h h3 h, h3_current
+ | None ->
+ let h3 = create_element "ul" in
+ append_child ul li_current;
+ append_child li_current h3;
+ li_of_h h3 h, Some h3
+ end
+ | _ -> li_current, h3_current) (create_element "li", None);
+ |> ignore;
+
+ let href = let base = Filename.basename file in
+ if String.sub base 0 5 = "type_"
+ then String.sub base 5 (String.length base - 5) else "#top" in
+ let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
+ let div = create_element ~class_:"toc_title" "div" in
+ append_child div a;
+ prepend_child nav div;
+
+ (* In case of indexlist, add it to TOC *)
+ (* This only happens for "index.html" *)
+ let () = match body $? "ul.indexlist" with
+ | Some uli ->
+ delete uli;
+ append_child ul uli;
+ unwrap uli;
+ if search then search_widget true |> prepend_child body;
+ create_element "h1" ~inner_text:
+ (sprintf "The OCaml %sAPI" config.title)
+ |> prepend_child body;
+ | None ->
+ if search then search_widget false |> prepend_child nav;
+ (* Add "general index" link to all other files *)
+ create_element "a" ~inner_text:"< General Index"
+ ~attributes:["href", "index.html"]
+ |> prepend_child nav in
+
+ (* Add version number *)
+ add_version_link nav (config.title ^ "API Version " ^ version) releases_url;
+
+ (* Add sidebar button for mobile navigation *)
+ add_sidebar_button body;
+
+ (* Add logo *)
+ prepend_child header (logo_html
+ ((if config.title = "" then "" else "../") ^
+ (manual_page_url ^ "/index.html")))
+
+
+let process ?(search=true) ~version config file out =
+
+ dbg "Processing %s..." file;
+ let soup = parse_file ~original:true file in
+
+ (* Add javascript and favicon *)
+ update_head ~search soup;
+
+ (* Add api wrapper *)
+ let body = wrap_body ~classes:["api"] soup in
+
+ (* Delete previous/up/next links *)
+ body $? "div.navbar"
+ |> Option.iter delete;
+
+ (* Add left sidebar with TOC *)
+ let title = soup $ "title" |> R.leaf_text in
+ make_toc ~version ~search file config title body;
+
+ dbg "Saving %s..." out;
+
+ (* Save new html file *)
+ let new_html = to_string soup in
+ write_file out new_html
+
+let process ?(overwrite=false) ~version config file out =
+ if overwrite || not (Sys.file_exists out)
+ then Ok (process ~version config file out)
+ else Error (sprintf "File %s already exists." out)
+
+let all_html_files config =
+ Sys.readdir config.src_dir |> Array.to_list
+ |> List.filter (fun s -> Filename.extension s = ".html")
+
+
+module Index = struct
+ (* Generate the index.js file for searching with the quick search widget *)
+ (* The idea is to parse the file "index_values.html" to extract, for each
+ entry of this index, the following information (list of 8 strings):
+
+ [Module name; href URL of the Module (in principle an html file); Value
+ name; href URL of the value; short description (html format); short
+ description in txt format; type signature (html format); type signature in
+ txt format]
+
+ The "txt format" versions are used for searching, the "html version" for
+ display. The signature is not in the "index_values.html" file, we have to
+ look for it by following the value href. The index_values.html file has
+ the following structure:
+
+ (...)
+
+ <table>
+
+ (...)
+
+ <tr><td><a href="List.html#VALappend">append</a> [<a
+ href="List.html">List</a>]</td> <td><div class="info"> <p>Concatenate two
+ lists.</p>
+
+ </div> </td></tr>
+
+ (...)
+
+ </table>
+
+ (...)
+
+ So we need to visit "List.html#VALappend", which has the following
+ structure:
+
+ <pre><span id="VALappend"><span class="keyword">val</span> append</span> :
+ <code class="type">'a list -> 'a list -> 'a list</code></pre>
+
+ and we finally return
+
+ ["List"; "List.html"; "rev_append"; "List.html#VALrev_append"; "<div
+ class=\"info\"> <p><code class=\"code\"><span
+ class=\"constructor\">List</span>.rev_append l1 l2</code>
+ reverses <code class=\"code\">l1</code> and concatenates it to <code
+ class=\"code\">l2</code>.</p> </div>"; "
+ List.rev_append\194\160l1\194\160l2 reverses l1 and concatenates it to
+ l2. "; "<code class=\"type\">'a list -> 'a list -> 'a list</code>";
+ "'a list -> 'a list -> 'a list"]
+
+ *)
+
+ type item =
+ { html : string; txt : string }
+
+ type entry =
+ { mdule : item;
+ value : item;
+ info : item;
+ signature : item option }
+
+ let anon_t_regexp = Re.Str.regexp "\\bt\\b"
+ let space_regexp = Re.Str.regexp " +"
+ let newline_regexp = Re.Str.regexp_string "\n"
+
+ (* Remove "\n" and superfluous spaces in string *)
+ let one_line s =
+ Re.Str.global_replace newline_regexp " " s
+ |> Re.Str.global_replace space_regexp " "
+ |> String.trim
+
+ (* Look for signature (with and without html formatting);
+ [id] is the HTML id of the value. Example:
+ # get_sig ~id_name:"VALfloat_of_int" "Stdlib.html";;
+ Looking for signature for VALfloat_of_int in Stdlib.html
+ Signature=[int -> float]
+ - : (string * string) option =
+ Some ("<code class=\\\"type\\\">int -> float</code>", "int -> float")
+ *)
+ let get_sig ?mod_name ~id_name config file =
+ dbg "Looking for signature for %s in %s" id_name file;
+ let soup = parse_file (config.src_dir // file) in
+ (* Now we jump to the html element with id=id_name. Warning, we cannot use
+ the CSS "#id" syntax for searching the id -- like in: soup $ ("#" ^ id)
+ -- because it can have problematic chars like id="VAL( * )" *)
+ let span = soup $$ "pre span"
+ |> filter (fun s -> id s = Some id_name)
+ |> first |> require in
+ let pre = match parent span with
+ | None -> failwith ("Cannot find signature for " ^ id_name)
+ | Some pre -> pre in
+ let code = pre $ ".type" in
+ let sig_txt = texts code
+ |> String.concat ""
+ |> String.escaped in
+ (* We now replace anonymous "t"'s by the qualified "Module.t" *)
+ let sig_txt = match mod_name with
+ | None -> sig_txt
+ | Some mod_name ->
+ Re.Str.global_replace anon_t_regexp (mod_name ^ ".t") sig_txt in
+ dbg "Signature=[%s]" sig_txt;
+ Some {html = to_string code |> String.escaped; txt = sig_txt}
+
+ (* Example: "Buffer.html#VALadd_subbytes" ==> Some "VALadd_subbytes" *)
+ let get_id ref =
+ match String.split_on_char '#' ref with
+ | [file; id] -> Some (file, id)
+ | _ -> dbg "Could not find id for %s" ref; None
+
+ let make ?(with_sig = true) config =
+ let soup = parse_file (config.src_dir // "index_values.html") in
+ soup $ "table"
+ |> select "tr"
+ |> fold (fun index_list tr ->
+ let td_list = tr $$ "td" |> to_list in
+ match td_list with
+ (* We scan the row; it should contain 2 <td> entries, except for
+ separators with initials A,B,C,D; etc. *)
+ | [td_val; td_info] ->
+ let mdule, value = match td_val $$ ">a" |> to_list with
+ | [a_val; a_mod] ->
+ { txt = R.leaf_text a_mod; html = R.attribute "href" a_mod },
+ { txt = R.leaf_text a_val; html = R.attribute "href" a_val }
+ | _ -> failwith "Cannot parse value" in
+ let info = match td_info $? "div.info" with
+ | Some info -> { html = to_string info
+ |> one_line
+ |> String.escaped;
+ txt = texts info
+ |> String.concat ""
+ |> one_line
+ |> String.escaped }
+ | None -> { html = ""; txt = ""} in
+ let signature =
+ if with_sig then
+ get_id value.html
+ |> flat_option (fun (file,id_name) ->
+ assert (file = mdule.html);
+ get_sig config ~mod_name:mdule.txt ~id_name file)
+ else None in
+ { mdule; value; info; signature } :: index_list
+ | _ ->
+ dbg "Ignoring row:";
+ dbg "%s" (List.map to_string td_list |> String.concat " ");
+ index_list) []
+
+ let save file index =
+ let outch = open_out file in
+ output_string outch "var GENERAL_INDEX = [\n";
+ List.iter (fun item ->
+ fprintf outch {|["%s", "%s", "%s", "%s", "%s", "%s", "%s", "%s"],|}
+ item.mdule.txt item.mdule.html item.value.txt item.value.html
+ item.info.html item.info.txt
+ (Option.map (fun i -> i.html) item.signature |> string_of_opt)
+ (Option.map (fun i -> i.txt) item.signature |> string_of_opt);
+ output_string outch "\n") index;
+ output_string outch "]\n";
+ close_out outch
+
+ let process config =
+ print_endline "Creating index file, please wait...";
+ let t = Unix.gettimeofday () in
+ let index = make config in
+ dbg "Index created. Time = %f\n" (Unix.gettimeofday () -. t);
+ save (config.dst_dir // "index.js") index;
+ dbg "Index saved. Time = %f\n" (Unix.gettimeofday () -. t)
+
+end (* of Index module *)
+
+let process_html config overwrite version =
+ print_endline (sprintf "\nProcessing version %s into %s...\n" version config.dst_dir);
+ let processed = ref 0 in
+ all_html_files config
+ |> List.iter (fun file ->
+ match process config ~overwrite ~version
+ (config.src_dir // file)
+ (config.dst_dir // file) with
+ | Ok () -> incr processed
+ | Error s -> dbg "%s" s
+ );
+ sprintf "Version %s, HTML processing done: %u files have been processed."
+ version !processed |> print_endline
+
+let copy_files config =
+ let ind = config.dst_dir // "index.js" in
+ if not (Sys.file_exists ind) then Index.process config
+
+(******************************************************************************)
+
+let () =
+ let version = find_version () in
+ let args = Sys.argv |> Array.to_list |> List.tl in
+ let config = if List.mem "compiler" args
+ then { src_dir = html_maindir // "compilerlibref";
+ dst_dir = api_dir // "compilerlibref"; title = "Compiler "}
+ else { src_dir = html_maindir // "libref";
+ dst_dir = api_dir; title = ""} in
+ let overwrite = List.mem "overwrite" args in
+ let makeindex = List.mem "makeindex" args in
+ let makehtml = List.mem "html" args || not makeindex in
+ if makehtml then process_html config overwrite version;
+ if makeindex then Index.process config;
+ copy_files config;
+ print_endline "DONE."
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
--- /dev/null
+(* ------------ Ocaml Web-manual -------------- *)
+
+(* Copyright San Vu Ngoc, 2020
+
+ file: process_api.ml
+
+ Post-processing the HTML of the OCaml Manual.
+
+ (The "API" side is treated by process_api.ml) *)
+
+open Soup
+open Printf
+open Common
+
+(* How the main index.html page will be called: *)
+let index_title = "Home"
+
+(* Alternative formats for the manual: *)
+let archives =
+ ["refman-html.tar.gz"; "refman.txt"; "refman.pdf"; "refman.info.tar.gz"]
+
+let preg_anyspace =
+ String.concat "\\|"
+ ["\u{00a0}"; (* NO-BREAK SPACE *)
+ "\u{2000}"; (* EN QUAD *)
+ "\u{2001}"; (* EM QUAD *)
+ "\u{2002}"; (* EN SPACE *)
+ "\u{2003}"; (* EM SPACE *)
+ "\u{2004}"; (* THREE-PER-EM SPACE *)
+ "\u{2005}"; (* FOUR-PER-EM SPACE *)
+ "\u{2006}"; (* SIX-PER-EM SPACE *)
+ "\u{2007}"; (* FIGURE SPACE *)
+ "\u{2008}"; (* PUNCTUATION SPACE *)
+ "\u{2009}"; (* THIN SPACE *)
+ "\u{200a}"; (* HAIR SPACE *)
+ "\u{202f}"; (* NARROW NO-BREAK SPACE *)
+ ]
+ |> sprintf "\\(%s\\)+"
+
+(* WARNING these are sensitive to Hevea fluctuations: *)
+(* "long" space is either " " (hevea 2.32) or "\u{2003}" (hevea 2.35) *)
+let preg_emspace = "\\(\u{2003}\\| \\)"
+(* What hevea inserts between "Chapter" and the chapter number: *)
+let preg_chapter_space = "\\(\u{2004}\u{200d}\\|" ^ preg_anyspace ^ "\\)"
+let writtenby_css = "span.font-it" (* "span.c009" for hevea 2.32 *)
+
+(* Remove number: "Chapter 1 The core language" ==> "The core language" *)
+let remove_number s =
+ Re.Str.(global_replace (regexp (".+" ^ preg_emspace)) "" s)
+
+let toc_get_title li =
+ let a = li $ "a[href]" in
+ let title = trimmed_texts a |> String.concat " "
+ |> remove_number in
+ let file = R.attribute "href" a
+ |> String.split_on_char '#'
+ |> List.hd in
+ file, title
+
+let register_toc_entry toc_table name li =
+ let file, title = toc_get_title li in
+ dbg "%s : %s" name title;
+ if not (Hashtbl.mem toc_table file)
+ then begin
+ Hashtbl.add toc_table file title;
+ dbg "Registering %s => %s" file title
+ end;
+ file, title
+
+(* Scan manual001.html and return two things:
+ 1. [toc_table]: a table with (file ==> title)
+ 2. [all_chapters]: the list of parts: (part_title, chapters), where
+ chapters is a list of (title, file) *)
+let parse_toc () =
+ let toc_table = Hashtbl.create 50 in
+ Hashtbl.add toc_table "manual001.html" "Contents";
+ Hashtbl.add toc_table "foreword.html" "Foreword";
+ Hashtbl.add toc_table "manual071.html" "Keywords";
+
+ let soup = read_file (html_file "manual001.html") |> parse in
+ let toc = soup $ "ul.toc" in
+ let all_chapters =
+ toc $$ ">li.li-toc" (* Parts *)
+ |> fold (fun all_chapters li ->
+ let _file, title = toc_get_title li in
+ dbg "Part: %s " title;
+ let chapters =
+ li $$ ">ul >li.li-toc" (* Chapters *)
+ |> fold (fun chapters li ->
+ let file, title = register_toc_entry toc_table " Chapters" li in
+ li $$ ">ul >li.li-toc" (* Sections *)
+ |> iter (ignore << (register_toc_entry toc_table " Section"));
+ (file,title) :: chapters) []
+ |> List.rev in
+ if chapters = [] then all_chapters
+ else (title, chapters) :: all_chapters) [] in
+ toc_table, all_chapters
+
+(* This string is updated by [extract_date] *)
+let copyright_text = ref "Copyright © 2020 Institut National de Recherche en Informatique et en Automatique"
+
+let copyright () =
+ "<div class=\"copyright\">" ^ !copyright_text ^ "</div>"
+ |> parse
+
+
+(* New UTF8 space chars have been introduced in Hevea 2.35. In Hevea 2.32, only
+ html nb_spaces " " were used. With 2.35 we have
+ 'Chapter\u2004\u200d2\u2003The module system'. The \u200d is Zero Width
+ Joiner and should probably not be used here, see
+ https://github.com/maranget/hevea/pull/61 *)
+
+let reg_chapter = Re.Str.regexp
+ ("Chapter" ^ preg_chapter_space ^ "\\([0-9]+\\)" ^ preg_anyspace)
+
+let load_html file =
+ dbg "%s" file;
+ (* First we perform some direct find/replace in the html string. *)
+ let html =
+ read_file (html_file file)
+ (* Normalize non-break spaces to the utf8 \u00A0: *)
+ |> Re.Str.(global_replace (regexp_string " ") " ")
+ |> Re.Str.(global_replace reg_chapter)
+ (if file = "index.html" then {|<span class="number">\3.</span>|}
+ else {|<span class="number">Chapter \3</span>|})
+
+ (* I think it would be good to replace "chapter" by "tutorial" for part
+ I. The problem of course is how we number chapters in the other parts. *)
+
+ (* |> Re.Str.global_replace (Re.Str.regexp_string "chapter") "tutorial"
+ * |> Re.Str.global_replace (Re.Str.regexp_string "Chapter") "Tutorial" *)
+
+ (* Remove the chapter number in local links, it makes the TOC unnecessarily
+ unfriendly. *)
+ |> Re.Str.(global_replace
+ (regexp (">[0-9]+\\.\\([0-9]+\\)" ^ preg_anyspace)))
+ {|><span class="number">\1</span>|}
+ |> Re.Str.(global_replace
+ (regexp ("[0-9]+\\.\\([0-9]+\\(\\.[0-9]+\\)+\\)" ^ preg_anyspace)))
+ {|<span class="number">\1</span>|}
+
+ (* The API (libref and compilerlibref directories) should be separate
+ entities, to better distinguish them from the manual. *)
+ |> Re.Str.(global_replace (regexp_string "\"libref/"))
+ (sprintf "\"%s/" api_page_url)
+ |> Re.Str.(global_replace (regexp_string "\"compilerlibref/")
+ (sprintf "\"%s/compilerlibref/" api_page_url))
+ in
+
+ (* For the main index file, we do a few adjustments *)
+ let html = if file = "index.html"
+ then Re.Str.(global_replace
+ (regexp ("Part" ^ preg_chapter_space ^ "\\([I|V]+\\)<br>\n"))
+ {|<span class="number">\3.</span>|} html)
+ else html in
+
+ (* Set utf8 encoding directly in the html string *)
+ let charset_regexp = Re.Str.regexp "charset=\\([-A-Za-z0-9]+\\)\\(\\b\\|;\\)" in
+ match Re.Str.search_forward charset_regexp html 0 with
+ | exception Not_found -> dbg "Warning, no charset found in html."; html
+ | _ -> match (String.lowercase_ascii (Re.Str.matched_group 1 html)) with
+ | "utf-8" -> dbg "Charset is UTF-8; good."; html
+ | "us-ascii" -> dbg "Charset is US-ASCII. We change it to UTF-8";
+ Re.Str.global_replace charset_regexp "charset=UTF-8\\2" html
+ | _ -> dbg "Warning, charset not recognized."; html
+
+(* Save new html file *)
+let save_to_file soup file =
+ let new_html = to_string soup in
+ write_file (docs_file file) new_html
+
+(* Find title associated with file *)
+let file_title file toc =
+ if file = "index.html" then Some index_title
+ else Hashtbl.find_opt toc file
+
+(* Replace the images of one of the "previous, next, up" link by the title of
+ the reference. *)
+let nav_replace_img_by_text toc alt a img =
+ let file = R.attribute "href" a in
+ let title = match file_title file toc with
+ | Some f -> begin match alt with
+ | "Previous" -> "« " ^ f
+ | "Next" -> f ^ " »"
+ | "Up" -> f
+ | _ -> failwith "This should not happen"
+ end
+ | None -> dbg "Unknown title for file %s" file; file in
+ let txt = create_text title in
+ replace img txt;
+ add_class (String.lowercase_ascii alt) a
+
+(* Replace three links "Previous, Up, Next" at the end of the file by more
+ useful titles, and insert then in a div container, keeping only 2 of them:
+ either (previous, next) or (previous, up) or (up, next). Remove them at the
+ top of the file, where they are not needed because we have the TOC. *)
+let update_navigation soup toc =
+ Option.iter delete (soup $? "hr");
+ let links =
+ ["Previous"; "Up"; "Next"]
+ |> List.map (fun alt -> alt, to_list (soup $$ ("img[alt=\"" ^ alt ^ "\"]")))
+ (* In principle [imgs] will contain either 0 or 2 elements. *)
+ |> List.filter (fun (_alt, imgs) -> List.length imgs = 2)
+ (* We delete the first link, and replace image by text *)
+ |> List.map (fun (alt, imgs) ->
+ delete (R.parent (List.hd imgs));
+ let img = List.hd (List.rev imgs) in
+ let a = R.parent img in
+ nav_replace_img_by_text toc alt a img;
+ a) in
+ if links <> [] then begin
+ (* We keep only 2 links: first and last *)
+ let a1, a2 = match links with
+ | [prev;up;next] -> delete up; (prev, next)
+ | [a;b] -> (a,b)
+ | _ -> failwith "Navigation link should have at least 2 elements" in
+ add_class "previous" a1;
+ add_class "next" a2;
+ (* some elements can have both previous and up classes, for instance. This
+ helps css styling. *)
+ let container = create_element ~class_:"bottom-navigation" "div" in
+ wrap a1 container;
+ append_child container a2
+ end
+
+
+(* extract the cut point (just after title) and the header of soup:
+ "insert_xfile_content" needs them to insert external files after the cut point,
+ and include the TOC. *)
+let make_template soup =
+ let header = soup $ "header" in
+ let title = match soup $? "div.maintitle" with
+ | Some div -> div (* This is the case for "index.html" *)
+ | None -> soup $ "h1" in
+ title, header
+
+(* Create a new file by keeping only the head/headers parts of "soup", deleting
+ everything after the title, and inserting the content of external file (hence
+ preserving TOC and headers) (WARNING: this mutates soup) *)
+let insert_xfile_content soup (title, header) toc xfile =
+ let xternal = parse (load_html xfile) in
+ update_navigation xternal toc;
+ Option.iter delete (xternal $? "hr");
+ let xbody = xternal $ "body" in
+ insert_after title xbody;
+ create_element ~id:"start-section" "a"
+ |> insert_after title;
+ insert_after title header;
+ next_siblings xbody
+ |> iter delete;
+ insert_after xbody (copyright ());
+ set_name "section" xbody;
+ set_attribute "id" "section" xbody;
+ save_to_file soup xfile
+
+(* Extract the date (and copyright) from the maintitle block in "index.html" *)
+let extract_date maintitle =
+ let months = ["January"; "February"; "March"; "April";
+ "May"; "June"; "July"; "August"; "September";
+ "October"; "November"; "December"] in
+ let txts = texts maintitle
+ |> List.map String.trim in
+ copyright_text := List.hd (List.rev txts);
+ txts
+ |> List.filter (fun s -> List.exists (fun month -> starts_with month s) months)
+ |> function | [s] -> Some s
+ | _ -> dbg "Warning, date not found"; None
+
+(* Special treatment of the main index.html file *)
+let convert_index version soup =
+ (* Remove "translated from LaTeX" *)
+ soup $$ "blockquote" |> last |> Option.iter delete;
+ let title_selector = if float_of_string version < 4.07
+ then "div.center" else "div.maintitle" in
+ let maintitle = soup $ title_selector in
+ sprintf "<div class=\"maintitle\"><h1><span>The OCaml system</span> release %s </h1><h3>%s</h3></div>"
+ version (extract_date maintitle |> string_of_opt)
+ |> parse
+ |> insert_after maintitle ;
+ delete maintitle;
+ let body = soup $ ".index" in
+ {|<span class="authors">Xavier Leroy,<br> Damien Doligez, Alain Frisch, Jacques Garrigue, Didier Rémy and Jérôme Vouillon</span>|}
+ |> parse
+ |> append_child body
+
+let change_title title soup =
+ let title_tag = soup $ "title" in
+ let new_title = create_element "title" ~inner_text:("OCaml - " ^ title) in
+ replace title_tag new_title
+
+(* Create left sidebar for TOC. *)
+let make_toc_sidebar ~version ~title file body =
+ let toc = match body $? "ul" with
+ | None -> None (* can be None, eg chapters 15,19...*)
+ | Some t -> if classes t <> [] (* as in libthreads.html or parsing.html *)
+ then (dbg "We don't promote <UL> to TOC for file %s" file; None)
+ else Some t in
+
+ let () = match body $? "h2.section", toc with
+ | None, Some toc ->
+ (* If file has "no content" (sections), we clone the toc to leave it in
+ the main content. This applies to "index.html" as well. *)
+ let original_toc = parse (to_string toc) in
+ original_toc $ "ul"
+ |> add_class "ul-content";
+ insert_after toc original_toc
+ | _ -> () in
+
+ let nav = create_element "nav" ~class_:"toc" in
+ let () = match toc with
+ | None -> prepend_child body nav
+ | Some toc -> wrap toc nav in
+ let nav = body $ "nav" in
+ wrap nav (create_element ~id:"sidebar" "header");
+ begin match toc with
+ | None -> dbg "No TOC for %s" file
+ | Some toc -> begin
+ (* TOC - Create a title entry in the menu *)
+ let a = create_element "a" ~inner_text:title
+ ~attributes:["href", "#"] in
+ let li = create_element "li" ~class_:"top" in
+ append_child li a;
+ prepend_child toc li;
+
+ (* index of keywords *)
+ if file = "index.html"
+ then begin
+ let keywords =
+ body $$ "ul"
+ |> fold (fun key ul ->
+ match key with
+ | None -> begin
+ match ul $$ "li" |> last with
+ | None -> None
+ | Some l -> begin match l $ "a" |> leaf_text with
+ | Some text -> dbg "[%s]" text;
+ if text = "Index of keywords"
+ then l $ "a" |> attribute "href" else None
+ | None -> None
+ end
+ end
+ | _ -> key) None in
+ begin match keywords with
+ | None -> dbg "Could not find Index of keywords"
+ | Some keywords ->
+ let a = create_element "a" ~inner_text:"Index of keywords"
+ ~attributes:["href", keywords] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li)
+ end;
+ (* Link to APIs *)
+ let a = create_element "a" ~inner_text:"OCaml API"
+ ~attributes:["href", api_page_url ^ "/index.html"] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li);
+ let a = create_element "a" ~inner_text:"OCaml Compiler API"
+ ~attributes:["href", api_page_url ^ "/compilerlibref/index.html"] in
+ let li = create_element "li" in
+ (append_child li a;
+ append_child toc li)
+ end
+ end
+ end;
+
+ (* Add back link to "OCaml Manual" *)
+ if file <> "index.html" then begin
+ let toc_title = create_element "div" ~class_:"toc_title" in
+ let a = create_element "a" ~inner_text:"< The OCaml Manual"
+ ~attributes:["href", "index.html"] in
+ append_child toc_title a;
+ prepend_child nav toc_title
+ end;
+
+ (* Add version number *)
+ let version_text = if file = "index.html" then "Select another version"
+ else "Version " ^ version in
+ add_version_link nav version_text releases_url;
+ toc
+
+ (* Create menu for all chapters in the part *)
+let make_part_menu ~part_title chapters file body =
+ let menu = create_element "ul" ~id:"part-menu" in
+ List.iter (fun (href, title) ->
+ let a = create_element "a" ~inner_text:title ~attributes:["href", href] in
+ let li = if href = file
+ then create_element "li" ~class_:"active"
+ else create_element "li" in
+ append_child li a;
+ append_child menu li) chapters;
+ prepend_child body menu;
+
+ (* Add part_title just before the part-menu *)
+ if part_title <> "" then begin
+ let nav = create_element ~id:"part-title" "nav" ~inner_text:part_title in
+ create_element "span" ~inner_text:"☰"
+ |> prepend_child nav;
+ prepend_child body nav
+ end
+
+(* Add logo *)
+let add_logo file soup =
+ match soup $? "header" with
+ | None -> dbg "Warning: no <header> for %s" file
+ | Some header -> prepend_child header (logo_html "https://ocaml.org/")
+
+(* Move authors to the end *)
+let move_authors body =
+ body $? writtenby_css
+ |> Option.iter (fun authors ->
+ match leaf_text authors with
+ | None -> ()
+ | Some s ->
+ match Re.Str.(search_forward (regexp "(.+written by.+)") s 0) with
+ | exception Not_found -> ()
+ | _ ->
+ dbg "Moving authors";
+ delete authors;
+ add_class "authors" authors;
+ append_child body authors)
+
+(* Get the list of external files linked by the current file *)
+let get_xfiles = function
+ | None -> []
+ | Some toc ->
+ toc $$ "li"
+ |> fold (fun list li ->
+ let rf = li $ "a" |> R.attribute "href" in
+ dbg "TOC reference = %s" rf;
+ if not (String.contains rf '#') &&
+ not (starts_with ".." rf) &&
+ not (starts_with "http" rf)
+ then begin
+ li $ "a" |> set_attribute "href" (rf ^ "#start-section");
+ rf::list
+ end else list) []
+
+(* This is the main script for processing a specified file. [convert] has to be
+ run for each "entry" [file] of the manual, making a "Chapter". (The list of
+ [chapters] corresponds to a "Part" of the manual.) *)
+let convert version (part_title, chapters) toc_table (file, title) =
+ dbg "%s ==> %s" (html_file file) (docs_file file);
+
+ (* Parse html *)
+ let soup = parse (load_html file) in
+
+ (* Change title, add javascript and favicon *)
+ change_title title soup;
+ update_head soup;
+
+ (* Wrap body. *)
+ let c = if file = "index.html" then ["manual"; "content"; "index"]
+ else ["manual"; "content"] in
+ let body = wrap_body ~classes:c soup in
+
+ if file = "index.html" then convert_index version soup;
+
+ (* Make sidebar *)
+ let toc = make_toc_sidebar ~version ~title file body in
+
+ (* Make top menu for chapters *)
+ make_part_menu ~part_title chapters file body;
+
+ (* Add side-bar button before part_title *)
+ add_sidebar_button body;
+
+ (* Add logo *)
+ add_logo file soup;
+
+ (* Move authors to the end *)
+ move_authors body;
+
+ (* Bottom navigation links *)
+ update_navigation soup toc_table;
+
+ (* Add copyright *)
+ append_child body (copyright ());
+
+ (* Save html *)
+ save_to_file soup file;
+
+ (* Finally, generate external files to be converted (this should be done at
+ the end because it deeply mutates the original soup) *)
+ let xfiles = get_xfiles toc in
+ let template = make_template soup in
+ List.iter (insert_xfile_content soup template toc_table) xfiles
+
+
+(* Completely process the given version of the manual. Returns the names of the
+ main html files. *)
+let process version =
+ print_endline (sprintf "\nProcessing version %s into %s...\n" version docs_maindir);
+
+ dbg "Current directory is: %s" (Sys.getcwd ());
+
+ dbg "* Scanning index";
+ let toc_table, all_chapters = parse_toc () in
+
+ (* special case of the "index.html" file: *)
+ convert version ("", []) toc_table ("index.html", "The OCaml Manual");
+
+ let main_files = List.fold_left (fun list (part_title, chapters) ->
+ dbg "* Processing chapters for %s" part_title;
+ List.iter (convert version (part_title, chapters) toc_table) chapters;
+ (fst (List.hd chapters)) :: list) [] all_chapters in
+
+ main_files
+
+(******************************************************************************)
+
+let () =
+ let _list = process (find_version ()) in
+ print_endline "DONE."
+
+(*
+ Local Variables:
+ compile-command:"dune build"
+ End:
+*)
--- /dev/null
+*.html
+*.haux
+*.hind
+compilerlibref
+libref
+manual.hmanual
+manual.hmanual.kwd
+manual.css
+odoc.css
+highlight.pack.js
+*.htoc
+*.svg
--- /dev/null
+<?xml version="1.0" standalone="no"?>
+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
+<svg xmlns="http://www.w3.org/2000/svg">
+<defs >
+<font id="FiraSans" horiz-adv-x="558" ><font-face
+ font-family="Fira Sans"
+ units-per-em="1000"
+ panose-1="2 11 5 3 5 0 0 2 0 4"
+ ascent="935"
+ descent="-265"
+ alphabetic="0" />
+<glyph unicode=" " glyph-name="space" horiz-adv-x="265" />
+<glyph unicode="!" glyph-name="exclam" horiz-adv-x="241" d="M170 689L160 230H79L68 689H170ZM150 127T170 107T190 58Q190 29 170 9T120 -12Q91 -12 71 8T51 58Q51 87 71 107T120 127Q150 127 170 107Z" />
+<glyph unicode=""" glyph-name="quotedbl" horiz-adv-x="399" d="M75 427L60 689H159L144 427H75ZM255 427L240 689H339L324 427H255Z" />
+<glyph unicode="#" glyph-name="numbersign" horiz-adv-x="518" d="M503 447H427L399 232H466V163H389L368 0H290L311 163H157L136 0H58L79 163H15V232H89L117 447H52V517H126L146 669H224L204 517H358L378 669H456L436 517H503V447ZM321 232L349 447H195L167 232H321Z" />
+<glyph unicode="$" glyph-name="dollar" horiz-adv-x="531" d="M491 110T443 58T310 -8V-155H230V-11Q107 -5 25 75L79 134Q151 64 251 64Q314 64 354 95T395 183Q395 216 383 238T339 277T250 312Q147 344 100 387T52 505Q52 575 101 622T230 678V824H310V677Q358
+672 396 654T470 602L417 544Q383 576 347 590T267 604Q214 604 181 580T147 509Q147 480 159 461T202 425T293 389Q356 370 398 347T465 285T491 186Q491 110 443 58Z" />
+<glyph unicode="%" glyph-name="percent" horiz-adv-x="826" d="M613 711L677 669L214 -31L150 11L613 711ZM279 679T324 633T370 510Q370 433 325 387T207 341Q136 341 91 387T45 510Q45 587 90 633T207 679Q279 679 324 633ZM163 617T145 587T126 510Q126 464
+144 434T207 403Q288 403 288 510Q288 556 270 586T207 617Q163 617 145 587ZM691 326T736 280T781 157Q781 80 736 34T619 -12Q547 -12 502 34T456 157Q456 234 501 280T619 326Q691 326 736 280ZM575 263T557 234T538 157Q538 111 556 81T619 50Q700 50 700 157Q700
+203 682 233T619 263Q575 263 557 234Z" />
+<glyph unicode="&" glyph-name="ampersand" horiz-adv-x="729" d="M356 701T397 682T462 627T485 549Q485 490 448 448T344 366L520 200Q560 281 580 369L666 344Q631 228 577 147L689 42L623 -12L526 82Q483 35 429 12T305 -12Q239 -12 189 11T110 76T81
+175Q81 237 116 283T220 374Q170 422 147 460T123 546Q123 614 170 657T302 701Q356 701 397 682ZM261 633T237 609T213 547Q213 511 232 483T292 415Q343 446 369 476T395 544Q395 586 370 609T303 633Q261 633 237 609ZM223 291T199 257T175 178Q175 123 213
+92T315 61Q362 61 400 79T473 133L273 324Q223 291 199 257Z" />
+<glyph unicode="'" glyph-name="quotesingle" horiz-adv-x="219" d="M75 427L60 689H159L144 427H75Z" />
+<glyph unicode="(" glyph-name="parenleft" horiz-adv-x="324" d="M284 805Q232 728 202 668T154 530T136 350Q136 248 153 171T201 33T284 -105L226 -145Q160 -51 125 9T65 154T40 350Q40 461 64 545T124 690T226 845L284 805Z" />
+<glyph unicode=")" glyph-name="parenright" horiz-adv-x="324" d="M164 751T199 691T259 546T284 350Q284 239 260 155T200 10T98 -145L40 -105Q92 -29 122 32T170 171T188 350Q188 453 171 530T123 667T40 805L98 845Q164 751 199 691Z" />
+<glyph unicode="*" glyph-name="asterisk" horiz-adv-x="439" d="M419 561L266 528L370 412L298 359L219 493L141 359L69 411L172 528L20 561L47 643L189 582L174 739H264L249 581L391 644L419 561Z" />
+<glyph unicode="+" glyph-name="plus" horiz-adv-x="499" d="M291 519V369H437V293H291V144H207V293H62V369H207V519H291Z" />
+<glyph unicode="," glyph-name="comma" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 27 171 -13L104 -166H38L78 0Q65 10 58 25T50 58Q50 87 70 107T119 127Q149 127 169 107Z" />
+<glyph unicode="-" glyph-name="hyphen" horiz-adv-x="403" d="M60 274V352H343V274H60Z" />
+<glyph unicode="." glyph-name="period" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 29 169 9T119 -12Q90 -12 70 8T50 58Q50 87 70 107T119 127Q149 127 169 107Z" />
+<glyph unicode="/" glyph-name="slash" horiz-adv-x="520" d="M337 807L415 789L184 -104L105 -85L337 807Z" />
+<glyph unicode="0" glyph-name="zero" d="M390 679T446 591T503 334Q503 166 447 77T279 -12Q168 -12 112 77T55 334Q55 502 111 590T279 679Q390 679 446 591ZM214 606T183 542T151 334Q151 190 182 126T279 61Q343 61 375 125T407 334Q407 477 375 541T279 606Q214
+606 183 542Z" />
+<glyph unicode="1" glyph-name="one" horiz-adv-x="433" d="M323 669V0H231V571L75 476L35 541L242 669H323Z" />
+<glyph unicode="2" glyph-name="two" horiz-adv-x="495" d="M288 679T333 655T404 590T429 496Q429 435 402 379T317 258T144 77H445L434 0H39V73Q173 212 229 276T309 389T333 492Q333 544 303 573T223 603Q182 603 151 586T85 530L25 578Q66 629 116 654T228
+679Q288 679 333 655Z" />
+<glyph unicode="3" glyph-name="three" horiz-adv-x="499" d="M287 679T331 656T399 594T423 509Q423 448 388 409T293 355Q360 349 402 307T444 193Q444 135 416 88T336 15T216 -12Q155 -12 104 10T15 78L70 129Q103 95 137 79T213 63Q276 63 312 98T348 194Q348
+260 314 287T215 314H165L176 385H210Q262 385 296 416T331 503Q331 550 301 577T220 605Q181 605 149 591T82 545L34 600Q119 679 225 679Q287 679 331 656Z" />
+<glyph unicode="4" glyph-name="four" horiz-adv-x="532" d="M502 238V165H415V0H326V165H40V231L241 679L318 647L137 238H327L335 418H415V238H502Z" />
+<glyph unicode="5" glyph-name="five" horiz-adv-x="501" d="M420 597H159V400Q210 426 266 426Q352 426 404 370T456 214Q456 148 427 97T346 17T224 -12Q163 -12 115 9T26 73L80 126Q112 94 146 79T223 63Q287 63 323 103T360 216Q360 289 327 322T238 355Q212
+355 190 350T143 332H71V669H433L420 597Z" />
+<glyph unicode="6" glyph-name="six" horiz-adv-x="533" d="M359 440T401 416T468 344T493 227Q493 156 465 102T388 18T280 -12Q163 -12 109 74T55 314Q55 423 85 505T173 633T308 679Q384 679 446 638L410 577Q363 606 307 606Q235 606 193 537T147 352Q209
+440 308 440Q359 440 401 416ZM338 61T369 105T400 224Q400 367 292 367Q248 367 211 343T148 275Q151 165 182 113T280 61Q338 61 369 105Z" />
+<glyph unicode="7" glyph-name="seven" horiz-adv-x="444" d="M414 669V600L164 -10L80 18L321 594H25V669H414Z" />
+<glyph unicode="8" glyph-name="eight" horiz-adv-x="551" d="M506 302T506 179Q506 124 477 81T394 13T274 -12Q206 -12 154 12T74 79T45 177Q45 239 78 281T177 351Q124 378 99 416T73 507Q73 561 101 600T176 659T276 679Q328 679 374 660T450 603T479 510Q479
+460 451 424T365 359Q506 302 506 179ZM224 610T194 583T163 506Q163 458 192 433T287 387L304 381Q349 407 369 436T389 507Q389 554 360 582T276 610Q224 610 194 583ZM337 61T373 93T410 178Q410 214 396 238T351 281T264 319L239 328Q189 304 165 268T141 177Q141
+122 177 92T275 61Q337 61 373 93Z" />
+<glyph unicode="9" glyph-name="nine" horiz-adv-x="525" d="M365 679T420 610T475 419Q475 282 438 199T325 66T119 -22L98 47Q232 85 303 150T380 323Q357 287 318 265T230 243Q178 243 136 269T70 344T45 458Q45 526 74 576T151 652T259 679Q365 679 420 610ZM328
+315T382 398Q384 509 355 557T261 606Q202 606 170 567T138 456Q138 386 168 351T249 315Q328 315 382 398Z" />
+<glyph unicode=":" glyph-name="colon" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 29 169 9T119 -12Q90 -12 70 8T50 58Q50 87 70 107T119 127Q149 127 169 107ZM149 495T169 475T189 426Q189 397 169 377T119 356Q90 356 70 376T50 426Q50 455 70 475T119
+495Q149 495 169 475Z" />
+<glyph unicode=";" glyph-name="semicolon" horiz-adv-x="240" d="M149 127T169 107T189 58Q189 27 171 -13L104 -166H38L78 0Q65 10 58 25T50 58Q50 87 70 107T119 127Q149 127 169 107ZM149 495T169 475T189 426Q189 397 169 377T119 356Q90 356 70 376T50 426Q50
+455 70 475T119 495Q149 495 169 475Z" />
+<glyph unicode="<" glyph-name="less" horiz-adv-x="500" d="M417 551L450 475L123 333L450 189L417 115L50 286V380L417 551Z" />
+<glyph unicode="=" glyph-name="equal" horiz-adv-x="500" d="M62 389V466H438V389H62ZM62 452V529H438V452H62Z" />
+<glyph unicode=">" glyph-name="greater" horiz-adv-x="500" d="M83 551L450 380V286L83 115L50 189L377 333L50 475L83 551Z" />
+<glyph unicode="?" glyph-name="question" horiz-adv-x="459" d="M298 701T341 680T407 622T429 545Q429 506 416 479T383 434T332 394Q290 365 269 341T248 275V230H157V280Q157 323 171 353T206 401T259 442Q297 467 315 487T333 539Q333 580 306 602T232 625Q152
+625 93 553L30 602Q114 701 238 701Q298 701 341 680ZM235 127T255 107T275 58Q275 29 255 9T205 -12Q176 -12 156 8T136 58Q136 87 156 107T205 127Q235 127 255 107Z" />
+<glyph unicode="@" glyph-name="at" horiz-adv-x="1020" d="M660 701T756 648T901 504T950 307Q950 177 900 93T753 9Q697 9 666 40T625 112Q606 68 571 40T481 11Q401 11 355 71T308 231Q308 357 368 424T526 492Q568 492 605 483T683 452V193Q683 131 700 106T751
+80Q857 80 857 305Q857 402 819 474T707 585T526 625Q416 625 334 576T207 439T163 240Q163 129 205 44T330 -89T526 -137Q621 -137 718 -103L743 -174Q687 -194 638 -203T525 -213Q391 -213 288 -158T128 1T70 240Q70 370 127 475T289 640T526 701Q660 701 756
+648ZM567 78T600 164V411Q567 426 529 426Q398 426 398 231Q398 156 422 117T492 78Q567 78 600 164Z" />
+<glyph unicode="A" glyph-name="A" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250Z" />
+<glyph unicode="B" glyph-name="B" horiz-adv-x="608" d="M475 352T519 314T563 196Q563 0 290 0H100V689H263Q394 689 463 646T533 515Q533 455 496 415T404 364Q475 352 519 314ZM195 614V397H299Q359 397 397 426T436 508Q436 568 396 591T273 614H195ZM374
+76T418 101T463 196Q463 264 420 294T308 324H195V76H290Q374 76 418 101Z" />
+<glyph unicode="C" glyph-name="C" horiz-adv-x="560" d="M403 701T445 685T532 633L480 572Q417 623 347 623Q261 623 209 557T156 345Q156 203 208 136T346 68Q390 68 423 83T493 125L540 65Q508 32 458 10T343 -12Q259 -12 194 29T92 151T55 345Q55 458 93
+538T196 660T341 701Q403 701 445 685Z" />
+<glyph unicode="D" glyph-name="D" horiz-adv-x="644" d="M400 689T494 617T589 348Q589 157 495 79T265 0H100V689H244Q400 689 494 617ZM195 613V75H272Q368 75 428 134T488 348Q488 457 457 515T378 593T265 613H195Z" />
+<glyph unicode="E" glyph-name="E" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473Z" />
+<glyph unicode="F" glyph-name="F" horiz-adv-x="491" d="M100 0V689H466L455 613H195V378H420V303H195V0H100Z" />
+<glyph unicode="G" glyph-name="G" horiz-adv-x="631" d="M419 701T466 683T561 625L505 567Q468 597 434 610T354 623Q301 623 257 595T184 504T156 345Q156 200 203 133T344 66Q420 66 475 97V305H353L342 382H569V49Q462 -12 344 -12Q208 -12 132 79T55 345Q55
+457 95 537T204 659T354 701Q419 701 466 683Z" />
+<glyph unicode="H" glyph-name="H" horiz-adv-x="680" d="M485 0V323H195V0H100V689H195V401H485V689H580V0H485Z" />
+<glyph unicode="I" glyph-name="I" horiz-adv-x="295" d="M195 689V0H100V689H195Z" />
+<glyph unicode="J" glyph-name="J" horiz-adv-x="305" d="M210 96Q210 -6 166 -57T30 -137L5 -68Q51 -50 74 -29T106 22T115 100V689H210V96Z" />
+<glyph unicode="K" glyph-name="K" horiz-adv-x="589" d="M195 689V0H100V689H195ZM570 689L309 374L589 0H472L200 368L462 689H570Z" />
+<glyph unicode="L" glyph-name="L" horiz-adv-x="498" d="M195 689V83H478L467 0H100V689H195Z" />
+<glyph unicode="M" glyph-name="M" horiz-adv-x="778" d="M716 0H624L600 311Q585 494 583 592L434 78H345L188 593Q188 468 175 304L152 0H62L119 689H247L392 188L530 689H659L716 0Z" />
+<glyph unicode="N" glyph-name="N" horiz-adv-x="683" d="M583 0H456L176 585Q182 516 185 458T189 316V0H100V689H224L507 103Q504 129 499 194T494 313V689H583V0Z" />
+<glyph unicode="O" glyph-name="O" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206 133T346 66Q536
+66 536 344Q536 623 346 623Q256 623 206 555Z" />
+<glyph unicode="P" glyph-name="P" horiz-adv-x="581" d="M409 689T479 636T549 476Q549 363 476 308T282 253H195V0H100V689H281Q409 689 479 636ZM361 328T404 360T448 475Q448 549 405 582T280 615H195V328H278Q361 328 404 360Z" />
+<glyph unicode="Q" glyph-name="Q" horiz-adv-x="691" d="M534 39T579 23T666 -23L604 -103Q544 -50 490 -30T344 -10Q258 -10 193 30T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660T600 538T637 344Q637 223 597 152T479 39Q534 39 579 23ZM156
+200T206 133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555T156 343Q156 200 206 133Z" />
+<glyph unicode="R" glyph-name="R" horiz-adv-x="605" d="M302 292H195V0H100V689H281Q410 689 476 640T543 494Q543 422 506 377T394 309L580 0H467L302 292ZM291 365Q366 365 404 395T442 494Q442 558 404 586T280 615H195V365H291Z" />
+<glyph unicode="S" glyph-name="S" horiz-adv-x="545" d="M339 701T388 682T483 621L431 563Q392 594 355 608T274 623Q220 623 185 598T150 525Q150 495 162 475T206 437T301 401Q366 381 409 358T478 295T505 192Q505 132 476 86T391 14T259 -12Q116 -12 25
+77L77 135Q119 101 162 84T258 66Q322 66 364 97T406 189Q406 223 393 245T349 286T257 322Q151 354 102 399T53 521Q53 573 80 614T157 678T270 701Q339 701 388 682Z" />
+<glyph unicode="T" glyph-name="T" horiz-adv-x="517" d="M507 689L497 608H306V0H211V608H15V689H507Z" />
+<glyph unicode="U" glyph-name="U" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221Z" />
+<glyph unicode="V" glyph-name="V" horiz-adv-x="556" d="M550 689L330 0H228L6 689H108L281 103L454 689H550Z" />
+<glyph unicode="W" glyph-name="W" horiz-adv-x="826" d="M801 689L661 0H539L412 577L284 0H165L25 689H118L229 83L362 689H463L599 83L714 689H801Z" />
+<glyph unicode="X" glyph-name="X" horiz-adv-x="540" d="M325 372L535 0H427L268 305L107 0H5L212 367L23 689H131L270 430L410 689H512L325 372Z" />
+<glyph unicode="Y" glyph-name="Y" horiz-adv-x="550" d="M545 689L323 265V0H227V264L5 689H110L278 348L446 689H545Z" />
+<glyph unicode="Z" glyph-name="Z" horiz-adv-x="522" d="M477 689V612L136 81H477L466 0H30V76L374 609H66V689H477Z" />
+<glyph unicode="[" glyph-name="bracketleft" horiz-adv-x="322" d="M272 816V739H152V-40H272V-116H65V816H272Z" />
+<glyph unicode="\" glyph-name="backslash" horiz-adv-x="520" d="M183 807L415 -85L336 -104L105 789L183 807Z" />
+<glyph unicode="]" glyph-name="bracketright" horiz-adv-x="322" d="M257 816V-116H50V-40H170V739H50V816H257Z" />
+<glyph unicode="^" glyph-name="asciicircum" horiz-adv-x="540" d="M311 840L500 527H402L269 760L137 527H40L229 840H311Z" />
+<glyph unicode="_" glyph-name="underscore" horiz-adv-x="520" d="M17 -142V-63H503V-142H17Z" />
+<glyph unicode="`" glyph-name="grave" horiz-adv-x="300" d="M71 801L270 687L242 638L30 724L71 801Z" />
+<glyph unicode="a" glyph-name="a" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265 539Q358
+539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139Z" />
+<glyph unicode="b" glyph-name="b" horiz-adv-x="594" d="M426 539T479 467T532 264Q532 182 507 120T435 23T325 -12Q242 -12 185 58L176 0H95V739L187 750V461Q244 539 336 539Q426 539 479 467ZM364 61T398 110T433 264Q433 371 401 418T310 466Q240 466 187
+384V132Q208 99 238 80T303 61Q364 61 398 110Z" />
+<glyph unicode="c" glyph-name="c" horiz-adv-x="478" d="M334 539T373 526T448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291 66Q322 66 348 75T406 106L448 46Q376 -12 287 -12Q180 -12 119 60T57 259Q57 343 85 406T164
+504T287 539Q334 539 373 526Z" />
+<glyph unicode="d" glyph-name="d" horiz-adv-x="598" d="M503 739V0H422L413 73Q387 33 348 11T261 -12Q167 -12 115 62T62 261Q62 342 87 405T159 503T269 539Q350 539 411 474V750L503 739ZM323 61T353 80T411 139V397Q385 431 356 448T289 466Q228 466 195
+415T161 263Q161 161 192 111T281 61Q323 61 353 80Z" />
+<glyph unicode="e" glyph-name="e" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491 232ZM402
+306Q402 384 371 425T278 466Q165 466 155 300H402V306Z" />
+<glyph unicode="f" glyph-name="f" horiz-adv-x="335" d="M232 676T214 658T196 600V527H324L314 456H196V0H104V456H10V527H104V599Q104 667 147 708T269 750Q305 750 333 744T395 723L366 656Q321 676 274 676Q232 676 214 658Z" />
+<glyph unicode="g" glyph-name="g" horiz-adv-x="520" d="M520 503Q490 493 454 490T366 487Q459 445 459 354Q459 275 405 225T258 175Q222 175 191 185Q179 177 172 164T165 136Q165 93 234 93H318Q371 93 412 74T475 22T498 -53Q498 -130 435 -171T251 -213Q166
+-213 117 -196T46 -143T25 -53H108Q108 -85 120 -103T163 -131T251 -141Q334 -141 369 -121T405 -59Q405 -22 377 -3T299 16H216Q149 16 115 44T80 116Q80 142 95 166T138 209Q92 233 71 268T49 355Q49 408 75 450T148 515T252 539Q314 538 356 543T425 558T493
+586L520 503ZM200 473T172 441T143 355Q143 301 172 269T254 236Q308 236 336 267T365 356Q365 473 252 473Q200 473 172 441Z" />
+<glyph unicode="h" glyph-name="h" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T320 467Q279 467 247 443T187 375V0H95V738L187 748V454Q249 539 343 539Q415 539 455 496Z" />
+<glyph unicode="i" glyph-name="i" horiz-adv-x="282" d="M187 527V0H95V527H187ZM169 780T187 762T205 717Q205 690 187 673T140 655Q112 655 94 672T76 717Q76 744 94 762T140 780Q169 780 187 762Z" />
+<glyph unicode="j" glyph-name="j" horiz-adv-x="280" d="M185 32Q185 -41 167 -85T115 -156T18 -212L-9 -145Q30 -127 51 -110T82 -61T93 26V527H185V32ZM168 780T186 762T204 717Q204 690 186 673T139 655Q111 655 93 672T75 717Q75 744 93 762T139 780Q168
+780 186 762Z" />
+<glyph unicode="k" glyph-name="k" horiz-adv-x="512" d="M187 750V0H95V739L187 750ZM490 527L296 294L512 0H402L193 288L387 527H490Z" />
+<glyph unicode="l" glyph-name="l" horiz-adv-x="293" d="M149 -12T120 18T90 104V739L182 750V106Q182 84 189 74T215 64Q234 64 249 70L273 6Q240 -12 200 -12Q149 -12 120 18Z" />
+<glyph unicode="m" glyph-name="m" horiz-adv-x="857" d="M689 539T728 496T767 378V0H675V365Q675 467 601 467Q562 467 535 445T477 374V0H385V365Q385 467 311 467Q271 467 244 444T187 374V0H95V527H174L182 450Q241 539 334 539Q383 539 417 514T467 444Q498
+490 535 514T624 539Q689 539 728 496Z" />
+<glyph unicode="n" glyph-name="n" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T321 467Q279 467 247 443T187 374V0H95V527H174L182 449Q210 491 251 515T343 539Q415 539 455 496Z" />
+<glyph unicode="o" glyph-name="o" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465 293 465Q156
+465 156 263Z" />
+<glyph unicode="p" glyph-name="p" horiz-adv-x="594" d="M438 539T485 467T532 264Q532 140 478 64T325 -12Q237 -12 187 48V-202L95 -213V527H174L181 456Q210 496 251 517T337 539Q438 539 485 467ZM433 63T433 264Q433 466 314 466Q275 466 243 443T187 384V127Q207
+96 237 80T303 63Q433 63 433 264Z" />
+<glyph unicode="q" glyph-name="q" horiz-adv-x="598" d="M503 527V-213L411 -202V70Q385 31 347 10T261 -12Q167 -12 115 62T62 261Q62 342 87 405T159 503T269 539Q353 539 417 468L424 527H503ZM323 61T353 80T411 139V397Q385 431 356 448T289 466Q228 466
+195 415T161 263Q161 161 192 111T281 61Q323 61 353 80Z" />
+<glyph unicode="r" glyph-name="r" horiz-adv-x="386" d="M352 539T376 533L359 443Q335 449 313 449Q264 449 234 413T187 301V0H95V527H174L183 420Q204 479 240 509T324 539Q352 539 376 533Z" />
+<glyph unicode="s" glyph-name="s" horiz-adv-x="467" d="M292 539T335 524T417 479L378 421Q342 444 310 455T241 466Q196 466 170 448T144 397Q144 365 168 347T257 312Q345 290 388 252T432 148Q432 70 372 29T224 -12Q104 -12 25 57L74 113Q141 62 222 62Q274
+62 304 83T335 142Q335 169 324 185T286 214T207 241Q123 263 86 300T48 394Q48 435 72 468T140 520T238 539Q292 539 335 524Z" />
+<glyph unicode="t" glyph-name="t" horiz-adv-x="361" d="M361 24Q309 -12 243 -12Q176 -12 139 26T101 138V456H9V527H101V646L193 657V527H318L308 456H193V142Q193 101 207 83T256 64Q287 64 326 85L361 24Z" />
+<glyph unicode="u" glyph-name="u" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0Z" />
+<glyph unicode="v" glyph-name="v" horiz-adv-x="492" d="M482 527L303 0H192L10 527H110L248 82L385 527H482Z" />
+<glyph unicode="w" glyph-name="w" horiz-adv-x="717" d="M697 527L577 0H452L360 444L265 0H143L20 527H112L207 64L311 527H414L513 64L609 527H697Z" />
+<glyph unicode="x" glyph-name="x" horiz-adv-x="485" d="M297 282L480 0H369L240 223L109 0H5L189 278L26 527H134L244 334L355 527H459L297 282Z" />
+<glyph unicode="y" glyph-name="y" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3Z" />
+<glyph unicode="z" glyph-name="z" horiz-adv-x="437" d="M404 527V457L129 77H407L396 0H25V69L299 449H48V527H404Z" />
+<glyph unicode="{" glyph-name="braceleft" horiz-adv-x="322" d="M277 765Q226 765 204 750T182 697V458Q182 407 164 385T107 349Q147 335 164 314T182 242V3Q182 -34 204 -49T277 -65V-136Q177 -136 136 -102T95 13V235Q95 277 80 294T25 311V387Q64 387 79
+405T95 465V687Q95 767 136 801T277 836V765Z" />
+<glyph unicode="|" glyph-name="bar" horiz-adv-x="403" d="M243 807V-102H160V807H243Z" />
+<glyph unicode="}" glyph-name="braceright" horiz-adv-x="322" d="M145 836T186 802T227 687V465Q227 423 242 405T297 387V311Q258 311 243 294T227 235V13Q227 -67 186 -101T45 -136V-65Q96 -65 118 -50T140 3V242Q140 293 157 314T215 349Q176 362 158 384T140
+458V697Q140 734 118 749T45 765V836Q145 836 186 802Z" />
+<glyph unicode="~" glyph-name="asciitilde" horiz-adv-x="488" d="M290 250T269 259T217 288Q199 300 187 306T163 312Q124 312 91 258L35 287Q85 384 172 384Q200 384 221 375T270 348Q290 335 302 329T328 323Q349 323 367 336T398 371L453 341Q406 250 319
+250Q290 250 269 259Z" />
+<glyph unicode=" " glyph-name="uni00A0" horiz-adv-x="265" />
+<glyph unicode="¡" glyph-name="exclamdown" horiz-adv-x="241" d="M150 495T170 475T190 425Q190 396 170 376T121 356Q91 356 71 376T51 425Q51 454 71 474T121 495Q150 495 170 475ZM162 247L173 -202H71L81 247H162Z" />
+<glyph unicode="¢" glyph-name="cent" horiz-adv-x="478" d="M448 46Q392 1 329 -9V-154H249V-9Q159 3 108 73T57 259Q57 374 108 448T250 536V684H329V536Q394 527 448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291
+66Q322 66 348 75T406 106L448 46Z" />
+<glyph unicode="£" glyph-name="sterling" horiz-adv-x="520" d="M213 153T200 125T152 77H472L461 0H40V73Q75 86 92 100T115 138T122 205V322H56V382H122V493Q122 576 172 627T311 679Q366 679 410 659T490 596L430 550Q406 578 379 591T315 604Q266 604
+240 576T213 494V382H421V322H213V204Q213 153 200 125Z" />
+<glyph unicode="¤" glyph-name="currency" horiz-adv-x="560" d="M492 272T455 218L531 143L476 88L398 164Q345 132 278 132Q212 132 160 167L82 88L29 143L107 221Q71 274 71 341Q71 406 106 460L29 540L84 595L162 515Q211 549 278 549Q347 549 399 516L478
+595L531 540L455 463Q492 411 492 341Q492 272 455 218ZM341 205T372 241T404 342Q404 407 373 443T281 479Q222 479 191 443T159 342Q159 277 190 241T281 205Q341 205 372 241Z" />
+<glyph unicode="¥" glyph-name="yen" horiz-adv-x="536" d="M531 669L340 346H453V284H315V194H453V133H315V0H221V133H82V194H221V284H82V346H196L5 669H107L271 374L434 669H531Z" />
+<glyph unicode="¦" glyph-name="brokenbar" horiz-adv-x="403" d="M243 807V443H160V807H243ZM243 262V-102H160V262H243Z" />
+<glyph unicode="§" glyph-name="section" horiz-adv-x="533" d="M441 136T441 75Q441 8 387 -31T246 -71Q149 -71 78 -21L113 40Q143 20 175 11T249 1Q293 1 321 18T349 66Q349 90 339 105T304 133T225 163Q142 190 106 222T70 311Q70 347 90 378T147 432Q120
+450 107 474T94 533Q94 600 146 638T281 677Q378 677 452 623L417 565Q384 586 352 596T280 606Q235 606 210 589T185 540Q185 516 194 501T230 471T307 440Q390 412 426 379T463 293Q463 224 387 173Q441 136 441 75ZM159 287T178 269T254 233Q297 219 333 203Q353
+221 364 241T375 280Q375 304 366 319T335 347T267 376Q232 389 200 403Q181 384 170 363T159 323Q159 287 178 269Z" />
+<glyph unicode="¨" glyph-name="dieresis" horiz-adv-x="385" d="M112 768T128 752T145 711Q145 687 129 671T88 654Q63 654 47 670T30 711Q30 735 46 751T88 768Q112 768 128 752ZM322 768T338 752T355 711Q355 687 339 671T297 654Q273 654 257 670T240
+711Q240 735 256 751T297 768Q322 768 338 752Z" />
+<glyph unicode="©" glyph-name="copyright" horiz-adv-x="810" d="M492 748T563 708T676 596T718 434Q718 344 677 273T564 161T406 121Q320 121 248 161T134 272T92 434Q92 524 134 595T248 707T406 748Q492 748 563 708ZM334 696T277 663T186 570T153 434Q153
+358 186 299T276 207T406 174Q477 174 534 207T625 299T658 434Q658 510 625 570T535 663T406 696Q334 696 277 663ZM444 625T471 615T525 585L490 538Q452 565 412 565Q371 565 346 533T321 435Q321 372 345 340T412 308Q437 308 456 315T496 339L528 291Q476
+245 409 245Q335 245 290 295T245 435Q245 495 267 538T326 603T408 625Q444 625 471 615Z" />
+<glyph unicode="ª" glyph-name="ordfeminine" horiz-adv-x="500" d="M313 525V549Q313 588 293 604T230 620Q181 620 117 599L95 661Q173 689 245 689Q402 689 402 554V384Q402 361 410 350T435 333L416 272Q381 276 360 289T327 331Q306 301 274 286T201
+271Q138 271 102 304T65 393Q65 457 114 491T255 525H313ZM280 337T313 390V470H265Q159 470 159 398Q159 369 176 353T224 337Q280 337 313 390ZM71 77H447V0H71V77Z" />
+<glyph unicode="«" glyph-name="guillemotleft" horiz-adv-x="575" d="M230 535L285 497L150 287L285 77L230 39L55 255V318L230 535ZM465 535L520 497L385 287L520 77L465 39L290 255V318L465 535Z" />
+<glyph unicode="¬" glyph-name="logicalnot" horiz-adv-x="500" d="M438 361V141H355V284H62V361H438Z" />
+<glyph unicode="­" glyph-name="uni00AD" horiz-adv-x="403" d="M60 274V352H343V274H60Z" />
+<glyph unicode="®" glyph-name="registered" horiz-adv-x="641" d="M390 750T448 716T540 622T574 493Q574 423 541 365T449 272T319 238Q250 238 192 272T101 364T67 493Q67 563 100 622T192 715T319 750Q390 750 448 716ZM377 287T422 313T493 387T519
+493Q519 552 494 599T423 674T319 701Q263 701 218 674T148 600T122 493Q122 434 147 387T218 314T319 287Q377 287 422 313ZM428 522T410 503T363 474L437 359H370L309 465H285V359H228V635H306Q428 635 428 551Q428 522 410 503ZM285 509H315Q369 509 369 551Q369
+572 356 581T313 591H285V509Z" />
+<glyph unicode="¯" glyph-name="overscore" horiz-adv-x="333" d="M303 667H30V736H303V667Z" />
+<glyph unicode="°" glyph-name="degree" horiz-adv-x="523" d="M176 381T139 400T78 455T55 541Q55 590 78 626T138 682T219 701Q262 701 299 682T360 626T383 540Q383 491 360 455T300 400T219 381Q176 381 139 400ZM256 443T281 468T306 540Q306 587 281
+612T219 638Q182 638 157 613T132 541Q132 494 157 469T219 443Q256 443 281 468Z" />
+<glyph unicode="±" glyph-name="plusminus" horiz-adv-x="500" d="M62 0V77H438V0H62ZM292 542V392H438V316H292V167H208V316H63V392H208V542H292Z" />
+<glyph unicode="²" glyph-name="uni00B2" horiz-adv-x="400" d="M259 746T296 712T334 626Q334 592 318 561T264 489T155 384H344L336 322H67V380Q151 461 187 499T238 565T254 620Q254 650 236 667T189 684Q163 684 144 674T104 640L55 678Q110 746 195
+746Q259 746 296 712Z" />
+<glyph unicode="³" glyph-name="uni00B3" horiz-adv-x="400" d="M261 746T297 716T334 641Q334 603 311 578T248 543Q292 539 320 513T348 441Q348 386 306 350T191 313Q104 313 52 373L97 415Q135 374 187 374Q224 374 245 393T267 445Q267 481 247 496T187
+512H153L162 568H185Q217 568 237 584T257 631Q257 657 239 672T191 687Q166 687 145 678T103 650L63 694Q121 746 197 746Q261 746 297 716Z" />
+<glyph unicode="´" glyph-name="acute" horiz-adv-x="300" d="M229 801L270 724L58 638L30 687L229 801Z" />
+<glyph unicode="µ" glyph-name="uni00B5" horiz-adv-x="588" d="M487 80T513 0L427 -12Q416 14 412 33T403 85V86Q379 44 344 16T265 -12Q230 -12 208 -1T169 38Q178 10 182 -20T186 -96V-202L95 -213V527H187V156Q187 67 266 67Q346 67 395 163V527H487V180Q487
+80 513 0Z" />
+<glyph unicode="¶" glyph-name="paragraph" horiz-adv-x="734" d="M594 689V-202L511 -215V616H397V-202L314 -215V282Q201 288 146 343T90 486Q90 583 156 636T336 689H594Z" />
+<glyph unicode="·" glyph-name="middot" horiz-adv-x="240" d="M149 380T169 360T189 311Q189 282 169 262T119 241Q90 241 70 261T50 311Q50 340 70 360T119 380Q149 380 169 360Z" />
+<glyph unicode="¸" glyph-name="cedilla" horiz-adv-x="275" d="M152 -56Q200 -60 222 -83T245 -141Q245 -189 210 -215T121 -241Q93 -241 69 -235T30 -217L55 -165Q85 -181 118 -181Q141 -181 154 -172T168 -141Q168 -120 147 -110T79 -99L93 16H152V-56Z" />
+<glyph unicode="¹" glyph-name="uni00B9" horiz-adv-x="400" d="M274 739V322H197V660L99 603L65 656L205 739H274Z" />
+<glyph unicode="º" glyph-name="ordmasculine" horiz-adv-x="500" d="M343 689T393 634T444 480Q444 385 393 328T250 271Q158 271 107 327T56 480Q56 575 108 632T251 689Q343 689 393 634ZM151 620T151 480Q151 340 250 340Q349 340 349 480Q349 552 325
+586T251 620Q151 620 151 480ZM62 0V77H438V0H62Z" />
+<glyph unicode="»" glyph-name="guillemotright" horiz-adv-x="566" d="M110 535L285 318V255L110 39L55 77L190 287L55 497L110 535ZM336 535L511 318V255L336 39L281 77L416 287L281 497L336 535Z" />
+<glyph unicode="¼" glyph-name="onequarter" horiz-adv-x="932" d="M274 689V272H197V610L99 553L65 606L205 689H274ZM640 750L699 721L293 -78L233 -49L640 750ZM889 156V96H836V0H760V96H574V150L702 424L768 399L655 156H761L768 261H836V156H889Z" />
+<glyph unicode="½" glyph-name="onehalf" horiz-adv-x="932" d="M274 689V272H197V610L99 553L65 606L205 689H274ZM640 750L699 721L293 -78L233 -49L640 750ZM791 424T828 390T866 304Q866 270 850 239T796 167T687 62H876L868 0H599V58Q683 139 719 177T770
+243T786 298Q786 328 768 345T721 362Q695 362 676 352T636 318L587 356Q642 424 727 424Q791 424 828 390Z" />
+<glyph unicode="¾" glyph-name="threequarters" horiz-adv-x="932" d="M261 696T297 666T334 591Q334 553 311 528T248 493Q292 489 320 463T348 391Q348 336 306 300T191 263Q104 263 52 323L97 365Q135 324 187 324Q224 324 245 343T267 395Q267 431 247
+446T187 462H153L162 518H185Q217 518 237 534T257 581Q257 607 239 622T191 637Q166 637 145 628T103 600L63 644Q121 696 197 696Q261 696 297 666ZM640 750L699 721L293 -78L233 -49L640 750ZM889 156V96H836V0H760V96H574V150L702 424L768 399L655 156H761L768
+261H836V156H889Z" />
+<glyph unicode="¿" glyph-name="questiondown" horiz-adv-x="459" d="M224 356T204 376T184 425Q184 454 204 474T254 495Q283 495 303 475T323 425Q323 396 303 376T254 356Q224 356 204 376ZM161 -215T118 -194T52 -136T30 -59Q30 -19 43 8T77 53T129 92Q170
+120 190 143T211 206V247H302V201Q302 159 288 130T254 84T201 44Q163 20 145 0T126 -53Q126 -94 153 -116T227 -139Q307 -139 366 -67L429 -116Q345 -215 221 -215Q161 -215 118 -194Z" />
+<glyph unicode="À" glyph-name="Agrave" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM196 911L397 804L373 755L157 834L196 911Z" />
+<glyph unicode="Á" glyph-name="Aacute" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM367 911L407 834L191 755L167 804L367 911Z" />
+<glyph unicode="Â" glyph-name="Acircumflex" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM160 759L120 804L256 914H317L452 804L413 759L286 840L160 759Z" />
+<glyph unicode="Ã" glyph-name="Atilde" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM326 782T311 789T276 809Q261 820 251 825T229 830Q213 830 201 819T176 784L120 812Q139 852 166 876T229
+900Q250 900 265 893T299 872Q302 870 311 864T329 855T345 852Q360 852 372 862T398 896L454 868Q435 826 407 804T345 782Q326 782 311 789Z" />
+<glyph unicode="Ä" glyph-name="Adieresis" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM206 894T222 878T239 837Q239 813 223 797T182 780Q157 780 141 796T124 837Q124 861 140 877T182 894Q206
+894 222 878ZM416 894T432 878T449 837Q449 813 433 797T391 780Q367 780 351 796T334 837Q334 861 350 877T391 894Q416 894 432 878Z" />
+<glyph unicode="Å" glyph-name="Aring" horiz-adv-x="573" d="M467 0L415 173H154L102 0H6L227 689H347L567 0H467ZM177 250H392L285 610L177 250ZM337 962T369 932T401 856Q401 811 369 781T287 750Q237 750 205 780T173 856Q173 901 205 931T287 962Q337
+962 369 932ZM262 912T248 897T234 856Q234 830 248 815T287 800Q311 800 325 815T340 856Q340 882 326 897T287 912Q262 912 248 897Z" />
+<glyph unicode="Æ" glyph-name="AE" horiz-adv-x="816" d="M535 76H762V0H458L418 173H150L85 0H-12L262 689H721L710 613H401L457 387H712V311H476L535 76ZM179 250H400L316 613L179 250Z" />
+<glyph unicode="Ç" glyph-name="Ccedilla" horiz-adv-x="560" d="M512 36T471 16T376 -10V-56Q424 -60 446 -83T469 -141Q469 -189 434 -215T345 -241Q317 -241 293 -235T254 -217L279 -165Q309 -181 342 -181Q365 -181 378 -172T392 -141Q392 -120 371 -110T303
+-99L314 -11Q237 -4 179 39T88 160T55 345Q55 458 93 538T196 660T341 701Q403 701 445 685T532 633L480 572Q417 623 347 623Q261 623 209 557T156 345Q156 203 208 136T346 68Q390 68 423 83T493 125L540 65Q512 36 471 16Z" />
+<glyph unicode="È" glyph-name="Egrave" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM199 911L400 804L376 755L160 834L199 911Z" />
+<glyph unicode="É" glyph-name="Eacute" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM370 911L410 834L194 755L170 804L370 911Z" />
+<glyph unicode="Ê" glyph-name="Ecircumflex" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM163 759L123 804L259 914H320L455 804L416 759L289 840L163 759Z" />
+<glyph unicode="Ë" glyph-name="Edieresis" horiz-adv-x="535" d="M473 689L462 613H195V388H427V312H195V76H481V0H100V689H473ZM209 894T225 878T242 837Q242 813 226 797T185 780Q160 780 144 796T127 837Q127 861 143 877T185 894Q209 894 225 878ZM419
+894T435 878T452 837Q452 813 436 797T394 780Q370 780 354 796T337 837Q337 861 353 877T394 894Q419 894 435 878Z" />
+<glyph unicode="Ì" glyph-name="Igrave" horiz-adv-x="295" d="M195 689V0H100V689H195ZM56 911L257 804L233 755L17 834L56 911Z" />
+<glyph unicode="Í" glyph-name="Iacute" horiz-adv-x="295" d="M195 689V0H100V689H195ZM227 911L267 834L51 755L27 804L227 911Z" />
+<glyph unicode="Î" glyph-name="Icircumflex" horiz-adv-x="295" d="M195 689V0H100V689H195ZM20 759L-20 804L116 914H177L312 804L273 759L146 840L20 759Z" />
+<glyph unicode="Ï" glyph-name="Idieresis" horiz-adv-x="295" d="M195 689V0H100V689H195ZM66 894T82 878T99 837Q99 813 83 797T42 780Q17 780 1 796T-16 837Q-16 861 0 877T42 894Q66 894 82 878ZM276 894T292 878T309 837Q309 813 293 797T251 780Q227
+780 211 796T194 837Q194 861 210 877T251 894Q276 894 292 878Z" />
+<glyph unicode="Ð" glyph-name="Eth" horiz-adv-x="656" d="M412 689T506 617T601 348Q601 157 507 79T277 0H112V318H20V388H112V689H256Q412 689 506 617ZM380 75T440 134T500 348Q500 457 469 515T390 593T277 613H207V388H364V318H207V75H284Q380 75 440 134Z" />
+<glyph unicode="Ñ" glyph-name="Ntilde" horiz-adv-x="683" d="M583 0H456L176 585Q182 516 185 458T189 316V0H100V689H224L507 103Q504 129 499 194T494 313V689H583V0ZM392 782T377 789T342 809Q327 820 317 825T295 830Q279 830 267 819T242 784L186
+812Q205 852 232 876T295 900Q316 900 331 893T365 872Q368 870 377 864T395 855T411 852Q426 852 438 862T464 896L520 868Q501 826 473 804T411 782Q392 782 377 789Z" />
+<glyph unicode="Ò" glyph-name="Ograve" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
+133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM255 911L456 804L432 755L216 834L255 911Z" />
+<glyph unicode="Ó" glyph-name="Oacute" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
+133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM426 911L466 834L250 755L226 804L426 911Z" />
+<glyph unicode="Ô" glyph-name="Ocircumflex" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200
+206 133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM219 759L179 804L315 914H376L511 804L472 759L345 840L219 759Z" />
+<glyph unicode="Õ" glyph-name="Otilde" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
+133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM385 782T370 789T335 809Q320 820 310 825T288 830Q272 830 260 819T235 784L179 812Q198 852 225 876T288 900Q309 900 324 893T358 872Q361 870 370 864T388 855T404 852Q419 852 431 862T457 896L513
+868Q494 826 466 804T404 782Q385 782 370 789Z" />
+<glyph unicode="Ö" glyph-name="Odieresis" horiz-adv-x="692" d="M433 701T498 660T600 538T637 344Q637 232 601 152T499 30T346 -12Q259 -12 194 29T92 150T55 343Q55 454 91 535T194 658T346 701Q433 701 498 660ZM256 623T206 555T156 343Q156 200 206
+133T346 66Q536 66 536 344Q536 623 346 623Q256 623 206 555ZM265 894T281 878T298 837Q298 813 282 797T241 780Q216 780 200 796T183 837Q183 861 199 877T241 894Q265 894 281 878ZM475 894T491 878T508 837Q508 813 492 797T450 780Q426 780 410 796T393 837Q393
+861 409 877T450 894Q475 894 491 878Z" />
+<glyph unicode="×" glyph-name="multiply" horiz-adv-x="500" d="M372 486L428 429L308 309L428 185L372 129L252 253L128 129L72 185L192 305L72 429L128 486L248 361L372 486Z" />
+<glyph unicode="Ø" glyph-name="Oslash" horiz-adv-x="692" d="M558 628T597 546T637 344Q637 232 601 152T499 30T346 -12Q310 -12 279 -5L244 -127L165 -106L205 22Q134 62 95 143T55 343Q55 454 91 535T194 658T346 701Q383 701 412 694L449 819L528 798L486
+667Q558 628 597 546ZM256 623T206 555T156 343Q156 158 238 97L396 618Q369 623 346 623Q256 623 206 555ZM536 66T536 344Q536 443 515 504T452 594L296 71Q321 66 346 66Q536 66 536 344Z" />
+<glyph unicode="Ù" glyph-name="Ugrave" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM240 911L441 804L417 755L201 834L240 911Z" />
+<glyph unicode="Ú" glyph-name="Uacute" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM411 911L451 834L235 755L211 804L411 911Z" />
+<glyph unicode="Û" glyph-name="Ucircumflex" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM204 759L164 804L300 914H361L496 804L457
+759L330 840L204 759Z" />
+<glyph unicode="Ü" glyph-name="Udieresis" horiz-adv-x="662" d="M572 221Q572 152 544 100T461 18T330 -12Q215 -12 153 51T90 221V689H185V228Q185 148 221 108T330 68Q404 68 440 107T476 228V689H572V221ZM250 894T266 878T283 837Q283 813 267 797T226
+780Q201 780 185 796T168 837Q168 861 184 877T226 894Q250 894 266 878ZM460 894T476 878T493 837Q493 813 477 797T435 780Q411 780 395 796T378 837Q378 861 394 877T435 894Q460 894 476 878Z" />
+<glyph unicode="Ý" glyph-name="Yacute" horiz-adv-x="550" d="M545 689L323 265V0H227V264L5 689H110L278 348L446 689H545ZM355 911L395 834L179 755L155 804L355 911Z" />
+<glyph unicode="Þ" glyph-name="Thorn" horiz-adv-x="581" d="M409 571T479 517T549 354Q549 238 476 183T282 127H195V0H100V689H195V571H281Q409 571 479 517ZM362 202T405 235T448 353Q448 430 405 463T280 497H195V202H278Q362 202 405 235Z" />
+<glyph unicode="ß" glyph-name="germandbls" horiz-adv-x="593" d="M351 750T391 731T454 680T476 607Q476 566 459 542T410 492Q386 472 376 459T365 427Q365 404 382 387T434 346Q472 320 495 299T536 244T553 162Q553 110 529 71T463 10T375 -12Q316 -12
+273 11L300 75Q326 62 366 62Q408 62 433 88T459 163Q459 208 436 236T366 297Q323 328 301 354T278 420Q278 453 292 472T335 515Q362 537 375 555T388 602Q388 639 362 658T295 678Q187 678 187 539V0H95V539Q95 639 147 694T296 750Q351 750 391 731Z" />
+<glyph unicode="à" glyph-name="agrave" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
+539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM192 801L391 687L363 638L151 724L192 801Z" />
+<glyph unicode="á" glyph-name="aacute" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
+539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM340 801L381 724L169 638L141 687L340 801Z" />
+<glyph unicode="â" glyph-name="acircumflex" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539
+265 539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM134 634L95 679L230 792H291L427 679L387 634L261 718L134 634Z" />
+<glyph unicode="ã" glyph-name="atilde" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
+539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM300 656T285 663T250 683Q235 694 225 699T203 704Q187 704 175 693T150 658L94 686Q113 726 140 750T203 774Q224 774 239 767T273
+746Q276 744 285 738T303 729T319 726Q334 726 346 736T372 770L428 742Q409 700 381 678T319 656Q300 656 285 663Z" />
+<glyph unicode="ä" glyph-name="adieresis" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539
+265 539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM180 768T196 752T213 711Q213 687 197 671T156 654Q131 654 115 670T98 711Q98 735 114 751T156 768Q180 768 196 752ZM390
+768T406 752T423 711Q423 687 407 671T365 654Q341 654 325 670T308 711Q308 735 324 751T365 768Q390 768 406 752Z" />
+<glyph unicode="å" glyph-name="aring" horiz-adv-x="544" d="M450 91T461 76T494 52L473 -12Q432 -7 407 11T370 67Q317 -12 213 -12Q135 -12 90 32T45 147Q45 231 105 276T277 321H358V360Q358 416 331 440T248 464Q190 464 106 436L83 503Q181 539 265
+539Q358 539 404 494T450 364V123Q450 91 461 76ZM313 57T358 139V260H289Q143 260 143 152Q143 105 166 81T234 57Q313 57 358 139ZM311 836T343 806T375 730Q375 685 343 655T261 624Q211 624 179 654T147 730Q147 775 179 805T261 836Q311 836 343 806ZM236
+786T222 771T208 730Q208 704 222 689T261 674Q285 674 299 689T314 730Q314 756 300 771T261 786Q236 786 222 771Z" />
+<glyph unicode="æ" glyph-name="ae" horiz-adv-x="849" d="M797 256T795 232H459Q465 145 503 104T601 63Q639 63 671 74T738 109L778 54Q694 -12 594 -12Q531 -12 483 13T404 85Q368 33 323 11T216 -12Q137 -12 91 32T45 147Q45 231 107 276T280 321H361V360Q361
+416 334 440T251 464Q193 464 109 436L86 503Q184 539 268 539Q382 539 425 455Q482 539 584 539Q686 539 741 470T797 279Q797 256 795 232ZM706 306Q706 384 675 425T582 466Q469 466 459 300H706V306ZM279 57T312 79T376 149Q361 197 361 257V260H292Q146 260
+146 152Q146 105 169 81T237 57Q279 57 312 79Z" />
+<glyph unicode="ç" glyph-name="ccedilla" horiz-adv-x="478" d="M385 -5T308 -11V-56Q356 -60 378 -83T401 -141Q401 -189 366 -215T277 -241Q249 -241 225 -235T186 -217L211 -165Q241 -181 274 -181Q297 -181 310 -172T324 -141Q324 -120 303 -110T235
+-99L246 -9Q157 5 107 75T57 259Q57 343 85 406T164 504T287 539Q334 539 373 526T448 482L404 424Q376 444 350 453T291 463Q227 463 192 412T156 261Q156 161 191 114T291 66Q322 66 348 75T406 106L448 46Q385 -5 308 -11Z" />
+<glyph unicode="è" glyph-name="egrave" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491
+232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM210 801L409 687L381 638L169 724L210 801Z" />
+<glyph unicode="é" glyph-name="eacute" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256 491
+232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM358 801L399 724L187 638L159 687L358 801Z" />
+<glyph unicode="ê" glyph-name="ecircumflex" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256
+491 232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM152 634L113 679L248 792H309L445 679L405 634L279 718L152 634Z" />
+<glyph unicode="ë" glyph-name="edieresis" horiz-adv-x="545" d="M493 256T491 232H155Q161 145 199 104T297 63Q335 63 367 74T434 109L474 54Q390 -12 290 -12Q180 -12 119 60T57 258Q57 340 83 403T159 503T276 539Q381 539 437 470T493 279Q493 256
+491 232ZM402 306Q402 384 371 425T278 466Q165 466 155 300H402V306ZM198 768T214 752T231 711Q231 687 215 671T174 654Q149 654 133 670T116 711Q116 735 132 751T174 768Q198 768 214 752ZM408 768T424 752T441 711Q441 687 425 671T383 654Q359 654 343 670T326
+711Q326 735 342 751T383 768Q408 768 424 752Z" />
+<glyph unicode="ì" glyph-name="igrave" horiz-adv-x="282" d="M187 527V0H95V527H187ZM72 801L271 687L243 638L31 724L72 801Z" />
+<glyph unicode="í" glyph-name="iacute" horiz-adv-x="282" d="M187 527V0H95V527H187ZM220 801L261 724L49 638L21 687L220 801Z" />
+<glyph unicode="î" glyph-name="icircumflex" horiz-adv-x="282" d="M187 527V0H95V527H187ZM14 634L-25 679L110 792H171L307 679L267 634L141 718L14 634Z" />
+<glyph unicode="ï" glyph-name="idieresis" horiz-adv-x="282" d="M187 527V0H95V527H187ZM60 768T76 752T93 711Q93 687 77 671T36 654Q11 654 -5 670T-22 711Q-22 735 -6 751T36 768Q60 768 76 752ZM270 768T286 752T303 711Q303 687 287 671T245 654Q221
+654 205 670T188 711Q188 735 204 751T245 768Q270 768 286 752Z" />
+<glyph unicode="ð" glyph-name="eth" horiz-adv-x="570" d="M432 596T470 501T508 265Q508 182 479 120T398 23T278 -12Q216 -12 166 17T86 102T57 235Q57 297 79 352T147 441T258 475Q349 475 405 408Q393 471 365 519T286 607L214 537L151 569L225 644Q173
+668 112 680L132 750Q217 733 281 702L351 776L405 729L342 664Q432 596 470 501ZM340 61T377 114T415 266Q415 287 413 325Q387 364 353 383T272 403Q151 403 151 239Q151 153 185 107T277 61Q340 61 377 114Z" />
+<glyph unicode="ñ" glyph-name="ntilde" horiz-adv-x="586" d="M415 539T455 496T496 378V0H404V365Q404 421 383 444T321 467Q279 467 247 443T187 374V0H95V527H174L182 449Q210 491 251 515T343 539Q415 539 455 496ZM337 656T322 663T287 683Q272 694
+262 699T240 704Q224 704 212 693T187 658L131 686Q150 726 177 750T240 774Q261 774 276 767T310 746Q313 744 322 738T340 729T356 726Q371 726 383 736T409 770L465 742Q446 700 418 678T356 656Q337 656 322 663Z" />
+<glyph unicode="ò" glyph-name="ograve" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
+293 465Q156 465 156 263ZM223 801L422 687L394 638L182 724L223 801Z" />
+<glyph unicode="ó" glyph-name="oacute" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
+293 465Q156 465 156 263ZM371 801L412 724L200 638L172 687L371 801Z" />
+<glyph unicode="ô" glyph-name="ocircumflex" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428
+465 293 465Q156 465 156 263ZM165 634L126 679L261 792H322L458 679L418 634L292 718L165 634Z" />
+<glyph unicode="õ" glyph-name="otilde" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428 465
+293 465Q156 465 156 263ZM331 656T316 663T281 683Q266 694 256 699T234 704Q218 704 206 693T181 658L125 686Q144 726 171 750T234 774Q255 774 270 767T304 746Q307 744 316 738T334 729T350 726Q365 726 377 736T403 770L459 742Q440 700 412 678T350 656Q331
+656 316 663Z" />
+<glyph unicode="ö" glyph-name="odieresis" horiz-adv-x="584" d="M404 539T465 465T527 264Q527 182 499 120T418 23T292 -12Q181 -12 119 62T57 263Q57 345 85 407T166 504T293 539Q404 539 465 465ZM156 465T156 263Q156 62 292 62Q428 62 428 264Q428
+465 293 465Q156 465 156 263ZM211 768T227 752T244 711Q244 687 228 671T187 654Q162 654 146 670T129 711Q129 735 145 751T187 768Q211 768 227 752ZM421 768T437 752T454 711Q454 687 438 671T396 654Q372 654 356 670T339 711Q339 735 355 751T396 768Q421
+768 437 752Z" />
+<glyph unicode="÷" glyph-name="divide" horiz-adv-x="500" d="M280 174T300 154T320 105Q320 76 300 56T250 35Q221 35 201 55T181 105Q181 134 201 154T250 174Q280 174 300 154ZM280 631T300 611T320 562Q320 533 300 513T250 492Q221 492 201 512T181
+562Q181 591 201 611T250 631Q280 631 300 611ZM62 294V371H438V294H62Z" />
+<glyph unicode="ø" glyph-name="oslash" horiz-adv-x="584" d="M470 475T498 413T527 264Q527 182 499 120T418 23T292 -12Q268 -12 241 -7L202 -130L127 -108L169 19Q115 52 86 115T57 263Q57 345 85 407T166 504T293 539Q317 539 344 534L383 656L458 634L416
+508Q470 475 498 413ZM156 465T156 263Q156 134 204 89L328 462Q311 465 293 465Q156 465 156 263ZM428 62T428 264Q428 331 417 373T381 437L258 65Q273 62 292 62Q428 62 428 264Z" />
+<glyph unicode="ù" glyph-name="ugrave" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM220 801L419 687L391 638L179 724L220 801Z" />
+<glyph unicode="ú" glyph-name="uacute" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM368 801L409 724L197 638L169 687L368 801Z" />
+<glyph unicode="û" glyph-name="ucircumflex" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM162 634L123 679L258 792H319L455 679L415 634L289 718L162
+634Z" />
+<glyph unicode="ü" glyph-name="udieresis" horiz-adv-x="582" d="M487 0H408L401 82Q371 33 332 11T237 -12Q168 -12 129 30T90 149V527H182V159Q182 105 201 83T263 60Q340 60 395 151V527H487V0ZM208 768T224 752T241 711Q241 687 225 671T184 654Q159
+654 143 670T126 711Q126 735 142 751T184 768Q208 768 224 752ZM418 768T434 752T451 711Q451 687 435 671T393 654Q369 654 353 670T336 711Q336 735 352 751T393 768Q418 768 434 752Z" />
+<glyph unicode="ý" glyph-name="yacute" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3ZM325 801L366 724L154 638L126 687L325 801Z" />
+<glyph unicode="þ" glyph-name="thorn" horiz-adv-x="594" d="M438 539T485 467T532 264Q532 140 478 64T325 -12Q237 -12 187 48V-198L95 -213V739L187 750V463Q215 500 254 519T337 539Q438 539 485 467ZM433 63T433 264Q433 466 314 466Q275 466 243 443T187
+384V127Q207 96 237 80T303 63Q433 63 433 264Z" />
+<glyph unicode="ÿ" glyph-name="ydieresis" horiz-adv-x="492" d="M306 -3Q275 -95 220 -148T61 -213L51 -141Q103 -132 134 -115T183 -72T218 0H187L10 527H108L249 67L387 527H482L306 -3ZM165 768T181 752T198 711Q198 687 182 671T141 654Q116 654 100
+670T83 711Q83 735 99 751T141 768Q165 768 181 752ZM375 768T391 752T408 711Q408 687 392 671T350 654Q326 654 310 670T293 711Q293 735 309 751T350 768Q375 768 391 752Z" />
+<glyph unicode="–" glyph-name="endash" horiz-adv-x="520" d="M32 274V352H488V274H32Z" />
+<glyph unicode="—" glyph-name="emdash" horiz-adv-x="790" d="M32 274V352H758V274H32Z" />
+<glyph unicode="‘" glyph-name="quoteleft" horiz-adv-x="228" d="M82 490T63 508T44 553Q44 565 47 577T61 611L128 753H188L148 603Q174 583 174 553Q174 527 155 509T109 490Q82 490 63 508Z" />
+<glyph unicode="’" glyph-name="quoteright" horiz-adv-x="228" d="M146 753T165 735T184 690Q184 678 181 666T167 632L100 490H40L80 640Q54 660 54 690Q54 716 73 734T119 753Q146 753 165 735Z" />
+<glyph unicode="‚" glyph-name="quotesinglbase" horiz-adv-x="228" d="M146 107T165 89T184 44Q184 32 181 20T167 -14L100 -156H40L80 -6Q54 14 54 44Q54 70 73 88T119 107Q146 107 165 89Z" />
+<glyph unicode="“" glyph-name="quotedblleft" horiz-adv-x="406" d="M82 490T63 508T44 553Q44 565 47 577T61 611L128 753H188L148 603Q174 583 174 553Q174 527 155 509T109 490Q82 490 63 508ZM260 490T241 508T222 553Q222 565 225 577T239 611L306
+753H366L326 603Q352 583 352 553Q352 527 333 509T287 490Q260 490 241 508Z" />
+<glyph unicode="”" glyph-name="quotedblright" horiz-adv-x="406" d="M146 753T165 735T184 690Q184 678 181 666T167 632L100 490H40L80 640Q54 660 54 690Q54 716 73 734T119 753Q146 753 165 735ZM324 753T343 735T362 690Q362 678 359 666T345 632L278
+490H218L258 640Q232 660 232 690Q232 716 251 734T297 753Q324 753 343 735Z" />
+<glyph unicode="„" glyph-name="quotedblbase" horiz-adv-x="406" d="M146 107T165 89T184 44Q184 32 181 20T167 -14L100 -156H40L80 -6Q54 14 54 44Q54 70 73 88T119 107Q146 107 165 89ZM324 107T343 89T362 44Q362 32 359 20T345 -14L278 -156H218L258
+-6Q232 14 232 44Q232 70 251 88T297 107Q324 107 343 89Z" />
+<glyph unicode="•" glyph-name="bullet" horiz-adv-x="324" d="M210 454T242 422T274 341Q274 293 242 261T162 229Q114 229 82 261T50 342Q50 390 82 422T162 454Q210 454 242 422Z" />
+<glyph unicode="‹" glyph-name="guilsinglleft" horiz-adv-x="340" d="M230 535L285 497L150 287L285 77L230 39L55 255V318L230 535Z" />
+<glyph unicode="›" glyph-name="guilsinglright" horiz-adv-x="340" d="M110 535L285 318V255L110 39L55 77L190 287L55 497L110 535Z" />
+</font>
+</defs>
+</svg>
--- /dev/null
+\ifouthtml
+\begin{rawhtml}
+<ul>
+<li><a HREF=libref/index_modules.html>Index of modules</a></li>
+<li><a HREF=libref/index_module_types.html>Index of module types</a></li>
+<li><a HREF=libref/index_types.html>Index of types</a></li>
+<li><a HREF=libref/index_exceptions.html>Index of exceptions</a></li>
+<li><a HREF=libref/index_values.html>Index of values</a></li>
+</ul>
+\end{rawhtml}
+\else
+\chapter*{Index to the library}
+\markright{Index to the library}
+\addcontentsline{toc}{chapter}{Index to the library}
+\myprintindex{\jobname.ind}
+\fi
+\chapter*{Index of keywords}
+\markright{Index of keywords}
+\addcontentsline{toc}{chapter}{Index of keywords}
+\myprintindex{\jobname.kwd.ind}
--- /dev/null
+*.haux
+*.hind
+*.info*.gz
+*.info.body*
+ocaml.hocaml.kwd
--- /dev/null
+*.tex
+*.htex
+arithstatus.mli
+ocamldoc.out
+ocamldoc.sty
+compiler_libs.txt
+
--- /dev/null
+SRC = ../../..
+
+CSLDIR = $(SRC)
+
+TEXQUOTE = $(SRC)/runtime/ocamlrun ../../tools/texquote2
+
+FILES = core.tex builtin.tex stdlib-blurb.tex compilerlibs.tex \
+ libunix.tex libstr.tex old.tex libthreads.tex libdynlink.tex
+
+etex-files: $(FILES)
+all: etex-files
+
+%.tex: %.etex
+ $(TEXQUOTE) < $< > $*.texquote_error.tex
+ mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+ rm -f *.tex ocamldoc.out ocamldoc.sty
--- /dev/null
+\section{s:core-builtins}{Built-in types and predefined exceptions}
+
+The following built-in types and predefined exceptions are always
+defined in the
+compilation environment, but are not part of any module. As a
+consequence, they can only be referred by their short names.
+
+%\vspace{0.1cm}
+\subsection*{ss:builtin-types}{Built-in types}
+%\vspace{0.1cm}
+
+\begin{ocamldoccode}
+ type int
+\end{ocamldoccode}
+\index{int@\verb`int`}
+\begin{ocamldocdescription}
+ The type of integer numbers.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type char
+\end{ocamldoccode}
+\index{char@\verb`char`}
+\begin{ocamldocdescription}
+ The type of characters.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type bytes
+\end{ocamldoccode}
+\index{bytes@\verb`bytes`}
+\begin{ocamldocdescription}
+ The type of (writable) byte sequences.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type string
+\end{ocamldoccode}
+\index{string@\verb`string`}
+\begin{ocamldocdescription}
+ The type of (read-only) character strings.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type float
+\end{ocamldoccode}
+\index{float@\verb`float`}
+\begin{ocamldocdescription}
+ The type of floating-point numbers.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type bool = false | true
+\end{ocamldoccode}
+\index{bool@\verb`bool`}
+\begin{ocamldocdescription}
+ The type of booleans (truth values).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type unit = ()
+\end{ocamldoccode}
+\index{unit@\verb`unit`}
+\begin{ocamldocdescription}
+ The type of the unit value.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type exn
+\end{ocamldoccode}
+\index{exn@\verb`exn`}
+\begin{ocamldocdescription}
+ The type of exception values.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type 'a array
+\end{ocamldoccode}
+\index{array@\verb`array`}
+\begin{ocamldocdescription}
+ The type of arrays whose elements have type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+ type 'a list = [] | :: of 'a * 'a list
+\end{ocamldoccode}
+\index{list@\verb`list`}
+\begin{ocamldocdescription}
+ The type of lists whose elements have type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type 'a option = None | Some of 'a
+\end{ocamldoccode}
+\index{option@\verb`option`}
+\begin{ocamldocdescription}
+ The type of optional values of type "'a".
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type int32
+\end{ocamldoccode}
+\index{int32@\verb`int32`}
+\begin{ocamldocdescription}
+ The type of signed 32-bit integers.
+ Literals for 32-bit integers are suffixed by l.
+ See the \stdmoduleref{Int32} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type int64
+\end{ocamldoccode}
+\index{int64@\verb`int64`}
+\begin{ocamldocdescription}
+ The type of signed 64-bit integers.
+ Literals for 64-bit integers are suffixed by L.
+ See the \stdmoduleref{Int64} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type nativeint
+\end{ocamldoccode}
+\index{nativeint@\verb`nativeint`}
+\begin{ocamldocdescription}
+ The type of signed, platform-native integers (32 bits on 32-bit
+ processors, 64 bits on 64-bit processors).
+ Literals for native integers are suffixed by n.
+ See the \stdmoduleref{Nativeint} module.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type ('a, 'b, 'c, 'd, 'e, 'f) format6
+\end{ocamldoccode}
+\index{format4@\verb`format4`}
+\begin{ocamldocdescription}
+ The type of format strings. "'a" is the type of the parameters of
+ the format, "'f" is the result type for the "printf"-style
+ functions, "'b" is the type of the first argument given to "%a" and
+ "%t" printing functions (see module \stdmoduleref{Printf}),
+ "'c" is the result type of these functions, and also the type of the
+ argument transmitted to the first argument of "kprintf"-style
+ functions, "'d" is the result type for the "scanf"-style functions
+ (see module \stdmoduleref{Scanf}), and "'e" is the type of the receiver function
+ for the "scanf"-style functions.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+type 'a lazy_t
+\end{ocamldoccode}
+\index{lazyt@\verb`lazy_t`}
+\begin{ocamldocdescription}
+ This type is used to implement the \stdmoduleref{Lazy} module.
+ It should not be used directly.
+\end{ocamldocdescription}
+
+%\vspace{0.1cm}
+\subsection*{ss:predef-exn}{Predefined exceptions}
+%\vspace{0.1cm}
+
+\begin{ocamldoccode}
+exception Match_failure of (string * int * int)
+\end{ocamldoccode}
+\index{Matchfailure@\verb`Match_failure`}
+\begin{ocamldocdescription}
+ Exception raised when none of the cases of a pattern-matching
+ apply. The arguments are the location of the "match" keyword
+ in the source code (file name, line number, column number).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Assert_failure of (string * int * int)
+\end{ocamldoccode}
+\index{Assertfailure@\verb`Assert_failure`}
+\begin{ocamldocdescription}
+ Exception raised when an assertion fails. The arguments are
+ the location of the "assert" keyword in the source code
+ (file name, line number, column number).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Invalid_argument of string
+\end{ocamldoccode}
+\index{Invalidargument@\verb`Invalid_argument`}
+\begin{ocamldocdescription}
+ Exception raised by library functions to signal that the given
+ arguments do not make sense. The string gives some information
+ to the programmer. As a general rule, this exception should not
+ be caught, it denotes a programming error and the code should be
+ modified not to trigger it.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Failure of string
+\end{ocamldoccode}
+\index{Failure@\verb`Failure`}
+\begin{ocamldocdescription}
+ Exception raised by library functions to signal that they are
+ undefined on the given arguments. The string is meant to give some
+ information to the programmer; you must \emph{not} pattern match on
+ the string literal because it may change in future versions (use
+ \verb`Failure _` instead).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Not_found
+\end{ocamldoccode}
+\index{Notfound@\verb`Not_found`}
+\begin{ocamldocdescription}
+ Exception raised by search functions when the desired object
+ could not be found.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Out_of_memory
+\end{ocamldoccode}
+\index{Outofmemory@\verb`Out_of_memory`}
+\begin{ocamldocdescription}
+ Exception raised by the garbage collector when there is
+ insufficient memory to complete the computation. (Not reliable for
+ allocations on the minor heap.)
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Stack_overflow
+\end{ocamldoccode}
+\index{Stackoverflow@\verb`Stack_overflow`}
+\begin{ocamldocdescription}
+ Exception raised by the bytecode interpreter when the evaluation
+ stack reaches its maximal size. This often indicates infinite or
+ excessively deep recursion in the user's program. Before 4.10, it
+ was not fully implemented by the native-code compiler.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Sys_error of string
+\end{ocamldoccode}
+\index{Syserror@\verb`Sys_error`}
+\begin{ocamldocdescription}
+ Exception raised by the input/output functions to report an
+ operating system error. The string is meant to give some
+ information to the programmer; you must \emph{not} pattern match on
+ the string literal because it may change in future versions (use
+ \verb`Sys_error _` instead).
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception End_of_file
+\end{ocamldoccode}
+\index{Endoffile@\verb`End_of_file`}
+\begin{ocamldocdescription}
+ Exception raised by input functions to signal that the
+ end of file has been reached.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Division_by_zero
+\end{ocamldoccode}
+\index{Divisionbyzero@\verb`Division_by_zero`}
+\begin{ocamldocdescription}
+ Exception raised by integer division and remainder operations
+ when their second argument is zero.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Sys_blocked_io
+\end{ocamldoccode}
+\index{Sysblockedio@\verb`Sys_blocked_io`}
+\begin{ocamldocdescription}
+ A special case of "Sys_error" raised when no I/O is possible
+ on a non-blocking I/O channel.
+\end{ocamldocdescription}
+
+\begin{ocamldoccode}
+exception Undefined_recursive_module of (string * int * int)
+\end{ocamldoccode}
+\index{Undefinedrecursivemodule@\verb`Undefined_recursive_module`}
+\begin{ocamldocdescription}
+ Exception raised when an ill-founded recursive module definition
+ is evaluated. (See section~\ref{s:recursive-modules}.)
+ The arguments are the location of the definition in the source code
+ (file name, line number, column number).
+\end{ocamldocdescription}
+
--- /dev/null
+{!indexlist}
+
+{1 Warning}
+ This library is part of the internal OCaml compiler API, and is
+not the language standard library.
+ There are no compatibility guarantees between releases, so code written
+against these modules must be willing to depend on specific OCaml compiler
+versions.
+
--- /dev/null
+\chapter{The compiler front-end} \label{c:parsinglib}\cutname{parsing.html}
+\label{Compiler-underscorelibs} % redirect references to compiler_libs.mld here
+
+This chapter describes the OCaml front-end, which declares the abstract
+syntax tree used by the compiler, provides a way to parse, print
+and pretty-print OCaml code, and ultimately allows one to write abstract
+syntax tree preprocessors invoked via the {\tt -ppx} flag (see chapters~\ref{c:camlc}
+and~\ref{c:nativecomp}).
+
+It is important to note that the exported front-end interface follows the evolution of the OCaml language and implementation, and thus does not provide {\bf any} backwards compatibility guarantees.
+
+The front-end is a part of "compiler-libs" library.
+Programs that use the "compiler-libs" library should be built as follows:
+\begin{alltt}
+ ocamlfind ocamlc \var{other options} -package compiler-libs.common \var{other files}
+ ocamlfind ocamlopt \var{other options} -package compiler-libs.common \var{other files}
+\end{alltt}
+Use of the {\tt ocamlfind} utility is recommended. However, if this is not possible, an alternative method may be used:
+\begin{alltt}
+ ocamlc \var{other options} -I +compiler-libs ocamlcommon.cma \var{other files}
+ ocamlopt \var{other options} -I +compiler-libs ocamlcommon.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "compiler-libs" library, start "ocaml" and
+type\\*"#load \"compiler-libs/ocamlcommon.cma\";;".
+
+% Some of the files below are commented out as the documentation is too poor
+% or they are thought to be nonessential.
+
+
+\begin{linklist}
+\ifouthtml%
+% Ast_helper is excluded from the PDF and text manuals.
+% It is over 20 pages long and does not have doc-comments. It is expected
+% that Ast_helper will be only useful in the HTML manual (to look up signatures).
+\compilerdocitem{Ast_helper}{helper functions for AST construction}
+\fi%
+\compilerdocitem{Ast_mapper}{-ppx rewriter interface}
+\compilerdocitem{Asttypes}{auxiliary types used by Parsetree}
+% \item \ahref{compilerlibref/Lexer.html}{Module \texttt{Lexer}: OCaml syntax lexing}
+\compilerdocitem{Location}{source code locations}
+\compilerdocitem{Longident}{long identifiers}
+\compilerdocitem{Parse}{OCaml syntax parsing}
+\compilerdocitem{Parsetree}{OCaml syntax tree}
+\compilerdocitem{Pprintast}{OCaml syntax printing}
+% \item \ahref{compilerlibref/Printast.html}{Module \texttt{Printast}: AST printing}
+\end{linklist}
--- /dev/null
+\chapter{The core library} \label{c:corelib}\cutname{core.html}
+
+This chapter describes the OCaml core library, which is
+ composed of declarations for built-in types and exceptions, plus
+the module "Stdlib" that provides basic operations on these
+ built-in types. The "Stdlib" module is special in two
+ways:
+\begin{itemize}
+\item It is automatically linked with the user's object code files by
+the "ocamlc" command (chapter~\ref{c:camlc}).
+
+\item It is automatically ``opened'' when a compilation starts, or
+when the toplevel system is launched. Hence, it is possible to use
+unqualified identifiers to refer to the functions provided by the
+"Stdlib" module, without adding a "open Stdlib" directive.
+\end{itemize}
+
+\begin{latexonly}
+\section*{s:core-conventions}{Conventions}
+
+The declarations of the built-in types and the components of module
+"Stdlib" are printed one by one in typewriter font, followed by a
+short comment. All library modules and the components they provide are
+indexed at the end of this report.
+\end{latexonly}
+
+\input{builtin.tex}
+\ifouthtml
+\section{s:stdlib-module}{Module {\tt Stdlib}: the initially opened module}
+\fi
+\begin{linklist}
+\libdocitem{Stdlib}{the initially opened module}
+\ifouthtml%
+\item Module \texttt{Pervasives}: deprecated alias for Stdlib
+\fi%
+\end{linklist}
--- /dev/null
+\chapter{The dynlink library: dynamic loading and linking of object files}
+%HEVEA\cutname{libdynlink.html}
+
+The "dynlink" library supports type-safe dynamic loading and linking
+of bytecode object files (".cmo" and ".cma" files) in a running
+bytecode program, or of native plugins (usually ".cmxs" files) in a
+running native program. Type safety is ensured by limiting the set of
+modules from the running program that the loaded object file can
+access, and checking that the running program and the loaded object
+file have been compiled against the same interfaces for these modules.
+In native code, there are also some compatibility checks on the
+implementations (to avoid errors with cross-module optimizations); it
+might be useful to hide ".cmx" files when building native plugins so
+that they remain independent of the implementation of modules in the
+main program.
+
+Programs that use the "dynlink" library simply need to link
+"dynlink.cma" or "dynlink.cmxa" with their object files and other libraries.
+
+\textbf{Note:} in order to insure that the dynamically-loaded modules have
+access to all the libraries that are visible to the main program (and not just
+to the parts of those libraries that are actually used in the main program),
+programs using the "dynlink" library should be linked with "-linkall".
+
+\begin{linklist}
+\libdocitem{Dynlink}{dynamic loading of bytecode object files}
+\end{linklist}
--- /dev/null
+\chapter{The str library: regular expressions and string processing}
+%HEVEA\cutname{libstr.html}
+
+The "str" library provides high-level string processing functions,
+some based on regular expressions. It is intended to support the kind
+of file processing that is usually performed with scripting languages
+such as "awk", "perl" or "sed".
+
+Programs that use the "str" library must be linked as follows:
+\begin{alltt}
+ ocamlc \var{other options} str.cma \var{other files}
+ ocamlopt \var{other options} str.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "str" library, do:
+\begin{alltt}
+ ocamlmktop -o mytop str.cma
+ ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"str.cma\";;".
+
+\begin{linklist}
+\libdocitem{Str}{regular expressions and string processing}
+\end{linklist}
--- /dev/null
+\chapter{The threads library}
+\label{c:threads}\cutname{threads.html}
+%HEVEA\cutname{libthreads.html}
+
+The "threads" library allows concurrent programming in OCaml.
+It provides multiple threads of control (also called lightweight
+processes) that execute concurrently in the same memory space. Threads
+communicate by in-place modification of shared data structures, or by
+sending and receiving data on communication channels.
+
+The "threads" library is implemented on top of the threading
+facilities provided by the operating system: POSIX 1003.1c threads for
+Linux, MacOS, and other Unix-like systems; Win32 threads for Windows.
+Only one thread at a time is allowed to run OCaml code, hence
+opportunities for parallelism are limited to the parts of the program
+that run system or C library code. However, threads provide
+concurrency and can be used to structure programs as several
+communicating processes. Threads also efficiently support concurrent,
+overlapping I/O operations.
+
+Programs that use threads must be linked as follows:
+\begin{alltt}
+ ocamlc -I +threads \var{other options} unix.cma threads.cma \var{other files}
+ ocamlopt -I +threads \var{other options} unix.cmxa threads.cmxa \var{other files}
+\end{alltt}
+Compilation units that use the "threads" library must also be compiled with
+the "-I +threads" option (see chapter~\ref{c:camlc}).
+
+\begin{linklist}
+\libdocitem{Thread}{lightweight threads}
+\libdocitem{Mutex}{locks for mutual exclusion}
+\libdocitem{Condition}{condition variables to synchronize between threads}
+\libdocitem{Semaphore}{semaphores, another thread synchronization mechanism}
+\libdocitem{Event}{first-class synchronous communication}
+\end{linklist}
--- /dev/null
+\chapter{The unix library: Unix system calls}
+%HEVEA\cutname{libunix.html}
+\label{c:unix}
+
+The "unix" library makes many Unix
+system calls and system-related library functions available to
+OCaml programs. This chapter describes briefly the functions
+provided. Refer to sections 2~and~3 of the Unix manual for more
+details on the behavior of these functions.
+
+\ifouthtml
+\begin{linklist}
+\libdocitem{Unix}{Unix system calls}
+\libdocitem{UnixLabels}{Labeled Unix system calls}
+\end{linklist}
+\fi
+
+Not all functions are provided by all Unix variants. If some functions
+are not available, they will raise "Invalid_arg" when called.
+
+Programs that use the "unix" library must be linked as follows:
+\begin{alltt}
+ ocamlc \var{other options} unix.cma \var{other files}
+ ocamlopt \var{other options} unix.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "unix" library, do:
+\begin{alltt}
+ ocamlmktop -o mytop unix.cma
+ ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"unix.cma\";;".
+
+\begin{latexonly}
+\begin{windows}
+A fairly complete emulation of the Unix system calls is provided in
+the Windows version of OCaml. The end of this chapter gives
+more information on the functions that are not supported under Windows.
+\end{windows}
+
+\begin{linklist}
+\libdocitem{Unix}{Unix system calls}
+\end{linklist}
+
+\section{UnixLabels}{Module \texttt{UnixLabels}: labelized version of the interface}
+\index{UnixLabels (module)@\verb~UnixLabels~ (module)}%
+
+This module is identical to "Unix"~(\ref{Unix}), and only differs by
+the addition of labels. You may see these labels directly by looking
+at "unixLabels.mli", or by using the "ocamlbrowser" tool.
+\newpage
+\end{latexonly}
+
+\begin{windows}
+The Cygwin port of OCaml fully implements all functions from
+the Unix module. The native Win32 ports implement a subset of them.
+Below is a list of the functions that are not implemented, or only
+partially implemented, by the Win32 ports. Functions not mentioned are
+fully implemented and behave as described previously in this chapter.
+\end{windows}
+
+\begin{tableau}{|l|p{8cm}|}{Functions}{Comment}
+\entree{"fork"}{not implemented, use "create_process" or threads}
+\entree{"wait"}{not implemented, use "waitpid"}
+\entree{"waitpid"}{can only wait for a given PID, not any child process}
+\entree{"getppid"}{not implemented (meaningless under Windows)}
+\entree{"nice"}{not implemented}
+\entree{"truncate", "ftruncate"}{implemented (since 4.10.0)}
+\entree{"link"}{implemented (since 3.02)}
+\entree{"fchmod"}{not implemented}
+\entree{"chown", "fchown"}{not implemented (make no sense on a DOS
+file system)}
+\entree{"umask"}{not implemented}
+\entree{"access"}{execute permission "X_OK" cannot be tested,
+ it just tests for read permission instead}
+\entree{"chroot"}{not implemented}
+\entree{"mkfifo"}{not implemented}
+\entree{"symlink", "readlink"}{implemented (since 4.03.0)}
+\entree{"kill"}{partially implemented (since 4.00.0): only the "sigkill" signal
+is implemented}
+\entree{"sigprocmask", "sigpending", "sigsuspend"}{not implemented (no inter-process signals on Windows}
+\entree{"pause"}{not implemented (no inter-process signals in Windows)}
+\entree{"alarm"}{not implemented}
+\entree{"times"}{partially implemented, will not report timings for child
+processes}
+\entree{"getitimer", "setitimer"}{not implemented}
+\entree{"getuid", "geteuid", "getgid", "getegid"}{always return 1}
+\entree{"setuid", "setgid", "setgroups", "initgroups"}{not implemented}
+\entree{"getgroups"}{always returns "[|1|]" (since 2.00)}
+\entree{"getpwnam", "getpwuid"}{always raise "Not_found"}
+\entree{"getgrnam", "getgrgid"}{always raise "Not_found"}
+\entree{type "socket_domain"}{"PF_INET" is fully supported;
+"PF_INET6" is fully supported (since 4.01.0); "PF_UNIX" is not supported }
+\entree{"establish_server"}{not implemented; use threads}
+\entree{terminal functions ("tc*")}{not implemented}
+\entree{"setsid"}{not implemented}
+\end{tableau}
--- /dev/null
+\chapter{Recently removed or moved libraries (Graphics, Bigarray, Num, LablTk)}
+%HEVEA\cutname{old.html}
+
+This chapter describes three libraries which were formerly part of the OCaml
+distribution (Graphics, Num, and LablTk), and a library which has now become
+part of OCaml's standard library, and is documented there (Bigarray).
+
+
+\section{s:graphics-removed}{The Graphics Library}
+
+Since OCaml 4.09, the "graphics" library is distributed as an external
+package. Its new home is:
+
+\url{https://github.com/ocaml/graphics}
+
+If you are using the opam package manager, you should install the
+corresponding "graphics" package:
+
+\begin{alltt}
+ opam install graphics
+\end{alltt}
+
+Before OCaml 4.09, this package simply ensures that the "graphics"
+library was installed by the compiler, and starting from OCaml 4.09
+this package effectively provides the "graphics" library.
+
+\section{s:bigarray-moved}{The Bigarray Library}
+
+As of OCaml 4.07, the "bigarray" library has been integrated into OCaml's
+standard library.
+
+The "bigarray" functionality may now be found in the standard library
+\ifouthtml
+ \ahref{libref/Bigarray.html}{\texttt{Bigarray} module},
+\else
+ \texttt{Bigarray} module,
+\fi
+except for the "map_file" function which is now
+part of the \hyperref[c:unix]{Unix library}. The documentation has
+been integrated into the documentation for the standard library.
+
+The legacy "bigarray" library bundled with the compiler is a
+compatibility library with exactly the same interface as before,
+i.e. with "map_file" included.
+
+We strongly recommend that you port your code to use the standard
+library version instead, as the changes required are minimal.
+
+If you choose to use the compatibility library, you must link your
+programs as follows:
+\begin{alltt}
+ ocamlc \var{other options} bigarray.cma \var{other files}
+ ocamlopt \var{other options} bigarray.cmxa \var{other files}
+\end{alltt}
+For interactive use of the "bigarray" compatibility library, do:
+\begin{alltt}
+ ocamlmktop -o mytop bigarray.cma
+ ./mytop
+\end{alltt}
+or (if dynamic linking of C libraries is supported on your platform),
+start "ocaml" and type "#load \"bigarray.cma\";;".
+
+\section{s:graphics-removed}{The Num Library}
+
+The "num" library implements integer arithmetic and rational
+arithmetic in arbitrary precision. It was split off the core
+OCaml distribution starting with the 4.06.0 release, and can now be found
+at \url{https://github.com/ocaml/num}.
+
+New applications that need arbitrary-precision arithmetic should use the
+"Zarith" library (\url{https://github.com/ocaml/Zarith}) instead of the "Num"
+library, and older applications that already use "Num" are encouraged to
+switch to "Zarith". "Zarith" delivers much better performance than "Num"
+and has a nicer API.
+
+\section{s:labltk-removed}{The Labltk Library and OCamlBrowser}
+
+Since OCaml version 4.02, the OCamlBrowser tool and the Labltk library
+are distributed separately from the OCaml compiler. The project is now
+hosted at \url{https://github.com/garrigue/labltk}.
--- /dev/null
+\chapter{The standard library} \label{c:stdlib}\cutname{stdlib.html}
+
+This chapter describes the functions provided by the OCaml
+standard library. The modules from the standard library are
+automatically linked with the user's object code files by the "ocamlc"
+command. Hence, these modules can be used in standalone programs without
+having to add any ".cmo" file on the command line for the linking
+phase. Similarly, in interactive use, these globals can be used in
+toplevel phrases without having to load any ".cmo" file in memory.
+
+Unlike the core "Stdlib" module, submodules are not automatically
+``opened'' when compilation starts, or when the toplevel system is launched.
+Hence it is necessary to use qualified identifiers to refer to the functions
+provided by these modules, or to add "open" directives.
+
+\label{stdlib:top}
+
+\begin{latexonly}
+
+\section*{s:stdlib-conv}{Conventions}
+
+For easy reference, the modules are listed below in alphabetical order
+of module names.
+For each module, the declarations from its signature are printed
+one by one in typewriter font, followed by a short comment.
+All modules and the identifiers they export are indexed at the end of
+this report.
+
+\section*{s:stdlib-overview}{Overview}
+
+Here is a short listing, by theme, of the standard library modules.
+
+\subsubsection*{sss:stdlib-data-structures}{Data structures:}
+\begin{tabular}{lll}
+% Beware: these entries must be written in a very rigidly-defined
+% format, or the check-stdlib-modules script will complain.
+"String" & p.~\stdpageref{String} & string operations \\
+"Bytes" & p.~\stdpageref{Bytes} & operations on byte sequences\\
+"Array" & p.~\stdpageref{Array} & array operations \\
+"List" & p.~\stdpageref{List} & list operations \\
+"StdLabels" & p.~\stdpageref{StdLabels} & labelized versions of
+the above 4 modules \\
+"Unit" & p.~\stdpageref{Unit} & unit values \\
+"Bool" & p.~\stdpageref{Bool} & boolean values \\
+"Char" & p.~\stdpageref{Char} & character operations \\
+"Uchar" & p.~\stdpageref{Uchar} & Unicode characters \\
+"Int" & p.~\stdpageref{Int} & integer values \\
+"Option" & p.~\stdpageref{Option} & option values \\
+"Result" & p.~\stdpageref{Result} & result values \\
+"Either" & p.~\stdpageref{Either} & either values \\
+"Hashtbl" & p.~\stdpageref{Hashtbl} & hash tables and hash functions \\
+"Random" & p.~\stdpageref{Random} & pseudo-random number generator \\
+"Set" & p.~\stdpageref{Set} & sets over ordered types \\
+"Map" & p.~\stdpageref{Map} & association tables over ordered types \\
+"MoreLabels" & p.~\stdpageref{MoreLabels} & labelized versions of
+"Hashtbl", "Set", and "Map" \\
+"Oo" & p.~\stdpageref{Oo} & useful functions on objects \\
+"Stack" & p.~\stdpageref{Stack} & last-in first-out stacks \\
+"Queue" & p.~\stdpageref{Queue} & first-in first-out queues \\
+"Buffer" & p.~\stdpageref{Buffer} & buffers that grow on demand \\
+"Seq" & p.~\stdpageref{Seq} & functional iterators \\
+"Lazy" & p.~\stdpageref{Lazy} & delayed evaluation \\
+"Weak" & p.~\stdpageref{Weak} & references that don't prevent objects
+from being garbage-collected \\
+"Atomic" & p.~\stdpageref{Atomic} & atomic references (for compatibility with concurrent runtimes) \\
+"Ephemeron" & p.~\stdpageref{Ephemeron} & ephemerons and weak hash tables \\
+"Bigarray" & p.~\stdpageref{Bigarray} & large, multi-dimensional, numerical arrays
+\end{tabular}
+\subsubsection*{sss:stdlib-arith}{Arithmetic:}
+\begin{tabular}{lll}
+"Complex" & p.~\stdpageref{Complex} & complex numbers \\
+"Float" & p.~\stdpageref{Float} & floating-point numbers \\
+"Int32" & p.~\stdpageref{Int32} & operations on 32-bit integers \\
+"Int64" & p.~\stdpageref{Int64} & operations on 64-bit integers \\
+"Nativeint" & p.~\stdpageref{Nativeint} & operations on platform-native
+integers
+\end{tabular}
+\subsubsection*{sss:stdlib-io}{input/output:}
+\begin{tabular}{lll}
+"Format" & p.~\stdpageref{Format} & pretty printing with automatic
+indentation and line breaking \\
+"Marshal" & p.~\stdpageref{Marshal} & marshaling of data structures \\
+"Printf" & p.~\stdpageref{Printf} & formatting printing functions \\
+"Scanf" & p.~\stdpageref{Scanf} & formatted input functions \\
+"Digest" & p.~\stdpageref{Digest} & MD5 message digest \\
+\end{tabular}
+\subsubsection*{sss:stdlib-parsing}{Parsing:}
+\begin{tabular}{lll}
+"Genlex" & p.~\stdpageref{Genlex} & a generic lexer over streams \\
+"Lexing" & p.~\stdpageref{Lexing} & the run-time library for lexers generated by "ocamllex" \\
+"Parsing" & p.~\stdpageref{Parsing} & the run-time library for parsers generated by "ocamlyacc" \\
+"Stream" & p.~\stdpageref{Stream} & basic functions over streams \\
+\end{tabular}
+\subsubsection*{sss:stdlib-system}{System interface:}
+\begin{tabular}{lll}
+"Arg" & p.~\stdpageref{Arg} & parsing of command line arguments \\
+"Callback" & p.~\stdpageref{Callback} & registering OCaml functions to
+be called from C \\
+"Filename" & p.~\stdpageref{Filename} & operations on file names \\
+"Gc" & p.~\stdpageref{Gc} & memory management control and statistics \\
+"Printexc" & p.~\stdpageref{Printexc} & a catch-all exception handler \\
+"Sys" & p.~\stdpageref{Sys} & system interface \\
+\end{tabular}
+\subsubsection*{sss:stdlib-misc}{Misc:}
+\begin{tabular}{lll}
+"Fun" & p.~\stdpageref{Fun} & function values \\
+\end{tabular}
+\end{latexonly}
+
+\begin{linklist}
+\stddocitem{Arg}{parsing of command line arguments}
+\stddocitem{Array}{array operations}
+\stddocitem{ArrayLabels}{array operations (with labels)}
+\stddocitem{Atomic}{atomic references}
+\stddocitem{Bigarray}{large, multi-dimensional, numerical arrays}
+\stddocitem{Bool}{boolean values}
+\stddocitem{Buffer}{extensible buffers}
+\stddocitem{Bytes}{byte sequences}
+\stddocitem{BytesLabels}{byte sequences (with labels)}
+\stddocitem{Callback}{registering OCaml values with the C runtime}
+\stddocitem{Char}{character operations}
+\stddocitem{Complex}{complex numbers}
+\stddocitem{Digest}{MD5 message digest}
+\stddocitem{Either}{either values}
+\stddocitem{Ephemeron}{Ephemerons and weak hash table}
+\stddocitem{Filename}{operations on file names}
+\stddocitem{Float}{floating-point numbers}
+\stddocitem{Format}{pretty printing}
+\stddocitem{Fun}{function values}
+\stddocitem{Gc}{memory management control and statistics; finalized values}
+\stddocitem{Genlex}{a generic lexical analyzer}
+\stddocitem{Hashtbl}{hash tables and hash functions}
+\stddocitem{Int}{integers}
+\stddocitem{Int32}{32-bit integers}
+\stddocitem{Int64}{64-bit integers}
+\stddocitem{Lazy}{deferred computations}
+\stddocitem{Lexing}{the run-time library for lexers generated by \texttt{ocamllex}}
+\stddocitem{List}{list operations}
+\stddocitem{ListLabels}{list operations (with labels)}
+\stddocitem{Map}{association tables over ordered types}
+\stddocitem{Marshal}{marshaling of data structures}
+\stddocitem{MoreLabels}{include modules \texttt{Hashtbl}, \texttt{Map} and \texttt{Set} with labels}
+\stddocitem{Nativeint}{processor-native integers}
+\stddocitem{Oo}{object-oriented extension}
+\stddocitem{Option}{option values}
+\stddocitem{Parsing}{the run-time library for parsers generated by \texttt{ocamlyacc}}
+\stddocitem{Printexc}{facilities for printing exceptions}
+\stddocitem{Printf}{formatting printing functions}
+\stddocitem{Queue}{first-in first-out queues}
+\stddocitem{Random}{pseudo-random number generator (PRNG)}
+\stddocitem{Result}{result values}
+\stddocitem{Scanf}{formatted input functions}
+\stddocitem{Seq}{functional iterators}
+\stddocitem{Set}{sets over ordered types}
+\stddocitem{Stack}{last-in first-out stacks}
+\stddocitem{StdLabels}{include modules \texttt{Array}, \texttt{List} and \texttt{String} with labels}
+\stddocitem{Stream}{streams and parsers}
+\stddocitem{String}{string operations}
+\stddocitem{StringLabels}{string operations (with labels)}
+\stddocitem{Sys}{system interface}
+\stddocitem{Uchar}{Unicode characters}
+\stddocitem{Unit}{unit values}
+\stddocitem{Weak}{arrays of weak pointers}
+\ifouthtml\else
+\input{Ocaml_operators}
+\fi
+\end{linklist}
--- /dev/null
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
+% Colors for links
+
+\newstyle{a.section-anchor::after}{
+ content:"\@print@u{128279}";
+ font-size:smaller;
+ margin-left:-1.5em;
+ padding-right:0.5em;
+}
+
+
+\newstyle{a.section-anchor}{
+ visibility:hidden;
+ color:grey !important;
+ text-decoration:none !important;
+}
+
+\newstyle{*:hover>a.section-anchor}{
+ visibility:visible;
+}
+
+\def\visited@color{\#0d46a3}
+\def\link@color{\#4286f4}
+\newstyle{a:link}{color:\link@color;text-decoration:underline;}
+\newstyle{a:visited}{color:\visited@color;text-decoration:underline;}
+\newstyle{a:hover}{color:black;text-decoration:underline;}
+
+
+\newstyle{@media all}{@font-face \{
+/* fira-sans-regular - latin */
+ font-family: 'Fira Sans';
+ font-style: normal;
+ font-weight: 400;
+ src: url('fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
+ src: local('Fira Sans Regular'), local('FiraSans-Regular'),
+ url('fonts/fira-sans-v8-latin-regular.eot?\#iefix') format('embedded-opentype'), /* IE6-IE8 */
+ url('fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
+ url('fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
+ url('fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
+ url('fonts/fira-sans-v8-latin-regular.svg\#FiraSans') format('svg'); /* Legacy iOS */
+\}}
+
+% Compact layout
+\newstyle{body}{
+ max-width:750px;
+ width: 85\%;
+ margin: auto;
+ background: \#f7f7f7;
+ margin-top: 80px;
+ font-size: 1rem;
+}
+
+% selects the index's title
+\newstyle{.maintitle}{
+ font-family: "Fira Sans", sans-serif;
+ text-align: center;
+}
+
+\newstyle{h1, h2, h3}{
+ font-family: "Fira Sans", sans-serif;
+ font-weight: normal;
+ border-bottom: 1px solid black;
+}
+
+
+\newstyle{div.ocaml}{
+ margin:2ex 0px;
+ font-size: 1rem;
+ background: beige;
+ border: 1px solid grey;
+ padding: 10px;
+ overflow-y:auto;
+ display:flex;
+ flex-direction: column;
+ flex-wrap: nowrap;
+}
+
+\newstyle{div.ocaml .pre}{
+ white-space: pre;
+ font-family: monospace;
+}
+
+
+
+\newstyle{.ocamlkeyword}{
+ font-weight:bold;
+}
+
+
+\newstyle{.ocamlhighlight}{
+ font-weight:bold;
+ text-decoration:underline;
+}
+
+\newstyle{.ocamlerror}{
+ font-weight:bold;
+ color:red;
+}
+
+\newstyle{.ocamlwarning}{
+ font-weight:bold;
+ color:purple;
+}
+
+\newstyle{.ocamlcomment}{
+ color:grey;
+}
+
+\newstyle{.ocamlstring}{
+ opacity:0.75;
+}
+
+% Creative commons license logo
+\newstyle{\#cc_license_logo}{
+ float:left;
+ margin-right: 1em;
+}
+
+% More spacing between lines and inside tables
+\newstyle{p,ul}{line-height:1.3em}
+\newstyle{.cellpadding1 tr td}{padding:1px 4px}
+
+%Styles for caml-example and friends
+\newstyle{div.caml-output}{color:maroon;}
+% Styles for toplevel mode only
+\newstyle{div.caml-example.toplevel div.caml-input}{color:\#006000;}
+
+%%% Code examples
+\newcommand{\input@color}{\htmlcolor{006000}}
+\newcommand{\output@color}{\maroon}
+\newcommand{\machine}{\@span{class=machine}\tt}
+\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
+\newcommand{\var}[1]{\textit{#1}}
+
+%% Caml-example environment
+\newcommand{\camlexample}[1]{
+ \@open{div}{class="caml-example #1"}
+}
+\newcommand{\endcamlexample}{
+ \@close{div}
+}
+
+\newenvironment{caml}{\@open{div}{class=ocaml}}{\@close{div}}
+\newcommand{\ocamlkeyword}{\@span{class="ocamlkeyword"}}
+\newcommand{\ocamlhighlight}{\@span{class="ocamlhighlight"}}
+\newcommand{\ocamlerror}{\@span{class="ocamlerror"}}
+\newcommand{\ocamlwarning}{\@span{class="ocamlwarning"}}
+\newcommand{\ocamlcomment}{\@span{class="ocamlcomment"}}
+\newcommand{\ocamlstring}{\@span{class="ocamlstring"}}
+
+\newcommand{\?}{\@span{class=ocamlprompt}\#}
+\newstyle{.ocamlprompt}{color:black;}
+
+%%% End of code example
+
+\newenvironment{library}{}{}
+\newcounter{page}
+\newenvironment{comment}{\begin{quote}}{\end{quote}}
+\newcommand{\nth}[2]{\({#1}_{#2}\)}
+\newenvironment{options}{\begin{description}}{\end{description}}
+
+
+%%venant de macros.tex
+\newcommand{\osvariant}{\@span{class=osvariant}}
+\newstyle{.osvariant}{font-family:sans-serif}
+\def\versionspecific#1{\begin{quote}{\osvariant{}#1:}\quad}
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{quote}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{quote}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\entree#1#2{#1 & #2 \\}
+\def\tableau#1#2#3{%
+\par
+\@open{div}{class="tableau"}
+\begin{center}%
+\begin{tabular*}{.8\linewidth}{#1}%
+\multicolumn{1}{c}{\textbf{#2}} &
+\multicolumn{1}{c}{\textbf{#3}} \\
+%%#2 & #3 \\%
+}%
+\def\endtableau{\end{tabular*}\end{center}\@close{div}\par}
+
+\newstyle{.tableau, .syntax, .syntaxleft}{
+ /* same width as body */
+ max-width: 750px;
+ overflow-y: auto;
+}
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+
+% PDF stuff
+
+\def\pdfchapterfold#1#2{}
+\def\pdfsection#1{}
+\def\pdfchapter{\pdfchapterfold{0}}
+
+%%% Pour camlidl
+
+\def\transl#1{$[\![\mbox{#1}]\!]$}
+
+% Pour l'index
+\usepackage{multind}
+\let\indexentry=\index
+\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
+\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
+% nth
+
+\def\th{^{\mbox{\@span{class=th}th}}}
+\newstyle{.th}{font-size:small;}
+\renewcommand{\hbox}[1]{\mbox{#1}}
+
+% Notations pour les metavariables
+\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
+\def\optvar#1{[\var{#1}\/]}
+\def\event{$\bowtie$}
+\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
+
+\newcommand{\vfill}{}
+\def\number{}
+\def\year{\arabic{year}}
+
+% Pour alltt
+\def\rminalltt#1{{\rm #1}}
+\def\goodbreak{\ \\}
+\def\@savedlistI{}
+
+%List of links with no space around items
+\newstyle{.li-links}{margin:0ex 0ex;}
+\newenvironment{links}
+{\setenvclass{itemize}{ftoc2}\setenvclass{li-itemize}{li-links}\itemize}
+{\enditemize}
+
+\newenvironment{maintitle}{\@open{div}{class="maintitle"}}{\@close{div}}
+
+%%% Linking to modules
+
+\newenvironment{linklist}{\begin{links}}{\end{links}}
+
+\ifocamldoc
+\newcommand{\moduleref}[3]{\ahref{#1/#2.html}{#3}}
+\newcommand{\stdmoduleref}[1]{\moduleref{libref}{#1}{\texttt{#1}}}
+\else
+\newcommand{\moduleref}[3]{\ahref{#1/#2/index.html}{#3}}
+\newcommand{\stdmoduleref}[1]{\moduleref{libref}{Stdlib/#1}{\texttt{#1}}}
+\fi
+\newcommand{\docitem}[3]{\item \moduleref{#1}{#2}{Module \texttt{#2}}: #3}
+\newcommand{\libdocitem}[2]{\docitem{libref}{#1}{#2}}
+\newcommand{\compilerdocitem}[2]{\docitem{compilerlibref}{#1}{#2}}
+
+%%% Missing macro
+\newcommand{\DeclareUnicodeCharacter}[2]{}
+
+\ifocamldoc
+\newcommand{\stddocitem}[2]{\libdocitem{#1}{#2}}
+\else
+\newcommand{\stddocitem}[2]{\docitem{libref/Stdlib}{#1}{#2}}
+\fi
+
+\renewcommand{\tt}{\@span{class=font-tt}}
+\newstyle{.font-tt}{font-family:monospace;}
+\renewcommand{\it}{\@span{class=font-it}}
+\newstyle{.font-it}{font-style:italic;}
+\renewcommand{\bf}{\@span{class=font-bold}}
+\newstyle{.font-bold}{font-weight:bold;}
+\renewcommand{\sl}{\ifmath\ifmathml\@span{class='sl-math'}%
+\else\@span{class="font-sl"}\fi\else\@span{class="font-sl"}\fi}
+\newstyle{.font-sl}{font-style:oblique;}
--- /dev/null
+\makeatletter
+
+% Pour hevea
+\newif\ifouthtml\outhtmlfalse
+\newcommand{\cutname}[1]{}
+% Notations pour les metavariables
+\def\var#1{{\it#1}}
+\def\nth#1#2{${\it#1}_{#2}$}
+\def\nmth#1#2#3{${\it#1}_{#2}^{#3}$}
+\def\optvar#1{\textrm{[}\var{#1}\/\textrm{]}}
+\def\event{$\bowtie$}
+\def\fromoneto#1#2{$#1 = 1, \ldots, #2$}
+
+
+% Redefining sections macros to make label mandatory
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsection
+
+\newcommand{\ocamldocinputstart}{
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+}
+
+\renewcommand{\section}{\@ifstar{\@lsectionstar}{\@lsection}}
+\renewcommand{\subsection}{\@ifstar{\@lsubsectionstar}{\@lsubsection}}
+\renewcommand{\subsubsection}{\@ifstar{\@lsubsubsectionstar}{\@lsubsubsection}}
+
+\newcommand{\@lsection}[2]{\@oldsection{\label{#1}#2}}
+\newcommand{\@lsectionstar}[2]{\@oldsection*{\label{#1}#2}}
+\newcommand{\@lsubsection}[2]{\@oldsubsection{\label{#1}#2}}
+\newcommand{\@lsubsectionstar}[2]{\@oldsubsection*{\label{#1}#2}}
+\newcommand{\@lsubsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\newcommand{\@lsubsubsectionstar}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
+% Numerotation
+\setcounter{secnumdepth}{2} % Pour numeroter les \subsection
+\setcounter{tocdepth}{1} % Pour ne pas mettre les \subsection
+ % dans la table des matieres
+
+
+\def\ttstretch{\tt\spaceskip=5.77pt plus 1.83pt minus 1.22pt}
+% La fonte cmr10 a normalement des espaces de 5.25pt non extensibles.
+% En 11 pt ca fait 5.77 pt. On lui ajoute la meme flexibilite que
+% cmr10 agrandie a 11 pt.
+
+% Pour la traduction "xxxx" -> {\machine{xxxx}} faite par texquote2
+\def\machine#1{\mbox{\ttstretch{#1}}}
+
+% Pour la traduction "\begin{verbatim}...\end{verbatim}"
+% -> "\begin{machineenv}...\end{machineenv}"
+% faite aussi par texquote2.
+\newenvironment{machineenv}{\alltt}{\endalltt}
+
+% Environnements
+
+\newlength{\versionwidth}
+\setbox0=\hbox{\bf Windows:} \setlength{\versionwidth}{\wd0}
+
+\def\versionspecific#1{
+ \begin{description}\item[#1:]~\\}
+
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{description}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{description}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\tableau#1#2#3{%
+\begin{center}
+\begin{tabular}{#1}
+\hline
+#2 & #3 \\
+\hline
+}
+\def\endtableau{\hline\end{tabular}\end{center}}
+\def\entree#1#2{#1 & #2 \\}
+
+% L'environnement option
+
+\def\optionitem[#1]{\if@noparitem \@donoparitem
+ \else \if@inlabel \indent \par \fi
+ \ifhmode \unskip\unskip \par \fi
+ \if@newlist \if@nobreak \@nbitem \else
+ \addpenalty\@beginparpenalty
+ \addvspace\@topsep \addvspace{-\parskip}\fi
+ \else \addpenalty\@itempenalty \addvspace\itemsep
+ \fi
+ \global\@inlabeltrue
+\fi
+\everypar{\global\@minipagefalse\global\@newlistfalse
+ \if@inlabel\global\@inlabelfalse \hskip -\parindent \box\@labels
+ \penalty\z@ \fi
+ \everypar{}}\global\@nobreakfalse
+\if@noitemarg \@noitemargfalse \if@nmbrlist \refstepcounter{\@listctr}\fi \fi
+\setbox\@tempboxa\hbox{\makelabel{#1}}%
+\global\setbox\@labels
+\ifdim \wd\@tempboxa >\labelwidth
+ \hbox{\unhbox\@labels
+ \hskip -\leftmargin
+ \box\@tempboxa}\hfil\break
+ \else
+ \hbox{\unhbox\@labels
+ \hskip -\leftmargin
+ \hbox to\leftmargin {\makelabel{#1}\hfil}}
+ \fi
+ \ignorespaces}
+
+\def\optionlabel#1{\bf #1}
+\def\options{\list{}{\let\makelabel\optionlabel\let\@item\optionitem}}
+\def\endoptions{\endlist}
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+\def\comment{\penalty200\list{}{}\item[]}
+\def\endcomment{\endlist\penalty-100}
+
+\def\library{
+\begingroup
+\raggedright
+\let\@savedlistI=\@listI%
+\def\@listI{\leftmargin\leftmargini\parsep 0pt plus 1pt\topsep 0pt plus 2pt}%
+\itemsep 0pt
+\topsep 0pt plus 2pt
+\partopsep 0pt
+}
+
+\def\endlibrary{
+\endgroup
+}
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+% ^^A...^^A: compose l'interieur en \tt, comme \verb
+
+\catcode`\^^A=\active
+\def\ 1{%
+\begingroup\catcode``=13\@noligs\ttstretch\let\do\@makeother\dospecials%
+\def\@xobeysp{\leavevmode\penalty100\ }%
+\@vobeyspaces\frenchspacing\catcode`\^^A=\active\def\ 1{\endgroup}}
+
+% Pour l'index
+
+\let\indexentry=\index
+\def\index{\indexentry{\jobname}}
+\def\ikwd{\indexentry{\jobname.kwd}}
+
+% Les en-tetes personnalises
+
+\pagestyle{myheadings}
+\def\partmark#1{\markboth{Part \thepart. \ #1}{}}
+\def\chaptermark#1{\markright{Chapter \thechapter. \ #1}}
+
+% nth
+
+\def\th{^{\hbox{\scriptsize th}}}
+
+% Pour annuler l'espacement vertical qui suit un "verbatim"
+\def\cancelverbatim{\vspace{-\topsep}\vspace{-\parskip}}% exact.
+
+% Pour annuler l'espacement vertical entre deux \item consecutifs dans \options
+\def\cancelitemspace{\vspace{-8mm}}% determine empiriquement
+
+% Pour faire la cesure apres _ dans les identificateurs
+\def\={\discretionary{}{}{}}
+\def\cuthere{\discretionary{}{}{}}
+
+% Pour la coupure en petits documents
+
+\let\mysection=\section
+
+%%% Augmenter l'espace entre numero de section
+% et nom de section dans la table des matieres.
+
+\def\l@section{\@dottedtocline{1}{1.5em}{2.8em}} % D'origine: 2.3
+
+% Pour alltt
+
+\def\rminalltt#1{{\rm #1}}
+
+% redefinition de l'environnement alltt pour que les {} \ et % soient
+% dans la bonne fonte
+
+\let\@oldalltt=\alltt
+\let\@oldendalltt=\endalltt
+\renewenvironment{alltt}{%
+\begingroup%
+\renewcommand{\{}{\char`\{}%
+\renewcommand{\}}{\char`\}}%
+\renewcommand{\\}{\char`\\}%
+\renewcommand{\%}{\char`\%}%
+\@oldalltt%
+}{%
+\@oldendalltt%
+\endgroup%
+}
+
+% Index stuff -- cf multind.sty
+
+\def\printindex#1#2{\@restonecoltrue\if@twocolumn\@restonecolfalse\fi
+ \columnseprule \z@ \columnsep 35pt
+ \newpage \phantomsection \twocolumn[{\Large\bf #2 \vskip4ex}]
+ \markright{\uppercase{#2}}
+ \addcontentsline{toc}{chapter}{#2}
+ \@input{#1.ind}}
+
+%%% Linking to modules
+\ifocamldoc
+\newcommand{\stdmoduleref}[1]{\hyperref[#1]{\texttt{#1}}[\ref{#1}]}
+\newcommand{\stdpageref}[1]{\pageref{#1}}
+\else
+\newcommand{\stdmoduleref}[1]{\hyperref[container-page-libref-module-Stdlib-module-#1]{\texttt{#1}}[\ref{container-page-libref-module-Stdlib-module-#1}]}
+\newcommand{\stdpageref}[1]{\pageref{container-page-libref-module-Stdlib-module-#1}}
+\fi
+\newenvironment{linklist}{\begingroup\ocamldocinputstart}{\endgroup}
+
+\newcommand{\compilerdocitem}[2]{\input{library/#1.tex}}
+\newcommand{\libdocitem}[2]{\input{library/#1.tex}}
+\ifocamldoc
+\newcommand{\stddocitem}[2]{\libdocitem{#1}{#2}}
+\else
+\newcommand{\stddocitem}[2]{\libdocitem{Stdlib.#1}{#2}}
+\fi
+\newenvironment{maintitle}{\begin{center}}{\end{center}}
+
+
+
+% Caml-example related command
+\newenvironment{camlexample}[1]{}{}
+\newenvironment{caml}{}{}
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\uline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+\newcommand{\?}{\color{black}\normalsize\tt\#{}}
+
+\definecolor{gray}{gray}{0.5}
+\newcommand{\ocamlcomment}{\color{gray}\normalfont\small}
+\newcommand{\ocamlstring}{\color{gray}\bfseries}
+
+\makeatother
--- /dev/null
+\input{anchored_book.hva}
+\input{ifocamldoc}
+\input{macros.hva}
+\newif\ifouthtml\outhtmltrue
--- /dev/null
+\input{book.hva}
+\renewcommand{\@indexsection}[1]{\chapter{#1}}
+\newcommand{\black}{\htmlcolor{#000000}}
+\newcommand{\machine}{\tt}
+\newenvironment{machineenv}{\begin{alltt}}{\end{alltt}}
+\newenvironment{camlunder}{\@style{U}}{}
+\newcommand{\?}{\black\#\blue }
+
+\newcommand{\ocamltag}[2]{\begin{ocaml#1}#2\end{ocaml#1}}
+\newcommand{\ocamlkeyword}{\bfseries}
+\newcommand{\ocamlhighlight}{\bfseries\underline}
+\newcommand{\ocamlerror}{\bfseries}
+\newcommand{\ocamlwarning}{\bfseries}
+\newcommand{\ocamlcomment}{\normalfont\small}
+\newcommand{\ocamlstring}{\bfseries}
+\newenvironment{ocamllongtable}[2][]{\begin{tabular}{#2}}{\end{tabular}}
+
+\newenvironment{caml}{\begin{alltt}}{\\\end{alltt}}
+\newenvironment{camlexample}[1]{}{}
+
+\newcommand{\var}[1]{\textit{#1}}
+
+\newenvironment{library}{}{}
+\newcounter{page}
+\newenvironment{comment}{\begin{quote}}{\end{quote}}
+\newcommand{\nth}[2]{\({#1}_{#2}\)}
+\newenvironment{options}{\begin{description}}{\end{description}}
+
+% Section macros with mandatory labels
+% Note: hevea and normal latex are forked due to the use of \@ifstar on the latex side
+
+% First, we save the normal macros
+\let\@oldsection=\section
+\let\@oldsubsection=\subsection
+\let\@oldsubsubsection=\subsubsection
+% The *-version are distincts macros in hevea
+\let\@oldsection*=\section*
+\let\@oldsubsection*=\subsection*
+\let\@oldsubsubsection*=\subsubsection*
+
+%We go back to standard macros for ocamldoc generated files
+\newcommand{\ocamldocinputstart}{%
+\let\section=\@oldsection
+\let\subsection=\@oldsubsection
+\let\subsubsection=\@oldsubsubsection
+% The *-version are distincts macros in hevea
+\let\section*=\@oldsection*
+\let\subsection*=\@oldsubsection*
+\let\subsubsection*=\@oldsubsubsection*
+}
+
+\renewcommand{\section}[2]{\@oldsection{\label{#1}#2}}
+\renewcommand{\section*}[2]{\@oldsection*{\label{#1}#2}}
+\renewcommand{\subsection}[2]{\@oldsubsection{\label{#1}#2}}
+\renewcommand{\subsection*}[2]{\@oldsubsection*{\label{#1}#2}}
+\renewcommand{\subsubsection}[2]{\@oldsubsubsection{\label{#1}#2}}
+\renewcommand{\subsubsection*}[2]{\@oldsubsubsection*{\label{#1}#2}}
+
+% For paragraph, we do not make labels compulsory
+\newcommand{\lparagraph}[2]{\paragraph{\label{#1}#2}}
+
+%%venant de macros.tex
+\newif\ifouthtml\outhtmlfalse
+\def\versionspecific#1{
+\quad\textsf{#1:}
+\begin{quote}}
+
+\def\unix{\versionspecific{Unix}}
+\def\endunix{\end{quote}}
+\def\windows{\versionspecific{Windows}}
+\def\endwindows{\end{quote}}
+
+\def\requirements{\trivlist \item[\hskip\labelsep {\bf Requirements.}]}
+\def\endrequirements{\endtrivlist}
+\def\installation{\trivlist \item[\hskip\labelsep {\bf Installation.}]}
+\def\endinstallation{\endtrivlist}
+\def\troubleshooting{\trivlist \item[\hskip\labelsep {\bf Troubleshooting.}]}
+\def\endtroubleshooting{\endtrivlist}
+
+\newtheorem{gcrule}{Rule}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+%\def\entree#1#2{#1 & #2 \\}
+%\def\tableau#1#2#3{%
+%\par\begin{center}%
+%\begin{tabular}{#1}%
+%\multicolumn{1}{c}{\textbf{#2}} &
+%\multicolumn{1}{c}{\textbf{#3}} \\
+%%#2 & #3 \\%
+%}%
+%\def\endtableau{\end{tabular}\end{center}\par}
+
+% Pour les tables de priorites et autres tableaux a deux colonnes, encadres
+
+\def\tableau#1#2#3{%
+\begin{center}
+\begin{tabular}{#1}
+\hline
+\multicolumn{1}{|c|}{\textbf{#2}} & \multicolumn{1}{c|}{\textbf{#3}} \\
+\hline
+}
+\def\endtableau{\hline\end{tabular}\end{center}}
+\def\entree#1#2{#1 & #2 \\}
+
+
+
+% L'environnement library (pour composer les descriptions des modules
+% de bibliotheque).
+
+
+\def\restoreindent{\begingroup\let\@listI=\@savedlistI}
+\def\endrestoreindent{\endgroup}
+
+
+% PDF stuff
+
+\def\pdfchapterfold#1#2{}
+\def\pdfsection#1{}
+\def\pdfchapter{\pdfchapterfold{0}}
+
+%%% Pour camlidl
+
+\def\transl#1{$[\![\mbox{#1}]\!]$}
+
+% Pour l'index
+\usepackage{multind}
+\let\indexentry=\index
+\renewcommand{\index}[1]{\indexentry{\jobname}{#1}}
+\def\ikwd#1{\indexentry{\jobname.kwd}{#1}}
+
+
+% nth
+\def\th{^{\mbox{\scriptsize th}}}
+\renewcommand{\hbox}[1]{\mbox{#1}}
+
+% Notations pour les metavariables
+\def\nmth#1#2#3{\({#1}_{#2}^{#3}\)}
+\def\optvar#1{[\var{#1}\/]}
+\def\event{§§}
+\def\fromoneto#1#2{$#1 = 1,\ldots{} , #2$}
+
+\newcommand{\vfill}{}
+\def\number{}
+\def\year{2013}
+
+% Pour alltt
+
+\def\rminalltt#1{{\rm #1}}
+
+\def\goodbreak{\ \\}
+
+\def\@savedlistI{}
+
+
+% Linking to modules
+\newenvironment{linklist}{\begingroup\ocamldocinputstart}{\endgroup}
+
+\newcommand{\compilerdocitem}[2]{\input{#1.tex}}
+\newcommand{\libdocitem}[2]{\input{#1.tex}}
+\ifocamldoc
+\newcommand{\stddocitem}[2]{\libdocitem{#1}{#2}}
+\else
+\newcommand{\stddocitem}[2]{\libdocitem{Stdlib.#1}{#2}}
+\fi
+\newenvironment{maintitle}{\begin{center}}{\end{center}}
--- /dev/null
+INFO-DIR-SECTION OCaml Programming Language
+START-INFO-DIR-ENTRY
+* ocaml: (ocaml). OCaml Reference Manual
+END-INFO-DIR-ENTRY
--- /dev/null
+\documentclass[11pt]{book}
+\usepackage{ae}
+
+\usepackage[utf8]{inputenc}
+\usepackage[T1]{fontenc}
+% HEVEA\@def@charset{UTF-8}%
+% Unicode character declarations
+\DeclareUnicodeCharacter{207A}{{}^{+}}
+\DeclareUnicodeCharacter{2014}{---}
+
+\usepackage{fullpage}
+\usepackage{syntaxdef}
+\usepackage{multind}
+\usepackage{html}
+\usepackage{textcomp}
+\usepackage{ocamldoc}
+\usepackage{xspace}
+\usepackage{color}
+
+% Package for code examples:
+\usepackage{listings}
+\usepackage{alltt}
+\usepackage{lmodern}% for supporting bold ttfamily in code examples
+\usepackage[normalem]{ulem}% for underlining errors in code examples
+\input{ifocamldoc}
+\ifocamldoc\else
+\usepackage{changepage}
+\fi
+\input{macros.tex}
+% Listing environments
+\lstnewenvironment{camloutput}{
+ \lstset{
+ inputencoding=utf8,
+ extendedchars=true,
+ basicstyle=\small\ttfamily\slshape,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ keywords={[2]{val}}, keywordstyle={[2]\ocamlkeyword},
+ aboveskip=0\baselineskip,
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-output ok}
+ \lstset {basicstyle=\ttfamily}
+\else
+ \lstset{
+ upquote=true,
+ literate=%
+ {⁺}{{${}^{+}$}}1%
+ {—}{{---}}1%
+ {'"'}{\textquotesingle "\textquotesingle}3%
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlinput}{
+ \lstset{
+ inputencoding=utf8,
+ extendedchars=true,
+ basicstyle=\ttfamily,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ commentstyle=\ocamlcomment,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ moredelim=[is][\ocamlhighlight]{<<}{>>},
+ moredelim=[s][\ocamlstring]{\{|}{|\}},
+ moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
+ keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
+ belowskip=0\baselineskip
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-input}
+\else
+%not implemented in hevea: upquote and literate
+ \lstset{
+ upquote=true,
+ literate=%
+ {⁺}{{${}^{+}$}}1%
+ {—}{{---}}1%
+ {'"'}{\textquotesingle "\textquotesingle}3%
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+}
+\fi
+}{}
+
+\lstnewenvironment{camlerror}{
+ \lstset{
+ escapeinside={$}{$},
+ showstringspaces=false,
+ basicstyle=\small\ttfamily\slshape,
+ emph={Error}, emphstyle={\ocamlerror},
+ }
+\ifouthtml
+ \setenvclass{lstlisting}{pre caml-output error}
+ \lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}
+{}
+
+\lstnewenvironment{camlwarn}{
+ \lstset{
+ escapeinside={$}{$},
+ showstringspaces=false,
+ basicstyle=\small\ttfamily\slshape,
+ emph={Warning}, emphstyle={\ocamlwarning},
+ }
+\ifouthtml
+\setenvclass{lstlisting}{pre caml-output warn}
+\lstset { basicstyle=\ttfamily }
+\else
+\lstset{upquote=true}
+\fi
+}{}
+
+
+\ifocamldoc\else
+\lstnewenvironment{ocamlcodeblock}{
+ \lstset{
+ backgroundcolor = \color{lightgray},
+ basicstyle=\ttfamily,
+ showstringspaces=false,
+ language=caml,
+ escapeinside={$}{$},
+ columns=fullflexible,
+ stringstyle=\ocamlstring,
+ commentstyle=\ocamlcomment,
+ keepspaces=true,
+ keywordstyle=\ocamlkeyword,
+ moredelim=[is][\ocamlhighlight]{<<}{>>},
+ moredelim=[s][\ocamlstring]{\{|}{|\}},
+ moredelim=[s][\ocamlstring]{\{delimiter|}{|delimiter\}},
+ keywords={[2]{val,initializer,nonrec}}, keywordstyle={[2]\ocamlkeyword},
+ belowskip=0\baselineskip,
+ upquote=true,
+ literate={'"'}{\textquotesingle "\textquotesingle}3
+ {'\\"'}{\textquotesingle \textbackslash"\textquotesingle}4,
+ }
+ }{}
+
+\newcommand{\ocamltag}[2]{\begin{ocaml#1}#2\end{ocaml#1}}
+\newcommand{\ocamlcodefragment}[1]{{\ttfamily\setlength{\parindent}{0cm}%
+\raggedright#1}}
+\newcommand{\ocamlinlinecode}[1]{{\ttfamily#1}}
+\newenvironment{ocamlarrow}{}{}
+\newenvironment{ocamlexception}{\bfseries}{}
+\newenvironment{ocamlextension}{\bfseries}{}
+\newenvironment{ocamlconstructor}{\bfseries}{}
+\newenvironment{ocamltype-var}{\itshape\ttfamily}{}
+\definecolor{lightgray}{gray}{0.97}
+\definecolor{gray}{gray}{0.5}
+\newenvironment{ocamlindent}{\begin{adjustwidth}{2em}{0pt}}{\end{adjustwidth}}
+\newenvironment{ocamltabular}[1]{\begin{tabular}{#1}}%
+{\end{tabular}}
+\newcommand{\bold}[1]{{\bfseries#1}}
+\fi
+
+% Add meta tag to the generated head tag
+\ifouthtml
+\let\oldmeta=\@meta
+\renewcommand{\@meta}{
+\oldmeta
+\begin{rawhtml}
+ <meta name="viewport" content="width=device-width, initial-scale=1.0, maximum-scale=1">
+\end{rawhtml}
+}
+\fi
+
+\usepackage[colorlinks,linkcolor=blue]{hyperref}
+
+% Make _ a normal character in text mode
+% it must be the last package included
+\usepackage[strings,nohyphen]{underscore}
+
+%\makeatletter \def\@wrindex#1#2{\xdef \@indexfile{\csname #1@idxfile\endcsname}\@@wrindex#2||\\}\makeatother
+
+
+\raggedbottom
+\input{version.tex}
+%HEVEA\tocnumber
+%HEVEA\setcounter{cuttingdepth}{1}
+%HEVEA\title{The OCaml system, release \ocamlversion}
+\input{allfiles.tex}
--- /dev/null
+*.tex
+*.htex
+/extensions/*.tex
+/extensions/*.htex
--- /dev/null
+ROOTDIR = ../../..
+include $(ROOTDIR)/Makefile.common
+
+LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+ $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
+ -repo-root $(ROOTDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+EXTENSION_FILES = letrecvalues.tex recursivemodules.tex locallyabstract.tex \
+ firstclassmodules.tex moduletypeof.tex signaturesubstitution.tex \
+ modulealias.tex overridingopen.tex gadts.tex bigarray.tex \
+ attributes.tex extensionnodes.etex extensiblevariants.tex \
+ generativefunctors.tex extensionsyntax.tex inlinerecords.tex \
+ doccomments.tex indexops.tex emptyvariants.tex alerts.tex \
+ generalizedopens.tex bindingops.tex extensionnodes.tex privatetypes.tex
+
+FILES = $(addprefix extensions/,$(EXTENSION_FILES)) \
+ refman.tex lex.tex names.tex values.tex const.tex types.tex \
+ patterns.tex expr.tex typedecl.tex modtypes.tex modules.tex compunit.tex \
+ exten.tex classes.tex
+
+
+etex-files: $(FILES)
+all: $(FILES)
+
+
+%.gen.tex: %.etex
+ $(CAMLLATEX) $< -o $*_camltex.tex
+ $(TRANSF) < $*_camltex.tex > $*.transf_error.tex
+ mv $*.transf_error.tex $@
+
+%.tex: %.gen.tex
+ $(TEXQUOTE) < $< > $*.texquote_error.tex
+ mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+ rm -f *.tex
+ rm -f extensions/*.tex
--- /dev/null
+\section{s:classes}{Classes}
+%HEVEA\cutname{classes.html}
+Classes are defined using a small language, similar to the module
+language.
+
+\subsection{ss:classes:class-types}{Class types}
+
+Class types are the class-level equivalent of type expressions: they
+specify the general shape and type properties of classes.
+
+\ikwd{object\@\texttt{object}}
+\ikwd{end\@\texttt{end}}
+\ikwd{inherit\@\texttt{inherit}}
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+\ikwd{virtual\@\texttt{virtual}|see{\texttt{val}, \texttt{method}, \texttt{class}}}
+\ikwd{constraint\@\texttt{constraint}}
+
+\begin{syntax}
+class-type:
+ [['?']label-name':'] typexpr '->' class-type
+ | class-body-type
+;
+class-body-type:
+ 'object' ['(' typexpr ')'] {class-field-spec} 'end'
+ | ['[' typexpr {',' typexpr} ']'] classtype-path
+ | 'let' 'open' module-path 'in' class-body-type
+;
+%\end{syntax} \begin{syntax}
+class-field-spec:
+ 'inherit' class-body-type
+ | 'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr
+ | 'val' 'virtual' 'mutable' inst-var-name ':' typexpr
+ | 'method' ['private'] ['virtual'] method-name ':' poly-typexpr
+ | 'method' 'virtual' 'private' method-name ':' poly-typexpr
+ | 'constraint' typexpr '=' typexpr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+\subsubsection*{sss:clty:simple}{Simple class expressions}
+
+The expression @classtype-path@ is equivalent to the class type bound to
+the name @classtype-path@. Similarly, the expression
+@'[' typexpr_1 ',' \ldots typexpr_n ']' classtype-path@ is equivalent to
+the parametric class type bound to the name @classtype-path@, in which
+type parameters have been instantiated to respectively @typexpr_1@,
+\ldots @typexpr_n@.
+
+\subsubsection*{sss:clty-fun}{Class function type}
+
+The class type expression @typexpr '->' class-type@ is the type of
+class functions (functions from values to classes) that take as
+argument a value of type @typexpr@ and return as result a class of
+type @class-type@.
+
+\subsubsection*{sss:clty:body}{Class body type}
+
+The class type expression
+@'object' ['(' typexpr ')'] {class-field-spec} 'end'@
+is the type of a class body. It specifies its instance variables and
+methods. In this type, @typexpr@ is matched against the self type, therefore
+providing a name for the self type.
+
+A class body will match a class body type if it provides definitions
+for all the components specified in the class body type, and these
+definitions meet the type requirements given in the class body type.
+Furthermore, all methods either virtual or public present in the class
+body must also be present in the class body type (on the other hand, some
+instance variables and concrete private methods may be omitted). A
+virtual method will match a concrete method, which makes it possible
+to forget its implementation. An immutable instance variable will match a
+mutable instance variable.
+
+\subsubsection*{sss:clty-open}{Local opens}
+
+Local opens are supported in class types since OCaml 4.06.
+
+\subsubsection*{sss:clty-inheritance}{Inheritance}
+
+\ikwd{inherit\@\texttt{inherit}}
+
+The inheritance construct @'inherit' class-body-type@ provides for inclusion of
+methods and instance variables from other class types.
+The instance variable and method types from @class-body-type@ are added
+into the current class type.
+
+\subsubsection*{sss:clty-variable}{Instance variable specification}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+A specification of an instance variable is written
+@'val' ['mutable'] ['virtual'] inst-var-name ':' typexpr@, where
+@inst-var-name@
+is the name of the instance variable and @typexpr@ its expected type.
+%
+The flag @'mutable'@ indicates whether this instance variable can be
+physically modified.
+%
+The flag @'virtual'@ indicates that this instance variable is not
+initialized. It can be initialized later through inheritance.
+
+An instance variable specification will hide any previous
+specification of an instance variable of the same name.
+
+\subsubsection*{sss:clty-meth}{Method specification}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+The specification of a method is written
+@'method' ['private'] method-name ':' poly-typexpr@, where
+@method-name@ is the name of the method and @poly-typexpr@ its
+expected type, possibly polymorphic. The flag @'private'@ indicates
+that the method cannot be accessed from outside the object.
+
+The polymorphism may be left implicit in public method specifications:
+any type variable which is not bound to a class parameter and does not
+appear elsewhere inside the class specification will be assumed to be
+universal, and made polymorphic in the resulting method type.
+Writing an explicit polymorphic type will disable this behaviour.
+
+If several specifications are present for the same method, they
+must have compatible types.
+Any non-private specification of a method forces it to be public.
+
+\subsubsection*{sss:class-virtual-meth-spec}{Virtual method specification}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A virtual method specification is written @'method' ['private']
+'virtual' method-name ':' poly-typexpr@, where @method-name@ is the
+name of the method and @poly-typexpr@ its expected type.
+
+\subsubsection*{sss:class-constraints}{Constraints on type parameters}
+
+\ikwd{constraint\@\texttt{constraint}}
+
+The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
+type expressions to be equal. This is typically used to specify type
+parameters: in this way, they can be bound to specific type
+expressions.
+
+\subsection{ss:class-expr}{Class expressions}
+
+Class expressions are the class-level equivalent of value expressions:
+they evaluate to classes, thus providing implementations for the
+specifications expressed in class types.
+
+\ikwd{object\@\texttt{object}}
+\ikwd{end\@\texttt{end}}
+\ikwd{fun\@\texttt{fun}}
+\ikwd{let\@\texttt{let}}
+\ikwd{and\@\texttt{and}}
+\ikwd{inherit\@\texttt{inherit}}
+\ikwd{as\@\texttt{as}}
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+\ikwd{constraint\@\texttt{constraint}}
+\ikwd{initializer\@\texttt{initializer}}
+
+\begin{syntax}
+class-expr:
+ class-path
+ | '[' typexpr {',' typexpr} ']' class-path
+ | '(' class-expr ')'
+ | '(' class-expr ':' class-type ')'
+ | class-expr {{argument}}
+ | 'fun' {{parameter}} '->' class-expr
+ | 'let' ['rec'] let-binding {'and' let-binding} 'in' class-expr
+ | 'object' class-body 'end'
+ | 'let' 'open' module-path 'in' class-expr
+;
+%BEGIN LATEX
+\end{syntax} \begin{syntax}
+%END LATEX
+class-field:
+ 'inherit' class-expr ['as' lowercase-ident]
+ | 'inherit!' class-expr ['as' lowercase-ident]
+ | 'val' ['mutable'] inst-var-name [':' typexpr] '=' expr
+ | 'val!' ['mutable'] inst-var-name [':' typexpr] '=' expr
+ | 'val' ['mutable'] 'virtual' inst-var-name ':' typexpr
+ | 'val' 'virtual' 'mutable' inst-var-name ':' typexpr
+ | 'method' ['private'] method-name {parameter} [':' typexpr] '=' expr
+ | 'method!' ['private'] method-name {parameter} [':' typexpr] '=' expr
+ | 'method' ['private'] method-name ':' poly-typexpr '=' expr
+ | 'method!' ['private'] method-name ':' poly-typexpr '=' expr
+ | 'method' ['private'] 'virtual' method-name ':' poly-typexpr
+ | 'method' 'virtual' 'private' method-name ':' poly-typexpr
+ | 'constraint' typexpr '=' typexpr
+ | 'initializer' expr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:locally-abstract]{locally abstract types},
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+\subsubsection*{sss:class-simple}{Simple class expressions}
+
+The expression @class-path@ evaluates to the class bound to the name
+@class-path@. Similarly, the expression
+@'[' typexpr_1 ',' \ldots typexpr_n ']' class-path@
+evaluates to the parametric class bound to the name @class-path@,
+in which type parameters have been instantiated respectively to
+@typexpr_1@, \ldots @typexpr_n@.
+
+The expression @'(' class-expr ')'@ evaluates to the same module as
+@class-expr@.
+
+The expression @'(' class-expr ':' class-type ')'@ checks that
+@class-type@ matches the type of @class-expr@ (that is, that the
+implementation @class-expr@ meets the type specification
+@class-type@). The whole expression evaluates to the same class as
+@class-expr@, except that all components not specified in
+@class-type@ are hidden and can no longer be accessed.
+
+\subsubsection*{sss:class-app}{Class application}
+
+Class application is denoted by juxtaposition of (possibly labeled)
+expressions. It denotes the class whose constructor is the first
+expression applied to the given arguments. The arguments are
+evaluated as for expression application, but the constructor itself will
+only be evaluated when objects are created. In particular, side-effects
+caused by the application of the constructor will only occur at object
+creation time.
+
+\subsubsection*{sss:class-fun}{Class function}
+
+The expression @'fun' [['?']label-name':']pattern '->' class-expr@ evaluates
+to a function from values to classes.
+When this function is applied to a value \var{v}, this value is
+matched against the pattern @pattern@ and the result is the result of
+the evaluation of @class-expr@ in the extended environment.
+
+Conversion from functions with default values to functions with
+patterns only works identically for class functions as for normal
+functions.
+
+The expression
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n "->" class-expr@
+\end{center}
+is a short form for
+\begin{center}
+@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
+\end{center}
+
+\subsubsection*{sss:class-localdefs}{Local definitions}
+
+The {\tt let} and {\tt let rec} constructs bind value names locally,
+as for the core language expressions.
+
+If a local definition occurs at the very beginning of a class
+definition, it will be evaluated when the class is created (just as if
+the definition was outside of the class).
+Otherwise, it will be evaluated when the object constructor is called.
+
+\subsubsection*{sss:class-opens}{Local opens}
+
+Local opens are supported in class expressions since OCaml 4.06.
+
+\subsubsection*{sss:class-body}{Class body}
+\begin{syntax}
+class-body: ['(' pattern [':' typexpr] ')'] { class-field }
+\end{syntax}
+The expression
+@'object' class-body 'end'@ denotes
+a class body. This is the prototype for an object : it lists the
+instance variables and methods of an object of this class.
+
+A class body is a class value: it is not evaluated at once. Rather,
+its components are evaluated each time an object is created.
+
+In a class body, the pattern @'(' pattern [':' typexpr] ')'@ is
+matched against self, therefore providing a binding for self and self
+type. Self can only be used in method and initializers.
+
+Self type cannot be a closed object type, so that the class remains
+extensible.
+
+Since OCaml 4.01, it is an error if the same method or instance
+variable name is defined several times in the same class body.
+
+\subsubsection*{sss:class-inheritance}{Inheritance}
+
+\ikwd{inherit\@\texttt{inherit}}
+
+The inheritance construct @'inherit' class-expr@ allows reusing
+methods and instance variables from other classes. The class
+expression @class-expr@ must evaluate to a class body. The instance
+variables, methods and initializers from this class body are added
+into the current class. The addition of a method will override any
+previously defined method of the same name.
+
+\ikwd{as\@\texttt{as}}
+An ancestor can be bound by appending @'as' lowercase-ident@
+to the inheritance construct. @lowercase-ident@ is not a true
+variable and can only be used to select a method, i.e. in an expression
+@lowercase-ident '#' method-name@. This gives access to the
+method @method-name@ as it was defined in the parent class even if it is
+redefined in the current class.
+The scope of this ancestor binding is limited to the current class.
+The ancestor method may be called from a subclass but only indirectly.
+
+\subsubsection*{sss:class-variables}{Instance variable definition}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+The definition @'val' ['mutable'] inst-var-name '=' expr@ adds an
+instance variable @inst-var-name@ whose initial value is the value of
+expression @expr@.
+%
+The flag @'mutable'@ allows physical modification of this variable by
+methods.
+
+An instance variable can only be used in the methods and
+initializers that follow its definition.
+
+Since version 3.10, redefinitions of a visible instance variable with
+the same name do not create a new variable, but are merged, using the
+last value for initialization. They must have identical types and
+mutability.
+However, if an instance variable is hidden by
+omitting it from an interface, it will be kept distinct from
+other instance variables with the same name.
+
+\subsubsection*{sss:class-virtual-variable}{Virtual instance variable definition}
+
+\ikwd{val\@\texttt{val}}
+\ikwd{mutable\@\texttt{mutable}}
+
+A variable specification is written @'val' ['mutable'] 'virtual'
+inst-var-name ':' typexpr@. It specifies whether the variable is
+modifiable, and gives its type.
+
+Virtual instance variables were added in version 3.10.
+
+\subsubsection*{sss:class-method}{Method definition}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A method definition is written @'method' method-name '=' expr@. The
+definition of a method overrides any previous definition of this
+method. The method will be public (that is, not private) if any of
+the definition states so.
+
+A private method, @'method' 'private' method-name '=' expr@, is a
+method that can only be invoked on self (from other methods of the
+same object, defined in this class or one of its subclasses). This
+invocation is performed using the expression
+@value-name '#' method-name@, where @value-name@ is directly bound to
+self at the beginning of the class definition. Private methods do
+not appear in object types. A method may have both public and private
+definitions, but as soon as there is a public one, all subsequent
+definitions will be made public.
+
+Methods may have an explicitly polymorphic type, allowing them to be
+used polymorphically in programs (even for the same object). The
+explicit declaration may be done in one of three ways: (1) by giving an
+explicit polymorphic type in the method definition, immediately after
+the method name, {\em i.e.}
+@'method' ['private'] method-name ':' {{"'" ident}} '.' typexpr '='
+expr@; (2) by a forward declaration of the explicit polymorphic type
+through a virtual method definition; (3) by importing such a
+declaration through inheritance and/or constraining the type of {\em
+self}.
+
+Some special expressions are available in method bodies for
+manipulating instance variables and duplicating self:
+\begin{syntax}
+expr:
+ \ldots
+ | inst-var-name '<-' expr
+ | '{<' [ inst-var-name '=' expr { ';' inst-var-name '=' expr } [';'] ] '>}'
+\end{syntax}
+
+The expression @inst-var-name '<-' expr@ modifies in-place the current
+object by replacing the value associated to @inst-var-name@ by the
+value of @expr@. Of course, this instance variable must have been
+declared mutable.
+
+The expression
+@'{<' inst-var-name_1 '=' expr_1 ';' \ldots ';' inst-var-name_n '=' expr_n '>}'@
+evaluates to a copy of the current object in which the values of
+instance variables @inst-var-name_1, \ldots, inst-var-name_n@ have
+been replaced by the values of the corresponding expressions @expr_1,
+\ldots, expr_n@.
+
+\subsubsection*{sss:class-virtual-meth}{Virtual method definition}
+
+\ikwd{method\@\texttt{method}}
+\ikwd{private\@\texttt{private}}
+
+A method specification is written @'method' ['private'] 'virtual'
+method-name ':' poly-typexpr@. It specifies whether the method is
+public or private, and gives its type. If the method is intended to be
+polymorphic, the type must be explicitly polymorphic.
+
+\subsubsection*{sss:class-explicit-overriding}{Explicit overriding}
+
+Since Ocaml 3.12, the keywords @"inherit!"@, @"val!"@ and @"method!"@
+have the same semantics as @"inherit"@, @"val"@ and @"method"@, but
+they additionally require the definition they introduce to be
+overriding. Namely, @"method!"@ requires @method-name@ to be already
+defined in this class, @"val!"@ requires @inst-var-name@ to be already
+defined in this class, and @"inherit!"@ requires @class-expr@ to
+override some definitions. If no such overriding occurs, an error is
+signaled.
+
+As a side-effect, these 3 keywords avoid the warnings~7
+(method override) and~13 (instance variable override).
+Note that warning~7 is disabled by default.
+
+\subsubsection*{sss:class-type-constraints}{Constraints on type parameters}
+
+\ikwd{constraint\@\texttt{constraint}}
+The construct @'constraint' typexpr_1 '=' typexpr_2@ forces the two
+type expressions to be equals. This is typically used to specify type
+parameters: in that way they can be bound to specific type
+expressions.
+
+\subsubsection*{sss:class-initializers}{Initializers}
+
+\ikwd{initializer\@\texttt{initializer}}
+
+A class initializer @'initializer' expr@ specifies an expression that
+will be evaluated whenever an object is created from the class, once
+all its instance variables have been initialized.
+
+\subsection{ss:class-def}{Class definitions}
+\label{s:classdef}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+class-definition:
+ 'class' class-binding { 'and' class-binding }
+;
+class-binding:
+ ['virtual'] ['[' type-parameters ']'] class-name
+ {parameter} [':' class-type] \\ '=' class-expr
+;
+type-parameters:
+ "'" ident { "," "'" ident }
+\end{syntax}
+
+A class definition @'class' class-binding { 'and' class-binding }@ is
+recursive. Each @class-binding@ defines a @class-name@ that can be
+used in the whole expression except for inheritance. It can also be
+used for inheritance, but only in the definitions that follow its own.
+
+A class binding binds the class name @class-name@ to the value of
+expression @class-expr@. It also binds the class type @class-name@ to
+the type of the class, and defines two type abbreviations :
+@class-name@ and @'#' class-name@. The first one is the type of
+objects of this class, while the second is more general as it unifies
+with the type of any object belonging to a subclass (see
+section~\ref{sss:typexpr-sharp-types}).
+
+\subsubsection*{sss:class-virtual}{Virtual class}
+
+A class must be flagged virtual if one of its methods is virtual (that
+is, appears in the class type, but is not actually defined).
+Objects cannot be created from a virtual class.
+
+\subsubsection*{sss:class-type-params}{Type parameters}
+
+The class type parameters correspond to the ones of the class type and
+of the two type abbreviations defined by the class binding. They must
+be bound to actual types in the class definition using type
+constraints. So that the abbreviations are well-formed, type
+variables of the inferred type of the class must either be type
+parameters or be bound in the constraint clause.
+
+\subsection{ss:class-spec}{Class specifications}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+class-specification:
+ 'class' class-spec { 'and' class-spec }
+;
+class-spec:
+ ['virtual'] ['[' type-parameters ']'] class-name ':'
+ class-type
+\end{syntax}
+
+This is the counterpart in signatures of class definitions.
+A class specification matches a class definition if they have the same
+type parameters and their types match.
+
+\subsection{ss:classtype}{Class type definitions}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+\ikwd{and\@\texttt{and}}
+
+\begin{syntax}
+classtype-definition:
+ 'class' 'type' classtype-def
+ { 'and' classtype-def }
+;
+classtype-def:
+ ['virtual'] ['[' type-parameters ']'] class-name '=' class-body-type
+\end{syntax}
+
+A class type definition @'class' class-name '=' class-body-type@
+defines an abbreviation @class-name@ for the class body type
+@class-body-type@. As for class definitions, two type abbreviations
+@class-name@ and @'#' class-name@ are also defined. The definition can
+be parameterized by some type parameters. If any method in the class
+type body is virtual, the definition must be flagged @'virtual'@.
+
+Two class type definitions match if they have the same type parameters
+and they expand to matching types.
--- /dev/null
+\section{s:compilation-units}{Compilation units}
+%HEVEA\cutname{compunit.html}
+
+\begin{syntax}
+unit-interface: { specification [';;'] }
+;
+unit-implementation: [ module-items ]
+\end{syntax}
+
+Compilation units bridge the module system and the separate
+compilation system. A compilation unit is composed of two parts: an
+interface and an implementation. The interface contains a sequence of
+specifications, just as the inside of a @'sig' \ldots 'end'@
+signature expression. The implementation contains a sequence of
+definitions and expressions, just as the inside of a
+@'struct' \ldots 'end'@ module
+expression. A compilation unit also has a name @unit-name@, derived
+from the names of the files containing the interface and the
+implementation (see chapter~\ref{c:camlc} for more details). A
+compilation unit behaves roughly as the module definition
+\begin{center}
+@'module' unit-name ':' 'sig' unit-interface 'end' '='
+ 'struct' unit-implementation 'end'@
+\end{center}
+
+A compilation unit can refer to other compilation units by their
+names, as if they were regular modules. For instance, if "U" is a
+compilation unit that defines a type "t", other compilation units can
+refer to that type under the name "U.t"; they can also refer to "U" as
+a whole structure. Except for names of other compilation units, a unit
+interface or unit implementation must not have any other free variables.
+In other terms, the type-checking and compilation of an interface or
+implementation proceeds in the initial environment
+\begin{center}
+@name_1 ':' 'sig' specification_1 'end' \ldots
+ name_n ':' 'sig' specification_n 'end'@
+\end{center}
+where @name_1 \ldots name_n@ are the names of the other
+compilation units available in the search path (see
+chapter~\ref{c:camlc} for more details) and @specification_1 \ldots
+specification_n@ are their respective interfaces.
--- /dev/null
+\section{s:const}{Constants}
+%HEVEA\cutname{const.html}
+
+\ikwd{false\@\texttt{false}}
+\ikwd{true\@\texttt{true}}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+
+\begin{syntax}
+constant:
+ integer-literal
+ | int32-literal
+ | int64-literal
+ | nativeint-literal
+ | float-literal
+ | char-literal
+ | string-literal
+ | constr
+ | "false"
+ | "true"
+ | "("")"
+ | "begin" "end"
+ | "[""]"
+ | "[|""|]"
+ | "`"tag-name
+\end{syntax}
+See also the following language extension:
+\hyperref[ss:extension-literals]{extension literals}.
+
+The syntactic class of constants comprises literals from the four
+base types (integers, floating-point numbers, characters, character
+strings), the integer variants, and constant constructors
+from both normal and polymorphic variants, as well as the special
+constants @"false"@, @"true"@, @"("")"@,
+@"[""]"@, and @"[|""|]"@, which behave like constant constructors, and
+@"begin" "end"@, which is equivalent to @'('')'@.
--- /dev/null
+\section{s:value-expr}{Expressions}
+%HEVEA\cutname{expr.html}
+\ikwd{in\@\texttt{in}|see{\texttt{let}}}
+\ikwd{and\@\texttt{and}}
+\ikwd{rec\@\texttt{rec}|see{\texttt{let}, \texttt{module}}}
+\ikwd{let\@\texttt{let}}
+\ikwd{try\@\texttt{try}}
+\ikwd{function\@\texttt{function}}
+\ikwd{fun\@\texttt{fun}}
+\ikwd{with\@\texttt{with}}
+\ikwd{done\@\texttt{done}|see{\texttt{while}, \texttt{for}}}
+\ikwd{do\@\texttt{do}|see{\texttt{while}, \texttt{for}}}
+\ikwd{downto\@\texttt{downto}|see{\texttt{for}}}
+\ikwd{to\@\texttt{to}|see{\texttt{for}}}
+\ikwd{for\@\texttt{for}}
+\ikwd{else\@\texttt{else}|see{\texttt{if}}}
+\ikwd{then\@\texttt{then}|see{\texttt{if}}}
+\ikwd{if\@\texttt{if}}
+\ikwd{or\@\texttt{or}}
+\ikwd{match\@\texttt{match}}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+\ikwd{when\@\texttt{when}}
+\ikwd{new\@\texttt{new}}
+\ikwd{object\@\texttt{object}}
+\ikwd{lazy\@\texttt{lazy}}
+
+\begin{syntax}
+expr:
+ value-path
+ | constant
+ | '(' expr ')'
+ | 'begin' expr 'end'
+ | '(' expr ':' typexpr ')'
+ | expr {{',' expr}}
+ | constr expr
+ | "`"tag-name expr
+ | expr '::' expr
+ | '[' expr { ';' expr } [';'] ']'
+ | '[|' expr { ';' expr } [';'] '|]'
+ | '{' field [':' typexpr] ['=' expr]%
+ { ';' field [':' typexpr] ['=' expr] } [';'] '}'
+ | '{' expr 'with' field [':' typexpr] ['=' expr]%
+ { ';' field [':' typexpr] ['=' expr] } [';'] '}'
+ | expr {{ argument }}
+ | prefix-symbol expr
+ | '-' expr
+ | '-.' expr
+ | expr infix-op expr
+ | expr '.' field
+ | expr '.' field '<-' expr
+ | expr '.(' expr ')'
+ | expr '.(' expr ')' '<-' expr
+ | expr '.[' expr ']'
+ | expr '.[' expr ']' '<-' expr
+ | 'if' expr 'then' expr [ 'else' expr ]
+ | 'while' expr 'do' expr 'done'
+ | 'for' value-name '=' expr ( 'to' || 'downto' ) expr 'do' expr 'done'
+ | expr ';' expr
+ | 'match' expr 'with' pattern-matching
+ | 'function' pattern-matching
+ | 'fun' {{ parameter }} [ ':' typexpr ] '->' expr
+ | 'try' expr 'with' pattern-matching
+ | 'let' ['rec'] let-binding { 'and' let-binding } 'in' expr
+ | "let" "exception" constr-decl "in" expr
+ | 'let' 'module' module-name { '(' module-name ':' module-type ')' }
+ [ ':' module-type ] \\ '=' module-expr 'in' expr
+ | '(' expr ':>' typexpr ')'
+ | '(' expr ':' typexpr ':>' typexpr ')'
+ | 'assert' expr
+ | 'lazy' expr
+ | local-open
+ | object-expr
+;
+%BEGIN LATEX
+\end{syntax} \begin{syntax}
+%END LATEX
+argument:
+ expr
+ | '~' label-name
+ | '~' label-name ':' expr
+ | '?' label-name
+ | '?' label-name ':' expr
+;
+%\end{syntax} \begin{syntax}
+pattern-matching:
+ [ '|' ] pattern ['when' expr] '->' expr
+ { '|' pattern ['when' expr] '->' expr }
+;
+let-binding:
+ pattern '=' expr
+ | value-name { parameter } [':' typexpr] [':>' typexpr] '=' expr
+ | value-name ':' poly-typexpr '=' expr %since 3.12
+;
+parameter:
+ pattern
+ | '~' label-name
+ | '~' '(' label-name [':' typexpr] ')'
+ | '~' label-name ':' pattern
+ | '?' label-name
+ | '?' '(' label-name [':' typexpr] ['=' expr] ')'
+ | '?' label-name ':' pattern
+ | '?' label-name ':' '(' pattern [':' typexpr] ['=' expr] ')'
+;
+local-open:
+ | "let" "open" module-path "in" expr
+ | module-path '.(' expr ')'
+ | module-path '.[' expr ']'
+ | module-path '.[|' expr '|]'
+ | module-path '.{' expr '}'
+ | module-path '.{<' expr '>}'
+;
+object-expr:
+ | 'new' class-path
+ | 'object' class-body 'end'
+ | expr '#' method-name
+ | inst-var-name
+ | inst-var-name '<-' expr
+ | '{<' [ inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] } [';'] ] '>}'
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:explicit-overriding-open]{overriding in open statements},
+\hyperref[s:bigarray-access]{syntax for Bigarray access},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:index-operators]{extended indexing operators}.
+
+\subsection{ss:precedence-and-associativity}{Precedence and associativity}
+The table below shows the relative precedences and associativity of
+operators and non-closed constructions. The constructions with higher
+precedence come first. For infix and prefix symbols, we write
+``"*"\ldots'' to mean ``any symbol starting with "*"''.
+% Note that this table is duplicated in stdlib/ocaml_operators.mld,
+% these tables should be kept in sync with the one below.
+\ikwd{or\@\texttt{or}}%
+\ikwd{if\@\texttt{if}}%
+\ikwd{fun\@\texttt{fun}}%
+\ikwd{function\@\texttt{function}}%
+\ikwd{match\@\texttt{match}}%
+\ikwd{try\@\texttt{try}}%
+\ikwd{let\@\texttt{let}}%
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+\begin{tableau}{|l|l|}{Construction or operator}{Associativity}
+\entree{prefix-symbol}{--}
+\entree{". .( .[ .{" (see section~\ref{s:bigarray-access})}{--}
+\entree{"#"\ldots}{left}
+\entree{function application, constructor application, tag
+ application, "assert",
+ "lazy"}{left}
+\entree{"- -." (prefix)}{--}
+\entree{"**"\ldots" lsl lsr asr"}{right}
+\entree{"*"\ldots" /"\ldots" %"\ldots" mod land lor lxor"}{left}
+ %% "`"@ident@"`"
+\entree{"+"\ldots" -"\ldots}{left}
+\entree{"::"}{right}
+\entree{{\tt \char64}\ldots " ^"\ldots}{right}
+\entree{"="\ldots" <"\ldots" >"\ldots" |"\ldots" &"\ldots" $"\ldots" !="}{left}
+\entree{"& &&"}{right}
+\entree{"or ||"}{right}
+\entree{","}{--}
+\entree{"<- :="}{right}
+\entree{"if"}{--}
+\entree{";"}{right}
+\entree{"let match fun function try"}{--}
+\end{tableau}
+
+It is simple to test or refresh one's understanding:
+
+\begin{caml_example}{toplevel}
+3 + 3 mod 2, 3 + (3 mod 2), (3 + 3) mod 2;;
+\end{caml_example}
+
+\subsection{ss:expr-basic}{Basic expressions}
+
+\subsubsection*{sss:expr-constants}{Constants}
+
+An expression consisting in a constant evaluates to this constant. For example,
+\texttt{3.14} or \texttt{[||]}.
+
+\subsubsection*{sss:expr-var}{Value paths}
+
+An expression consisting in an access path evaluates to the value bound to
+this path in the current evaluation environment. The path can
+be either a value name or an access path to a value component of a module.
+
+\begin{caml_example}{toplevel}
+Float.ArrayLabels.to_list;;
+\end{caml_example}
+
+\subsubsection*{sss:expr-parenthesized}{Parenthesized expressions}
+\ikwd{begin\@\texttt{begin}}
+\ikwd{end\@\texttt{end}}
+
+The expressions @'(' expr ')'@ and @'begin' expr 'end'@ have the same
+value as @expr@. The two constructs are semantically equivalent, but it
+is good style to use @'begin' \ldots 'end'@ inside control structures:
+\begin{alltt}
+ if \ldots then begin \ldots ; \ldots end else begin \ldots ; \ldots end
+\end{alltt}
+and @'(' \ldots ')'@ for the other grouping situations.
+
+\begin{caml_example}{toplevel}
+let x = 1 + 2 * 3
+let y = (1 + 2) * 3;;
+\end{caml_example}
+
+\begin{caml_example}{toplevel}
+let f a b =
+ if a = b then
+ print_endline "Equal"
+ else begin
+ print_string "Not Equal: ";
+ print_int a;
+ print_string " and ";
+ print_int b;
+ print_newline ()
+ end;;
+\end{caml_example}
+
+Parenthesized expressions can contain a type constraint, as in @'('
+expr ':' typexpr ')'@. This constraint forces the type of @expr@ to be
+compatible with @typexpr@.
+
+Parenthesized expressions can also contain coercions
+@'(' expr [':' typexpr] ':>' typexpr')'@ (see
+subsection~\ref{ss:expr-coercions} below).
+
+
+\subsubsection*{sss:expr-functions-application}{Function application}
+
+Function application is denoted by juxtaposition of (possibly labeled)
+expressions. The expression @expr argument_1 \ldots argument_n@
+evaluates the expression @expr@ and those appearing in @argument_1@
+to @argument_n@. The expression @expr@ must evaluate to a
+functional value $f$, which is then applied to the values of
+@argument_1, \ldots, argument_n@.
+
+The order in which the expressions @expr, argument_1, \ldots,
+argument_n@ are evaluated is not specified.
+
+\begin{caml_example}{toplevel}
+List.fold_left ( + ) 0 [1; 2; 3; 4; 5];;
+\end{caml_example}
+
+Arguments and parameters are matched according to their respective
+labels. Argument order is irrelevant, except among arguments with the
+same label, or no label.
+
+\begin{caml_example}{toplevel}
+ListLabels.fold_left ~f:( @ ) ~init:[] [[1; 2; 3]; [4; 5; 6]; [7; 8; 9]];;
+\end{caml_example}
+
+If a parameter is specified as optional (label prefixed by @"?"@) in the
+type of @expr@, the corresponding argument will be automatically
+wrapped with the constructor "Some", except if the argument itself is
+also prefixed by @"?"@, in which case it is passed as is.
+
+\begin{caml_example}{toplevel}
+let fullname ?title first second =
+ match title with
+ | Some t -> t ^ " " ^ first ^ " " ^ second
+ | None -> first ^ " " ^ second
+
+let name = fullname ~title:"Mrs" "Jane" "Fisher"
+
+let address ?title first second town =
+ fullname ?title first second ^ "\n" ^ town;;
+\end{caml_example}
+
+If a non-labeled argument is passed, and its corresponding parameter
+is preceded by one or several optional parameters, then these
+parameters are {\em defaulted}, {\em i.e.} the value "None" will be
+passed for them.
+%
+All other missing parameters (without corresponding argument), both
+optional and non-optional, will be kept, and the result of the
+function will still be a function of these missing parameters to the
+body of $f$.
+
+\begin{caml_example}{toplevel}
+let fullname ?title first second =
+ match title with
+ | Some t -> t ^ " " ^ first ^ " " ^ second
+ | None -> first ^ " " ^ second
+
+let name = fullname "Jane" "Fisher";;
+\end{caml_example}
+
+In all cases but exact match of order and labels, without optional
+parameters, the function type should be known at the application
+point. This can be ensured by adding a type constraint. Principality
+of the derivation can be checked in the "-principal" mode.
+
+As a special case, OCaml supports "labels-omitted" full applications:
+if the function has a known arity, all the arguments are unlabeled,
+and their number matches the number of non-optional parameters, then
+labels are ignored and non-optional parameters are matched in their
+definition order. Optional arguments are defaulted. This omission of
+labels is discouraged and results in a warning, see \ref{ss:warn6}.
+
+\subsubsection*{sss:expr-function-definition}{Function definition}
+
+Two syntactic forms are provided to define functions. The first form
+is introduced by the keyword "function":
+\ikwd{function\@\texttt{function}}
+
+$$\begin{array}{rlll}
+\token{function} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|} & \ldots \\
+\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+This expression evaluates to a functional value with one argument.
+When this function is applied to a value \var{v}, this value is
+matched against each pattern @pattern_1@ to @pattern_n@.
+If one of these matchings succeeds, that is, if the value \var{v}
+matches the pattern @pattern_i@ for some \var{i},
+then the expression @expr_i@ associated to the selected pattern
+is evaluated, and its value becomes the value of the function
+application. The evaluation of @expr_i@ takes place in an
+environment enriched by the bindings performed during the matching.
+
+If several patterns match the argument \var{v}, the one that occurs
+first in the function definition is selected. If none of the patterns
+matches the argument, the exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+\begin{caml_example}{toplevel}
+(function (0, 0) -> "both zero"
+ | (0, _) -> "first only zero"
+ | (_, 0) -> "second only zero"
+ | (_, _) -> "neither zero")
+(7, 0);;
+\end{caml_example}
+
+The other form of function definition is introduced by the keyword "fun":
+\ikwd{fun\@\texttt{fun}}
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n "->" expr@
+\end{center}
+This expression is equivalent to:
+\begin{center}
+@"fun" parameter_1 "->" \ldots "fun" parameter_n "->" expr@
+\end{center}
+
+\begin{caml_example}{toplevel}
+let f = (fun a -> fun b -> fun c -> a + b + c)
+let g = (fun a b c -> a + b + c);;
+\end{caml_example}
+
+An optional type constraint @typexpr@ can be added before "->" to enforce
+the type of the result to be compatible with the constraint @typexpr@:
+\begin{center}
+@"fun" parameter_1 \ldots parameter_n ":" typexpr "->" expr@
+\end{center}
+is equivalent to
+\begin{center}
+ @"fun" parameter_1 "->" \ldots "fun" parameter_n "->" %
+ (expr ":" typexpr )@
+\end{center}
+
+Beware of the small syntactic difference between a type constraint on
+the last parameter
+\begin{center}
+ @"fun" parameter_1 \ldots (parameter_n":"typexpr)"->" expr @
+\end{center}
+and one on the result
+\begin{center}
+ @"fun" parameter_1 \ldots parameter_n":" typexpr "->" expr @
+\end{center}
+
+\begin{caml_example}{toplevel}
+let eq = fun (a : int) (b : int) -> a = b
+let eq2 = fun a b : bool -> a = b
+let eq3 = fun (a : int) (b : int) : bool -> a = b;;
+\end{caml_example}
+
+The parameter patterns @"~"lab@ and @"~("lab [":" typ]")"@
+are shorthands for respectively @"~"lab":"lab@ and
+@"~"lab":("lab [":" typ]")"@, and similarly for their optional
+counterparts.
+
+\begin{caml_example}{toplevel}
+let bool_map ~cmp:(cmp : int -> int -> bool) l =
+ List.map cmp l
+
+let bool_map' ~(cmp : int -> int -> bool) l =
+ List.map cmp l;;
+\end{caml_example}
+
+A function of the form @"fun" "?" lab ":(" pattern '=' expr_0 ')' '->'
+expr@ is equivalent to
+\begin{center}
+@"fun" "?" lab ":" ident '->'
+ "let" pattern '='
+ "match" ident "with" "Some" ident "->" ident '|' "None" '->' expr_0
+ "in" expr@
+\end{center}
+where @ident@
+is a fresh variable, except that it is unspecified when @expr_0@ is evaluated.
+
+\begin{caml_example}{toplevel}
+let open_file_for_input ?binary filename =
+ match binary with
+ | Some true -> open_in_bin filename
+ | Some false | None -> open_in filename
+
+let open_file_for_input' ?(binary=false) filename =
+ if binary then open_in_bin filename else open_in filename;;
+\end{caml_example}
+
+After these two transformations, expressions are of the form
+\begin{center}
+@"fun" [label_1] pattern_1 "->" \ldots "fun" [label_n] pattern_n "->" expr@
+\end{center}
+If we ignore labels, which will only be meaningful at function
+application, this is equivalent to
+\begin{center}
+@"function" pattern_1 "->" \ldots "function" pattern_n "->" expr@
+\end{center}
+That is, the @"fun"@ expression above evaluates to a curried function
+with \var{n} arguments: after applying this function $n$ times to the
+values @@v@_1 \ldots @v@_n@, the values will be matched
+in parallel against the patterns @pattern_1 \ldots pattern_n@.
+If the matching succeeds, the function returns the value of @expr@ in
+an environment enriched by the bindings performed during the matchings.
+If the matching fails, the exception "Match_failure" is raised.
+
+\subsubsection*{sss:guards-in-pattern-matchings}{Guards in pattern-matchings}
+
+\ikwd{when\@\texttt{when}}
+The cases of a pattern matching (in the @"function"@, @"match"@ and
+@"try"@ constructs) can include guard expressions, which are
+arbitrary boolean expressions that must evaluate to "true" for the
+match case to be selected. Guards occur just before the @"->"@ token and
+are introduced by the @"when"@ keyword:
+
+$$\begin{array}{rlll}
+\token{function} & \nt{pattern}_1 \; [\token{when} \; \nt{cond}_1] & \token{->} & \nt{expr}_1 \\
+\token{|} & \ldots \\
+\token{|} & \nt{pattern}_n \; [\token{when} \; \nt{cond}_n] & \token{->} & \nt{expr}_n
+\end{array}$$
+
+
+Matching proceeds as described before, except that if the value
+matches some pattern @pattern_i@ which has a guard @@cond@_i@, then the
+expression @@cond@_i@ is evaluated (in an environment enriched by the
+bindings performed during matching). If @@cond@_i@ evaluates to "true",
+then @expr_i@ is evaluated and its value returned as the result of the
+matching, as usual. But if @@cond@_i@ evaluates to "false", the matching
+is resumed against the patterns following @pattern_i@.
+
+\begin{caml_example}{toplevel}
+let rec repeat f = function
+ | 0 -> ()
+ | n when n > 0 -> f (); repeat f (n - 1)
+ | _ -> raise (Invalid_argument "repeat");;
+\end{caml_example}
+
+\subsubsection*{sss:expr-localdef}{Local definitions}
+
+\ikwd{let\@\texttt{let}}
+
+The @"let"@ and @"let" "rec"@ constructs bind value names locally.
+The construct
+\begin{center}
+@"let" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n "in" expr@
+\end{center}
+evaluates @expr_1 \ldots expr_n@ in some unspecified order and matches
+their values against the patterns @pattern_1 \ldots pattern_n@. If the
+matchings succeed, @expr@ is evaluated in the environment enriched by
+the bindings performed during matching, and the value of @expr@ is
+returned as the value of the whole @"let"@ expression. If one of the
+matchings fails, the exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+\begin{caml_example}{toplevel}
+let v =
+ let x = 1 in [x; x; x]
+
+let v' =
+ let a, b = (1, 2) in a + b
+
+let v'' =
+ let a = 1 and b = 2 in a + b;;
+\end{caml_example}
+
+An alternate syntax is provided to bind variables to functional
+values: instead of writing
+\begin{center}
+@"let" ident "=" "fun" parameter_1 \ldots parameter_m "->" expr@
+\end{center}
+in a @"let"@ expression, one may instead write
+\begin{center}
+@"let" ident parameter_1 \ldots parameter_m "=" expr@
+\end{center}
+
+\begin{caml_example}{toplevel}
+let f = fun x -> fun y -> fun z -> x + y + z
+
+let f' = fun x y z -> x + y + z
+
+let f'' x y z = x + y + z;;
+\end{caml_example}
+
+\noindent
+Recursive definitions of names are introduced by @"let" "rec"@:
+\begin{center}
+@"let" "rec" pattern_1 "=" expr_1 "and" \ldots "and" pattern_n "=" expr_n
+ "in" expr@
+\end{center}
+
+The only difference with the @"let"@ construct described above is
+that the bindings of names to values performed by the
+pattern-matching are considered already performed when the expressions
+@expr_1@ to @expr_n@ are evaluated. That is, the expressions @expr_1@
+to @expr_n@ can reference identifiers that are bound by one of the
+patterns @pattern_1, \ldots, pattern_n@, and expect them to have the
+same value as in @expr@, the body of the @"let" "rec"@ construct.
+
+\begin{caml_example}{toplevel}
+let rec even =
+ function 0 -> true | n -> odd (n - 1)
+and odd =
+ function 0 -> false | n -> even (n - 1)
+in
+ even 1000;;
+\end{caml_example}
+
+The recursive definition is guaranteed to behave as described above if
+the expressions @expr_1@ to @expr_n@ are function definitions
+(@"fun" \ldots@ or @"function" \ldots@), and the patterns @pattern_1
+\ldots pattern_n@ are just value names, as in:
+\begin{center}
+@"let" "rec" name_1 "=" "fun" \ldots
+"and" \ldots
+"and" name_n "=" "fun" \ldots
+"in" expr@
+\end{center}
+This defines @name_1 \ldots name_n@ as mutually recursive functions
+local to @expr@.
+
+The behavior of other forms of @"let" "rec"@ definitions is
+implementation-dependent. The current implementation also supports
+a certain class of recursive definitions of non-functional values,
+as explained in section~\ref{s:letrecvalues}.
+
+It is possible to define local exceptions in expressions:
+@ "let" exception constr-decl "in" expr @ .
+
+\begin{caml_example}{toplevel}
+let map_empty_on_negative f l =
+ let exception Negative in
+ let aux x = if x < 0 then raise Negative else f x in
+ try List.map aux l with Negative -> [];;
+\end{caml_example}
+
+The syntactic scope of the exception constructor is the inner
+expression, but nothing prevents exception values created with this
+constructor from escaping this scope. Two executions of the definition
+above result in two incompatible exception constructors (as for any
+exception definition). For instance:
+
+\begin{caml_example}{toplevel}
+let gen () = let exception A in A
+
+let () = assert(gen () = gen ());;
+\end{caml_example}
+
+\subsubsection{sss:expr-explicit-polytype}{Explicit polymorphic type annotations}
+(Introduced in OCaml 3.12)
+
+Polymorphic type annotations in @"let"@-definitions behave in a way
+similar to polymorphic methods:
+
+\begin{center}
+@"let" pattern_1 ":" typ_1 \ldots typ_n "." typexpr "=" expr @
+\end{center}
+
+These annotations explicitly require the defined value to be polymorphic,
+and allow one to use this polymorphism in recursive occurrences
+(when using @"let" "rec"@). Note however that this is a normal polymorphic
+type, unifiable with any instance of itself.
+
+
+
+\subsection{ss:expr-control}{Control structures}
+
+\subsubsection*{sss:expr-sequence}{Sequence}
+
+The expression @expr_1 ";" expr_2@ evaluates @expr_1@ first, then
+@expr_2@, and returns the value of @expr_2@.
+
+\begin{caml_example}{toplevel}
+let print_pair (a, b) =
+ print_string "(";
+ print_string (string_of_int a);
+ print_string ",";
+ print_string (string_of_int b);
+ print_endline ")";;
+\end{caml_example}
+
+\subsubsection*{sss:expr-conditional}{Conditional}
+\ikwd{if\@\texttt{if}}
+
+The expression @"if" expr_1 "then" expr_2 "else" expr_3@ evaluates to
+the value of @expr_2@ if @expr_1@ evaluates to the boolean @"true"@,
+and to the value of @expr_3@ if @expr_1@ evaluates to the boolean
+@"false"@.
+
+\begin{caml_example}{toplevel}
+let rec factorial x =
+ if x <= 1 then 1 else x * factorial (x - 1);;
+\end{caml_example}
+
+The @"else" expr_3@ part can be omitted, in which case it defaults to
+@"else" "()"@.
+
+\begin{caml_example}{toplevel}
+let debug = ref false
+
+let log msg =
+ if !debug then prerr_endline msg;;
+\end{caml_example}
+
+\subsubsection*{sss:expr-case}{Case expression}\ikwd{match\@\texttt{match}}
+
+The expression
+$$\begin{array}{rlll}
+\token{match} & \textsl{expr} \\
+\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|} & \ldots \\
+\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+matches the value of @expr@ against the patterns @pattern_1@ to
+@pattern_n@. If the matching against @pattern_i@ succeeds, the
+associated expression @expr_i@ is evaluated, and its value becomes the
+value of the whole @'match'@ expression. The evaluation of
+@expr_i@ takes place in an environment enriched by the bindings
+performed during matching. If several patterns match the value of
+@expr@, the one that occurs first in the @'match'@ expression is
+selected.
+
+\begin{caml_example}{toplevel}
+let rec sum l =
+ match l with
+ | [] -> 0
+ | h :: t -> h + sum t;;
+\end{caml_example}
+
+If none of the patterns match the value of @expr@, the
+exception "Match_failure" is raised.
+%
+\index{Matchfailure\@\verb`Match_failure`}
+
+\begin{caml_example}{toplevel}[warning=8, error]
+let unoption o =
+ match o with
+ | Some x -> x
+
+let l = List.map unoption [Some 1; Some 10; None; Some 2];;
+\end{caml_example}
+
+\subsubsection*{sss:expr-boolean-operators}{Boolean operators}
+
+The expression @expr_1 '&&' expr_2@ evaluates to @'true'@ if both
+@expr_1@ and @expr_2@ evaluate to @'true'@; otherwise, it evaluates to
+@'false'@. The first component, @expr_1@, is evaluated first. The
+second component, @expr_2@, is not evaluated if the first component
+evaluates to @'false'@. Hence, the expression @expr_1 '&&' expr_2@ behaves
+exactly as
+\begin{center}
+@'if' expr_1 'then' expr_2 'else' 'false'@.
+\end{center}
+
+The expression @expr_1 '||' expr_2@ evaluates to @'true'@ if one of
+the expressions
+@expr_1@ and @expr_2@ evaluates to @'true'@; otherwise, it evaluates to
+@'false'@. The first component, @expr_1@, is evaluated first. The
+second component, @expr_2@, is not evaluated if the first component
+evaluates to @'true'@. Hence, the expression @expr_1 '||' expr_2@ behaves
+exactly as
+\begin{center}
+@'if' expr_1 'then' 'true' 'else' expr_2@.
+\end{center}
+
+\ikwd{or\@\texttt{or}}
+The boolean operators @'&'@ and @'or'@ are deprecated synonyms for
+(respectively) @'&&'@ and @'||'@.
+
+\begin{caml_example}{toplevel}
+let xor a b =
+ (a || b) && not (a && b);;
+\end{caml_example}
+
+\subsubsection*{sss:expr-loops}{Loops}
+
+\ikwd{while\@\texttt{while}}
+The expression @'while' expr_1 'do' expr_2 'done'@ repeatedly
+evaluates @expr_2@ while @expr_1@ evaluates to @'true'@. The loop
+condition @expr_1@ is evaluated and tested at the beginning of each
+iteration. The whole @'while' \ldots 'done'@ expression evaluates to
+the unit value @'()'@.
+
+\begin{caml_example}{toplevel}
+let chars_of_string s =
+ let i = ref 0 in
+ let chars = ref [] in
+ while !i < String.length s do
+ chars := s.[!i] :: !chars;
+ i := !i + 1
+ done;
+ List.rev !chars;;
+\end{caml_example}
+
+\ikwd{for\@\texttt{for}}
+The expression @'for' name '=' expr_1 'to' expr_2 'do' expr_3 'done'@
+first evaluates the expressions @expr_1@ and @expr_2@ (the boundaries)
+into integer values \var{n} and \var{p}. Then, the loop body @expr_3@ is
+repeatedly evaluated in an environment where @name@ is successively
+bound to the values
+ $n$, $n+1$, \ldots, $p-1$, $p$.
+ The loop body is never evaluated if $n > p$.
+
+\begin{caml_example}{toplevel}
+let chars_of_string s =
+ let l = ref [] in
+ for p = 0 to String.length s - 1 do
+ l := s.[p] :: !l
+ done;
+ List.rev !l;;
+\end{caml_example}
+
+The expression @'for' name '=' expr_1 'downto' expr_2 'do' expr_3 'done'@
+evaluates similarly, except that @name@ is successively bound to the values
+ $n$, $n-1$, \ldots, $p+1$, $p$.
+ The loop body is never evaluated if $n < p$.
+
+\begin{caml_example}{toplevel}
+let chars_of_string s =
+ let l = ref [] in
+ for p = String.length s - 1 downto 0 do
+ l := s.[p] :: !l
+ done;
+ !l;;
+\end{caml_example}
+
+In both cases, the whole @'for'@ expression evaluates to the unit
+value @'()'@.
+
+\subsubsection*{sss:expr-exception-handling}{Exception handling}
+\ikwd{try\@\texttt{try}}
+
+The expression
+$$\begin{array}{rlll}
+\token{try~} & \textsl{expr} \\
+\token{with} & \textsl{pattern}_1 & \token{->} & \textsl{expr}_1 \\
+\token{|} & \ldots \\
+\token{|} & \textsl{pattern}_n & \token{->} & \textsl{expr}_n
+\end{array}$$
+evaluates the expression @expr@ and returns its value if the
+evaluation of @expr@ does not raise any exception. If the evaluation
+of @expr@ raises an exception, the exception value is matched against
+the patterns @pattern_1@ to @pattern_n@. If the matching against
+@pattern_i@ succeeds, the associated expression @expr_i@ is evaluated,
+and its value becomes the value of the whole @'try'@ expression. The
+evaluation of @expr_i@ takes place in an environment enriched by the
+bindings performed during matching. If several patterns match the value of
+@expr@, the one that occurs first in the @'try'@ expression is
+selected. If none of the patterns matches the value of @expr@, the
+exception value is raised again, thereby transparently ``passing
+through'' the @'try'@ construct.
+
+\begin{caml_example}{toplevel}
+let find_opt p l =
+ try Some (List.find p l) with Not_found -> None;;
+\end{caml_example}
+
+\subsection{ss:expr-ops-on-data}{Operations on data structures}
+
+\subsubsection*{sss:expr-products}{Products}
+
+The expression @expr_1 ',' \ldots ',' expr_n@ evaluates to the
+\var{n}-tuple of the values of expressions @expr_1@ to @expr_n@. The
+evaluation order of the subexpressions is not specified.
+
+\begin{caml_example}{toplevel}
+(1 + 2 * 3, (1 + 2) * 3, 1 + (2 * 3));;
+\end{caml_example}
+
+\subsubsection*{sss:expr-variants}{Variants}
+
+The expression @constr expr@ evaluates to the unary variant value
+whose constructor is @constr@, and whose argument is the value of
+@expr@. Similarly, the expression @constr '(' expr_1 ',' \ldots ','
+expr_n ')'@ evaluates to the n-ary variant value whose constructor is
+@constr@ and whose arguments are the values of @expr_1, \ldots,
+expr_n@.
+
+The expression @constr '('expr_1, \ldots, expr_n')'@ evaluates to the
+variant value whose constructor is @constr@, and whose arguments are
+the values of @expr_1 \ldots expr_n@.
+
+\begin{caml_example}{toplevel}
+type t = Var of string | Not of t | And of t * t | Or of t * t
+
+let test = And (Var "x", Not (Or (Var "y", Var "z")));;
+\end{caml_example}
+
+For lists, some syntactic sugar is provided. The expression
+@expr_1 '::' expr_2@ stands for the constructor @'(' '::' ')' @
+applied to the arguments @'(' expr_1 ',' expr_2 ')'@, and therefore
+evaluates to the list whose head is the value of @expr_1@ and whose tail
+is the value of @expr_2@. The expression @'[' expr_1 ';' \ldots ';'
+expr_n ']'@ is equivalent to @expr_1 '::' \ldots '::' expr_n '::'
+'[]'@, and therefore evaluates to the list whose elements are the
+values of @expr_1@ to @expr_n@.
+
+\begin{caml_example}{toplevel}
+0 :: [1; 2; 3] = 0 :: 1 :: 2 :: 3 :: [];;
+\end{caml_example}
+
+\subsubsection*{sss:expr-polyvars}{Polymorphic variants}
+
+The expression @"`"tag-name expr@ evaluates to the polymorphic variant
+value whose tag is @tag-name@, and whose argument is the value of @expr@.
+
+\begin{caml_example}{toplevel}
+let with_counter x = `V (x, ref 0);;
+\end{caml_example}
+
+\subsubsection*{sss:expr-records}{Records}
+
+The expression @'{' field_1 ['=' expr_1] ';' \ldots ';' field_n ['='
+expr_n ']}'@ evaluates to the record value
+$\{ field_1 = v_1; \ldots; field_n = v_n \}$
+where $v_i$ is the value of @expr_i@ for \fromoneto{i}{n}.
+A single identifier @field_k@ stands for @field_k '=' field_k@,
+and a qualified identifier @module-path '.' field_k@ stands for
+@module-path '.' field_k '=' field_k@.
+The fields @field_1@ to @field_n@ must all belong to the same record
+type; each field of this record type must appear exactly
+once in the record expression, though they can appear in any
+order. The order in which @expr_1@ to @expr_n@ are evaluated is not
+specified. Optional type constraints can be added after each field
+@'{' field_1 ':' typexpr_1 '=' expr_1 ';'%
+ \ldots ';' field_n ':' typexpr_n '=' expr_n '}'@
+to force the type of @field_k@ to be compatible with @typexpr_k@.
+
+\begin{caml_example}{toplevel}
+type t = {house_no : int; street : string; town : string; postcode : string}
+
+let address x =
+ Printf.sprintf "The occupier\n%i %s\n%s\n%s"
+ x.house_no x.street x.town x.postcode;;
+\end{caml_example}
+
+The expression
+@"{" expr "with" field_1 ["=" expr_1] ";" \ldots ";" field_n ["=" expr_n] "}"@
+builds a fresh record with fields @field_1 \ldots field_n@ equal to
+@expr_1 \ldots expr_n@, and all other fields having the same value as
+in the record @expr@. In other terms, it returns a shallow copy of
+the record @expr@, except for the fields @field_1 \ldots field_n@,
+which are initialized to @expr_1 \ldots expr_n@. As previously,
+single identifier @field_k@ stands for @field_k '=' field_k@,
+a qualified identifier @module-path '.' field_k@ stands for
+@module-path '.' field_k '=' field_k@ and it is
+possible to add an optional type constraint on each field being updated
+with
+@"{" expr "with" field_1 ':' typexpr_1 "=" expr_1 ";" %
+ \ldots ";" field_n ':' typexpr_n "=" expr_n "}"@.
+
+\begin{caml_example}{toplevel}
+type t = {house_no : int; street : string; town : string; postcode : string}
+
+let uppercase_town address =
+ {address with town = String.uppercase_ascii address.town};;
+\end{caml_example}
+
+The expression @expr_1 '.' field@ evaluates @expr_1@ to a record
+value, and returns the value associated to @field@ in this record
+value.
+
+The expression @expr_1 '.' field '<-' expr_2@ evaluates @expr_1@ to a record
+value, which is then modified in-place by replacing the value
+associated to @field@ in this record by the value of
+@expr_2@. This operation is permitted only if @field@ has been
+declared @'mutable'@ in the definition of the record type. The whole
+expression @expr_1 '.' field '<-' expr_2@ evaluates to the unit value
+@'()'@.
+
+\begin{caml_example}{toplevel}
+type t = {mutable upper : int; mutable lower : int; mutable other : int}
+
+let stats = {upper = 0; lower = 0; other = 0}
+
+let collect =
+ String.iter
+ (function
+ | 'A'..'Z' -> stats.upper <- stats.upper + 1
+ | 'a'..'z' -> stats.lower <- stats.lower + 1
+ | _ -> stats.other <- stats.other + 1);;
+\end{caml_example}
+
+
+\subsubsection*{sss:expr-arrays}{Arrays}
+
+The expression @'[|' expr_1 ';' \ldots ';' expr_n '|]'@ evaluates to
+a \var{n}-element array, whose elements are initialized with the values of
+@expr_1@ to @expr_n@ respectively. The order in which these
+expressions are evaluated is unspecified.
+
+The expression @expr_1 '.(' expr_2 ')'@ returns the value of element
+number @expr_2@ in the array denoted by @expr_1@. The first element
+has number 0; the last element has number $n-1$, where \var{n} is the
+size of the array. The exception "Invalid_argument" is raised if the
+access is out of bounds.
+
+The expression @expr_1 '.(' expr_2 ')' '<-' expr_3@ modifies in-place
+the array denoted by @expr_1@, replacing element number @expr_2@ by
+the value of @expr_3@. The exception "Invalid_argument" is raised if
+the access is out of bounds. The value of the whole expression is @'()'@.
+
+\begin{caml_example}{toplevel}
+let scale arr n =
+ for x = 0 to Array.length arr - 1 do
+ arr.(x) <- arr.(x) * n
+ done
+
+let x = [|1; 10; 100|]
+let _ = scale x 2;;
+\end{caml_example}
+
+\subsubsection*{sss:expr-strings}{Strings}
+
+The expression @expr_1 '.[' expr_2 ']'@ returns the value of character
+number @expr_2@ in the string denoted by @expr_1@. The first character
+has number 0; the last character has number $n-1$, where \var{n} is the
+length of the string. The exception "Invalid_argument" is raised if the
+access is out of bounds.
+
+\begin{caml_example}{toplevel}
+let iter f s =
+ for x = 0 to String.length s - 1 do f s.[x] done;;
+\end{caml_example}
+
+The expression @expr_1 '.[' expr_2 ']' '<-' expr_3@ modifies in-place
+the string denoted by @expr_1@, replacing character number @expr_2@ by
+the value of @expr_3@. The exception "Invalid_argument" is raised if
+the access is out of bounds. The value of the whole expression is @'()'@.
+{\bf Note:} this possibility is offered only for backward
+compatibility with older versions of OCaml and will be removed in a
+future version. New code should use byte sequences and the "Bytes.set"
+function.
+
+\subsection{ss:expr-operators}{Operators}
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+
+Symbols from the class @infix-symbol@, as well as the keywords
+@"*"@, @"+"@, @"-"@, @'-.'@, @"="@, @"!="@, @"<"@, @">"@, @"or"@, @"||"@,
+@"&"@, @"&&"@, @":="@, @"mod"@, @"land"@, @"lor"@, @"lxor"@, @"lsl"@, @"lsr"@,
+and @"asr"@ can appear in infix position (between two
+expressions). Symbols from the class @prefix-symbol@, as well as
+the keywords @"-"@ and @"-."@
+can appear in prefix position (in front of an expression).
+
+\begin{caml_example}{toplevel}
+(( * ), ( := ), ( || ));;
+\end{caml_example}
+
+Infix and prefix symbols do not have a fixed meaning: they are simply
+interpreted as applications of functions bound to the names
+corresponding to the symbols. The expression @prefix-symbol expr@ is
+interpreted as the application @'(' prefix-symbol ')'
+expr@. Similarly, the expression @expr_1 infix-symbol expr_2@ is
+interpreted as the application @'(' infix-symbol ')' expr_1 expr_2@.
+
+The table below lists the symbols defined in the initial environment
+and their initial meaning. (See the description of the core
+library module "Stdlib" in chapter~\ref{c:corelib} for more
+details). Their meaning may be changed at any time using
+@"let" "(" infix-op ")" name_1 name_2 "=" \ldots@
+
+\begin{caml_example}{toplevel}
+let ( + ), ( - ), ( * ), ( / ) = Int64.(add, sub, mul, div);;
+\end{caml_example}
+
+Note: the operators @'&&'@, @'||'@, and @'~-'@ are handled specially
+and it is not advisable to change their meaning.
+
+The keywords @'-'@ and @'-.'@ can appear both as infix and
+prefix operators. When they appear as prefix operators, they are
+interpreted respectively as the functions @'(~-)'@ and @'(~-.)'@.
+
+%% Conversely, a regular function identifier can also be used as an infix
+%% operator by enclosing it in backquotes: @expr_1 '`' ident '`' expr_2@
+%% is interpreted as the application @ident expr_1 expr_2@.
+
+\ikwd{mod\@\texttt{mod}}%
+\ikwd{land\@\texttt{land}}%
+\ikwd{lor\@\texttt{lor}}%
+\ikwd{lxor\@\texttt{lxor}}%
+\ikwd{lsl\@\texttt{lsl}}%
+\ikwd{lsr\@\texttt{lsr}}%
+\ikwd{asr\@\texttt{asr}}%
+\begin{tableau}{|l|p{12cm}|}{Operator}{Initial meaning}
+\entree{"+"}{Integer addition.}
+\entree{"-" (infix)}{Integer subtraction.}
+\entree{"~- -" (prefix)}{Integer negation.}
+\entree{"*"}{Integer multiplication.}
+\entree{"/"}{Integer division.
+ Raise "Division_by_zero" if second argument is zero.}
+\entree{"mod"}{Integer modulus. Raise
+ "Division_by_zero" if second argument is zero.}
+\entree{"land"}{Bitwise logical ``and'' on integers.}
+\entree{"lor"}{Bitwise logical ``or'' on integers.}
+\entree{"lxor"}{Bitwise logical ``exclusive or'' on integers.}
+\entree{"lsl"}{Bitwise logical shift left on integers.}
+\entree{"lsr"}{Bitwise logical shift right on integers.}
+\entree{"asr"}{Bitwise arithmetic shift right on integers.}
+\entree{"+."}{Floating-point addition.}
+\entree{"-." (infix)}{Floating-point subtraction.}
+\entree{"~-. -." (prefix)}{Floating-point negation.}
+\entree{"*."}{Floating-point multiplication.}
+\entree{"/."}{Floating-point division.}
+\entree{"**"}{Floating-point exponentiation.}
+\entree{{\tt\char64} }{List concatenation.}
+\entree{"^" }{String concatenation.}
+\entree{"!" }{Dereferencing (return the current
+ contents of a reference).}
+\entree{":="}{Reference assignment (update the
+ reference given as first argument with the value of the second
+ argument).}
+\entree{"=" }{Structural equality test.}
+\entree{"<>" }{Structural inequality test.}
+\entree{"==" }{Physical equality test.}
+\entree{"!=" }{Physical inequality test.}
+\entree{"<" }{Test ``less than''.}
+\entree{"<=" }{Test ``less than or equal''.}
+\entree{">" }{Test ``greater than''.}
+\entree{">=" }{Test ``greater than or equal''.}
+\entree{"&& &"}{Boolean conjunction.}
+\entree{"|| or"}{Boolean disjunction.}
+\end{tableau}
+
+\subsection{ss:expr-obj}{Objects} \label{s:objects}
+
+\subsubsection*{sss:expr-obj-creation}{Object creation}
+
+\ikwd{new\@\texttt{new}}
+
+When @class-path@ evaluates to a class body, @'new' class-path@
+evaluates to a new object containing the instance variables and
+methods of this class.
+
+\begin{caml_example}{toplevel}
+class of_list (lst : int list) = object
+ val mutable l = lst
+ method next =
+ match l with
+ | [] -> raise (Failure "empty list");
+ | h::t -> l <- t; h
+end
+
+let a = new of_list [1; 1; 2; 3; 5; 8; 13]
+
+let b = new of_list;;
+\end{caml_example}
+
+When @class-path@ evaluates to a class function, @'new' class-path@
+evaluates to a function expecting the same number of arguments and
+returning a new object of this class.
+
+\subsubsection*{sss:expr-obj-immediate}{Immediate object creation}
+
+\ikwd{object\@\texttt{object}}
+
+Creating directly an object through the @'object' class-body 'end'@
+construct is operationally equivalent to defining locally a @'class'
+class-name '=' 'object' class-body 'end'@ ---see sections
+\ref{sss:class-body} and following for the syntax of @class-body@---
+and immediately creating a single object from it by @'new' class-name@.
+
+\begin{caml_example}{toplevel}
+let o =
+ object
+ val secret = 99
+ val password = "unlock"
+ method get guess = if guess <> password then None else Some secret
+ end;;
+\end{caml_example}
+
+The typing of immediate objects is slightly different from explicitly
+defining a class in two respects. First, the inferred object type may
+contain free type variables. Second, since the class body of an
+immediate object will never be extended, its self type can be unified
+with a closed object type.
+
+\subsubsection*{sss:expr-method}{Method invocation}
+
+The expression @expr '#' method-name@ invokes the method
+@method-name@ of the object denoted by @expr@.
+
+\begin{caml_example}{toplevel}
+class of_list (lst : int list) = object
+ val mutable l = lst
+ method next =
+ match l with
+ | [] -> raise (Failure "empty list");
+ | h::t -> l <- t; h
+end
+
+let a = new of_list [1; 1; 2; 3; 5; 8; 13]
+
+let third = ignore a#next; ignore a#next; a#next;;
+\end{caml_example}
+
+If @method-name@ is a polymorphic method, its type should be known at
+the invocation site. This is true for instance if @expr@ is the name
+of a fresh object (@'let' ident = 'new' class-path \dots @) or if
+there is a type constraint. Principality of the derivation can be
+checked in the "-principal" mode.
+
+\subsubsection*{sss:expr-obj-variables}{Accessing and modifying instance variables}
+
+The instance variables of a class are visible only in the body of the
+methods defined in the same class or a class that inherits from the
+class defining the instance variables. The expression @inst-var-name@
+evaluates to the value of the given instance variable. The expression
+@inst-var-name '<-' expr@ assigns the value of @expr@ to the instance
+variable @inst-var-name@, which must be mutable. The whole expression
+@inst-var-name '<-' expr@ evaluates to @"()"@.
+
+\begin{caml_example}{toplevel}
+class of_list (lst : int list) = object
+ val mutable l = lst
+ method next =
+ match l with (* access instance variable *)
+ | [] -> raise (Failure "empty list");
+ | h::t -> l <- t; h (* modify instance variable *)
+end;;
+\end{caml_example}
+
+\subsubsection*{sss:expr-obj-duplication}{Object duplication}
+
+An object can be duplicated using the library function "Oo.copy"
+(see module \stdmoduleref{Oo}). Inside a method, the expression
+@ '{<' [inst-var-name ['=' expr] { ';' inst-var-name ['=' expr] }] '>}'@
+returns a copy of self with the given instance variables replaced by
+the values of the associated expressions. A single instance variable
+name @id@ stands for @id '=' id@. Other instance variables have the same
+value in the returned object as in self.
+
+\begin{caml_example}{toplevel}
+let o =
+ object
+ val secret = 99
+ val password = "unlock"
+ method get guess = if guess <> password then None else Some secret
+ method with_new_secret s = {< secret = s >}
+ end;;
+\end{caml_example}
+
+\subsection{ss:expr-coercions}{Coercions}
+
+Expressions whose type contains object or polymorphic variant types
+can be explicitly coerced (weakened) to a supertype.
+%
+The expression @'('expr ':>' typexpr')'@ coerces the expression @expr@
+to type @typexpr@.
+%
+The expression @'('expr ':' typexpr_1 ':>' typexpr_2')'@ coerces the
+expression @expr@ from type @typexpr_1@ to type @typexpr_2@.
+
+The former operator will sometimes fail to coerce an expression @expr@
+from a type @typ_1@ to a type @typ_2@
+even if type @typ_1@ is a subtype of type
+@typ_2@: in the current implementation it only expands two levels of
+type abbreviations containing objects and/or polymorphic variants,
+keeping only recursion when it is explicit in the class type (for objects).
+As an exception to the above algorithm, if both the inferred type of @expr@
+and @typ@ are ground ({\em i.e.} do not contain type variables), the
+former operator behaves as the latter one, taking the inferred type of
+@expr@ as @typ_1@. In case of failure with the former operator,
+the latter one should be used.
+
+It is only possible to coerce an expression @expr@ from type
+@typ_1@ to type @typ_2@, if the type of @expr@ is an instance of
+@typ_1@ (like for a type annotation), and @typ_1@ is a subtype
+of @typ_2@. The type of the coerced expression is an
+instance of @typ_2@. If the types contain variables,
+they may be instantiated by the subtyping algorithm, but this is only
+done after determining whether @typ_1@ is a potential subtype of
+@typ_2@. This means that typing may fail during this latter
+unification step, even if some instance of @typ_1@ is a subtype of
+some instance of @typ_2@.
+%
+In the following paragraphs we describe the subtyping relation used.
+
+\subsubsection*{sss:expr-obj-types}{Object types}
+
+A fixed object type admits as subtype any object type that includes all
+its methods. The types of the methods shall be subtypes of those in
+the supertype. Namely,
+\begin{center}
+@ '<' met_1 ':' typ_1 ';' \dots ';' met_n ':' typ_n '>' @
+\end{center}
+is a supertype of
+\begin{center}
+@ '<' met_1 ':' typ@$'_1$@ ';' \dots ';' met_n ':' typ@$'_n$@ ';'
+met@$_{n+1}$@ ':' typ@$'_{n+1}$@ ';' \dots ';' met@$_{n+m}$@ ':' typ@$'_{n+m}$@
+~[';' '..'] '>' @
+\end{center}
+which may contain an ellipsis ".." if every @typ_i@ is a supertype of
+the corresponding @typ@$'_i$.
+
+A monomorphic method type can be a supertype of a polymorphic method
+type. Namely, if @typ@ is an instance of @typ@$'$, then @ "'"@a@_1
+\dots "'"@a@_n '.' typ@$'$ is a subtype of @typ@.
+
+Inside a class definition, newly defined types are not available for
+subtyping, as the type abbreviations are not yet completely
+defined. There is an exception for coercing @@self@@ to the (exact)
+type of its class: this is allowed if the type of @@self@@ does not
+appear in a contravariant position in the class type, {\em i.e.} if
+there are no binary methods.
+
+\subsubsection*{sss:expr-polyvar-types}{Polymorphic variant types}
+
+A polymorphic variant type @typ@ is a subtype of another polymorphic
+variant type @typ@$'$ if the upper bound of @typ@ ({\em i.e.} the
+maximum set of constructors that may appear in an instance of @typ@)
+is included in the lower bound of @typ@$'$, and the types of arguments
+for the constructors of @typ@ are subtypes of those in
+@typ@$'$. Namely,
+\begin{center}
+@ "["["<"] "`"C_1 "of" typ_1 "|" \dots "|" "`"C_n "of" typ_n "]" @
+\end{center}
+which may be a shrinkable type, is a subtype of
+\begin{center}
+@ "["[">"] "`"C_1 "of" typ@$'_1$@ "|" \dots "|" "`"C_n "of" typ@$'_n$@
+ "|" "`"C@$_{n+1}$@ "of" typ@$'_{n+1}$@ "|" \dots "|" "`"C@$_{n+m}$@ "of"
+ typ@$'_{n+m}$@ "]" @
+\end{center}
+which may be an extensible type, if every @typ_i@ is a subtype of @typ@$'_i$.
+
+\subsubsection*{sss:expr-variance}{Variance}
+
+Other types do not introduce new subtyping, but they may propagate the
+subtyping of their arguments. For instance, @typ_1 "*" typ_2@ is a
+subtype of @typ@$'_1$@ "*" typ@$'_2$ when @typ_1@ and @typ_2@ are
+respectively subtypes of @typ@$'_1$ and @typ@$'_2$.
+For function types, the relation is more subtle:
+@typ_1 "->" typ_2@ is a subtype of @typ@$'_1$@~"->" typ@$'_2$
+if @typ_1@ is a supertype of @typ@$'_1$ and @typ_2@ is a
+subtype of @typ@$'_2$. For this reason, function types are covariant in
+their second argument (like tuples), but contravariant in their first
+argument. Mutable types, like "array" or "ref" are neither covariant
+nor contravariant, they are nonvariant, that is they do not propagate
+subtyping.
+
+For user-defined types, the variance is automatically inferred: a
+parameter is covariant if it has only covariant occurrences,
+contravariant if it has only contravariant occurrences,
+variance-free if it has no occurrences, and nonvariant otherwise.
+A variance-free parameter may change freely through subtyping, it does
+not have to be a subtype or a supertype.
+%
+For abstract and private types, the variance must be given explicitly
+(see section~\ref{ss:typedefs}),
+otherwise the default is nonvariant. This is also the case for
+constrained arguments in type definitions.
+
+
+\subsection{ss:expr-other}{Other}
+
+\subsubsection*{sss:expr-assertion}{Assertion checking}
+
+
+\ikwd{assert\@\texttt{assert}}
+
+OCaml supports the @"assert"@ construct to check debugging assertions.
+The expression @"assert" expr@ evaluates the expression @expr@ and
+returns @"()"@ if @expr@ evaluates to @"true"@. If it evaluates to
+@"false"@ the exception
+"Assert_failure" is raised with the source file name and the
+location of @expr@ as arguments. Assertion
+checking can be turned off with the "-noassert" compiler option. In
+this case, @expr@ is not evaluated at all.
+
+\begin{caml_example}{toplevel}
+let f a b c =
+ assert (a <= b && b <= c);
+ (b -. a) /. (c -. b);;
+\end{caml_example}
+
+As a special case, @"assert false"@ is reduced to
+@'raise' '('@"Assert_failure ..."@')'@, which gives it a polymorphic
+type. This means that it can be used in place of any expression (for
+example as a branch of any pattern-matching). It also means that
+the @"assert false"@ ``assertions'' cannot be turned off by the
+"-noassert" option.
+%
+\index{Assertfailure\@\verb`Assert_failure`}
+
+\begin{caml_example}{toplevel}
+let min_known_nonempty = function
+ | [] -> assert false
+ | l -> List.hd (List.sort compare l);;
+\end{caml_example}
+
+\subsubsection*{sss:expr-lazy}{Lazy expressions}
+\ikwd{lazy\@\texttt{lazy}}
+
+The expression @"lazy" expr@ returns a value \var{v} of type "Lazy.t" that
+encapsulates the computation of @expr@. The argument @expr@ is not
+evaluated at this point in the program. Instead, its evaluation will
+be performed the first time the function "Lazy.force" is applied to the value
+\var{v}, returning the actual value of @expr@. Subsequent applications
+of "Lazy.force" to \var{v} do not evaluate @expr@ again. Applications
+of "Lazy.force" may be implicit through pattern matching (see~\ref{sss:pat-lazy}).
+
+\begin{caml_example}{toplevel}
+let lazy_greeter = lazy (print_string "Hello, World!\n");;
+
+Lazy.force lazy_greeter;;
+\end{caml_example}
+
+\subsubsection*{sss:expr-local-modules}{Local modules}
+\ikwd{let\@\texttt{let}}
+\ikwd{module\@\texttt{module}}
+
+The expression
+@"let" "module" module-name "=" module-expr "in" expr@
+locally binds the module expression @module-expr@ to the identifier
+@module-name@ during the evaluation of the expression @expr@.
+It then returns the value of @expr@. For example:
+\begin{caml_example}{toplevel}
+let remove_duplicates comparison_fun string_list =
+ let module StringSet =
+ Set.Make(struct type t = string
+ let compare = comparison_fun end)
+ in
+ StringSet.elements
+ (List.fold_right StringSet.add string_list StringSet.empty);;
+\end{caml_example}
+
+\subsubsection*{sss:local-opens}{Local opens}
+\ikwd{let\@\texttt{let}}
+\ikwd{module\@\texttt{open}}
+
+The expressions @"let" "open" module-path "in" expr@ and
+@module-path'.('expr')'@ are strictly equivalent. These
+constructions locally open the module referred to by the module path
+@module-path@ in the respective scope of the expression @expr@.
+
+\begin{caml_example}{toplevel}
+let map_3d_matrix f m =
+ let open Array in
+ map (map (map f)) m
+
+let map_3d_matrix' f =
+ Array.(map (map (map f)));;
+\end{caml_example}
+
+When the body of a local open expression is delimited by
+@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
+For expression, parentheses can also be omitted for @'{<' '>}'@.
+For example, @module-path'.['expr']'@ is equivalent to
+@module-path'.(['expr'])'@, and @module-path'.[|' expr '|]'@ is
+equivalent to @module-path'.([|' expr '|])'@.
+
+\begin{caml_example}{toplevel}
+let vector = Random.[|int 255; int 255; int 255; int 255|];;
+\end{caml_example}
+
+
+%% \newpage
--- /dev/null
+\chapter{Language extensions} \label{c:extensions}
+%HEVEA\cutname{extn.html}
+
+This chapter describes language extensions and convenience features
+that are implemented in OCaml, but not described in chapter \ref{c:refman}.
+
+
+%HEVEA\cutdef{section}
+\section{s:letrecvalues}{Recursive definitions of values}
+%HEVEA\cutname{letrecvalues.html}
+\input{letrecvalues.tex}
+
+\section{s:recursive-modules}{Recursive modules}
+\ikwd{module\@\texttt{module}}
+\ikwd{and\@\texttt{and}}
+%HEVEA\cutname{recursivemodules.html}
+\input{recursivemodules.tex}
+
+\section{s:private-types}{Private types}
+%HEVEA\cutname{privatetypes.html}
+\ikwd{private\@\texttt{private}}
+\input{privatetypes.tex}
+
+\section{s:locally-abstract}{Locally abstract types}
+\ikwd{type\@\texttt{type}}
+\ikwd{fun\@\texttt{fun}}
+%HEVEA\cutname{locallyabstract.html}
+\input{locallyabstract.tex}
+
+\section{s:first-class-modules}{First-class modules}
+\ikwd{module\@\texttt{module}}
+\ikwd{val\@\texttt{val}}
+\ikwd{with\@\texttt{with}}
+\ikwd{and\@\texttt{and}}
+%HEVEA\cutname{firstclassmodules.html}
+\input{firstclassmodules.tex}
+
+\section{s:module-type-of}{Recovering the type of a module}
+%HEVEA\cutname{moduletypeof.html}
+\ikwd{module\@\texttt{module}}
+\ikwd{type\@\texttt{type}}
+\ikwd{of\@\texttt{of}}
+\ikwd{include\@\texttt{include}}
+\input{moduletypeof.tex}
+
+\section{s:signature-substitution}{Substituting inside a signature}
+\ikwd{with\@\texttt{with}}
+\ikwd{module\@\texttt{module}}
+\ikwd{type\@\texttt{type}}
+%HEVEA\cutname{signaturesubstitution.html}
+\input{signaturesubstitution.tex}
+
+\section{s:module-alias}{Type-level module aliases}
+\ikwd{module\@\texttt{module}}
+%HEVEA\cutname{modulealias.html}
+\input{modulealias.tex}
+
+\section{s:explicit-overriding-open}{Overriding in open statements}
+\ikwd{open.\@\texttt{open\char33}}
+%HEVEA\cutname{overridingopen.html}
+\input{overridingopen.tex}
+
+\section{s:gadts}{Generalized algebraic datatypes} \ikwd{type\@\texttt{type}}
+\ikwd{match\@\texttt{match}}
+%HEVEA\cutname{gadts.html}
+\input{gadts.tex}
+
+\section{s:bigarray-access}{Syntax for Bigarray access}
+%HEVEA\cutname{bigarray.html}
+\input{bigarray.tex}
+
+\section{s:attributes}{Attributes}
+%HEVEA\cutname{attributes.html}
+\ikwd{when\@\texttt{when}}
+\input{attributes.tex}
+
+\section{s:extension-nodes}{Extension nodes}
+%HEVEA\cutname{extensionnodes.html}
+\input{extensionnodes.tex}
+
+\section{s:extensible-variants}{Extensible variant types}
+%HEVEA\cutname{extensiblevariants.html}
+\input{extensiblevariants.tex}
+
+\section{s:generative-functors}{Generative functors}
+%HEVEA\cutname{generativefunctors.html}
+\input{generativefunctors.tex}
+
+\section{s:extension-syntax}{Extension-only syntax}
+%HEVEA\cutname{extensionsyntax.html}
+\input{extensionsyntax.tex}
+
+\section{s:inline-records}{Inline records}
+%HEVEA\cutname{inlinerecords.html}
+\input{inlinerecords.tex}
+
+\section{s:doc-comments}{Documentation comments}
+%HEVEA\cutname{doccomments.html}
+\input{doccomments.tex}
+
+\section{s:index-operators}{Extended indexing operators }
+%HEVEA\cutname{indexops.html}
+\input{indexops.tex}
+
+\section{s:empty-variants}{Empty variant types}
+%HEVEA\cutname{emptyvariants.html}
+(Introduced in 4.07.0)
+\input{emptyvariants.tex}
+
+\section{s:alerts}{Alerts}
+%HEVEA\cutname{alerts.html}
+\input{alerts.tex}
+
+\section{s:generalized-open}{Generalized open statements}
+%HEVEA\cutname{generalizedopens.html}
+\input{generalizedopens.tex}
+
+\section{s:binding-operators}{Binding operators}
+%HEVEA\cutname{bindingops.html}
+\input{bindingops.tex}
+
+%HEVEA\cutend
--- /dev/null
+(Introduced in 4.08)
+
+Since OCaml 4.08, it is possible to mark components (such as value or
+type declarations) in signatures with ``alerts'' that will be reported
+when those components are referenced. This generalizes the notion of
+``deprecated'' components which were previously reported as warning 3.
+Those alerts can be used for instance to report usage of unsafe
+features, or of features which are only available on some platforms,
+etc.
+
+Alert categories are identified by a symbolic identifier (a lowercase
+identifier, following the usual lexical rules) and an optional
+message. The identifier is used to control which alerts are enabled,
+and which ones are turned into fatal errors. The message is reported
+to the user when the alert is triggered (i.e. when the marked
+component is referenced).
+
+The "ocaml.alert" or "alert" attribute serves two purposes: (i) to
+mark component with an alert to be triggered when the component is
+referenced, and (ii) to control which alert names are enabled. In the
+first form, the attribute takes an identifier possibly
+followed by a message. Here is an example of a value declaration marked
+with an alert:
+
+\begin{verbatim}
+module U: sig
+ val fork: unit -> bool
+ [@@alert unix "This function is only available under Unix."]
+end
+\end{verbatim}
+
+Here "unix" is the identifier for the alert. If this alert category
+is enabled, any reference to "U.fork" will produce a message at
+compile time, which can be turned or not into a fatal error.
+
+And here is another example as a floating attribute on top
+of an ``.mli'' file (i.e. before any other non-attribute item)
+or on top of an ``.ml'' file without a corresponding interface file,
+so that any reference to that unit will trigger the alert:
+
+\begin{verbatim}
+[@@@alert unsafe "This module is unsafe!"]
+\end{verbatim}
+
+
+Controlling which alerts are enabled and whether they are turned into
+fatal errors is done either through the compiler's command-line option
+"-alert <spec>" or locally in the code through the "alert" or
+"ocaml.alert" attribute taking a single string payload "<spec>". In
+both cases, the syntax for "<spec>" is a concatenation of items of the
+form:
+
+\begin{itemize}
+\item "+id" enables alert "id".
+\item "-id" disables alert "id".
+\item "++id" turns alert "id" into a fatal error.
+\item "--id" turns alert "id" into non-fatal mode.
+\item "\@id" equivalent to "++id+id" (enables "id" and turns it into a fatal-error)
+\end{itemize}
+
+As a special case, if "id" is "all", it stands for all alerts.
+
+Here are some examples:
+
+\begin{verbatim}
+
+(* Disable all alerts, reenables just unix (as a soft alert) and window
+ (as a fatal-error), for the rest of the current structure *)
+
+[@@@alert "-all--all+unix@window"]
+ ...
+
+let x =
+ (* Locally disable the window alert *)
+ begin[@alert "-window"]
+ ...
+ end
+\end{verbatim}
+
+Before OCaml 4.08, there was support for a single kind of deprecation
+alert. It is now known as the "deprecated" alert, but legacy
+attributes to trigger it and the legacy ways to control it as warning
+3 are still supported. For instance, passing "-w +3" on the
+command-line is equivant to "-alert +deprecated", and:
+
+\begin{verbatim}
+val x: int
+ [@@@ocaml.deprecated "Please do something else"]
+\end{verbatim}
+
+is equivalent to:
+
+\begin{verbatim}
+val x: int
+ [@@@ocaml.alert deprecated "Please do something else"]
+\end{verbatim}
--- /dev/null
+(Introduced in OCaml 4.02,
+infix notations for constructs other than expressions added in 4.03)
+
+Attributes are ``decorations'' of the syntax tree which are mostly
+ignored by the type-checker but can be used by external tools. An
+attribute is made of an identifier and a payload, which can be a
+structure, a type expression (prefixed with ":"), a signature
+(prefixed with ":") or a pattern (prefixed with "?") optionally
+followed by a "when" clause:
+
+
+\begin{syntax}
+attr-id:
+ lowercase-ident
+ | capitalized-ident
+ | attr-id '.' attr-id
+;
+attr-payload:
+ [ module-items ]
+ | ':' typexpr
+ | ':' [ specification ]
+ | '?' pattern ['when' expr]
+;
+\end{syntax}
+
+The first form of attributes is attached with a postfix notation on
+``algebraic'' categories:
+
+\begin{syntax}
+attribute:
+ '[@' attr-id attr-payload ']'
+;
+expr: ...
+ | expr attribute
+;
+typexpr: ...
+ | typexpr attribute
+;
+pattern: ...
+ | pattern attribute
+;
+module-expr: ...
+ | module-expr attribute
+;
+module-type: ...
+ | module-type attribute
+;
+class-expr: ...
+ | class-expr attribute
+;
+class-type: ...
+ | class-type attribute
+;
+\end{syntax}
+
+This form of attributes can also be inserted after the @'`'tag-name@
+in polymorphic variant type expressions (@tag-spec-first@, @tag-spec@,
+@tag-spec-full@) or after the @method-name@ in @method-type@.
+
+The same syntactic form is also used to attach attributes to labels and
+constructors in type declarations:
+
+\begin{syntax}
+field-decl:
+ ['mutable'] field-name ':' poly-typexpr {attribute}
+;
+constr-decl:
+ (constr-name || '()') [ 'of' constr-args ] {attribute}
+;
+\end{syntax}
+
+Note: when a label declaration is followed by a semi-colon, attributes
+can also be put after the semi-colon (in which case they are merged to
+those specified before).
+
+
+The second form of attributes are attached to ``blocks'' such as type
+declarations, class fields, etc:
+
+\begin{syntax}
+item-attribute:
+ '[@@' attr-id attr-payload ']'
+;
+typedef: ...
+ | typedef item-attribute
+;
+exception-definition:
+ 'exception' constr-decl
+ | 'exception' constr-name '=' constr
+;
+module-items:
+ [';;'] ( definition || expr { item-attribute } ) { [';;'] definition || ';;' expr { item-attribute } } [';;']
+;
+class-binding: ...
+ | class-binding item-attribute
+;
+class-spec: ...
+ | class-spec item-attribute
+;
+classtype-def: ...
+ | classtype-def item-attribute
+;
+definition:
+ 'let' ['rec'] let-binding { 'and' let-binding }
+ | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
+ | type-definition
+ | exception-definition { item-attribute }
+ | class-definition
+ | classtype-definition
+ | 'module' module-name { '(' module-name ':' module-type ')' }
+ [ ':' module-type ] \\ '=' module-expr { item-attribute }
+ | 'module' 'type' modtype-name '=' module-type { item-attribute }
+ | 'open' module-path { item-attribute }
+ | 'include' module-expr { item-attribute }
+ | 'module' 'rec' module-name ':' module-type '=' \\
+ module-expr { item-attribute } \\
+ { 'and' module-name ':' module-type '=' module-expr \\
+ { item-attribute } }
+;
+specification:
+ 'val' value-name ':' typexpr { item-attribute }
+ | 'external' value-name ':' typexpr '=' external-declaration { item-attribute }
+ | type-definition
+ | 'exception' constr-decl { item-attribute }
+ | class-specification
+ | classtype-definition
+ | 'module' module-name ':' module-type { item-attribute }
+ | 'module' module-name { '(' module-name ':' module-type ')' }
+ ':' module-type { item-attribute }
+ | 'module' 'type' modtype-name { item-attribute }
+ | 'module' 'type' modtype-name '=' module-type { item-attribute }
+ | 'open' module-path { item-attribute }
+ | 'include' module-type { item-attribute }
+;
+class-field-spec: ...
+ | class-field-spec item-attribute
+;
+class-field: ...
+ | class-field item-attribute
+;
+\end{syntax}
+
+A third form of attributes appears as stand-alone structure or
+signature items in the module or class sub-languages. They are not
+attached to any specific node in the syntax tree:
+
+\begin{syntax}
+floating-attribute:
+ '[@@@' attr-id attr-payload ']'
+;
+definition: ...
+ | floating-attribute
+;
+specification: ...
+ | floating-attribute
+;
+class-field-spec: ...
+ | floating-attribute
+;
+class-field: ...
+ | floating-attribute
+;
+\end{syntax}
+
+(Note: contrary to what the grammar above describes, @item-attributes@
+cannot be attached to these floating attributes in @class-field-spec@
+and @class-field@.)
+
+
+It is also possible to specify attributes using an infix syntax. For instance:
+
+\begin{verbatim}
+let[@foo] x = 2 in x + 1 === (let x = 2 [@@foo] in x + 1)
+begin[@foo][@bar x] ... end === (begin ... end)[@foo][@bar x]
+module[@foo] M = ... === module M = ... [@@foo]
+type[@foo] t = T === type t = T [@@foo]
+method[@foo] m = ... === method m = ... [@@foo]
+\end{verbatim}
+
+For "let", the attributes are applied to each bindings:
+
+\begin{verbatim}
+let[@foo] x = 2 and y = 3 in x + y === (let x = 2 [@@foo] and y = 3 in x + y)
+let[@foo] x = 2
+and[@bar] y = 3 in x + y === (let x = 2 [@@foo] and y = 3 [@@bar] in x + y)
+\end{verbatim}
+
+
+\subsection{ss:builtin-attributes}{Built-in attributes}
+
+Some attributes are understood by the type-checker:
+\begin{itemize}
+\item
+ ``ocaml.warning'' or ``warning'', with a string literal payload.
+ This can be used as floating attributes in a
+ signature/structure/object/object type. The string is parsed and has
+ the same effect as the "-w" command-line option, in the scope between
+ the attribute and the end of the current
+ signature/structure/object/object type. The attribute can also be
+ attached to any kind of syntactic item which support attributes
+ (such as an expression, or a type expression)
+ in which case its scope is limited to that item.
+ Note that it is not well-defined which scope is used for a specific
+ warning. This is implementation dependent and can change between versions.
+ Some warnings are even completely outside the control of ``ocaml.warning''
+ (for instance, warnings 1, 2, 14, 29 and 50).
+
+\item
+ ``ocaml.warnerror'' or ``warnerror'', with a string literal payload.
+ Same as ``ocaml.warning'', for the "-warn-error" command-line option.
+
+\item
+ ``ocaml.alert'' or ``alert'': see section~\ref{s:alerts}.
+
+\item
+ ``ocaml.deprecated'' or ``deprecated'': alias for the
+ ``deprecated'' alert, see section~\ref{s:alerts}.
+\item
+ ``ocaml.deprecated_mutable'' or ``deprecated_mutable''.
+ Can be applied to a mutable record label. If the label is later
+ used to modify the field (with ``expr.l <- expr''), the ``deprecated'' alert
+ will be triggered. If the payload of the attribute is a string literal,
+ the alert message includes this text.
+\item
+ ``ocaml.ppwarning'' or ``ppwarning'', in any context, with
+ a string literal payload. The text is reported as warning (22)
+ by the compiler (currently, the warning location is the location
+ of the string payload). This is mostly useful for preprocessors which
+ need to communicate warnings to the user. This could also be used
+ to mark explicitly some code location for further inspection.
+\item
+ ``ocaml.warn_on_literal_pattern'' or ``warn_on_literal_pattern'' annotate
+ constructors in type definition. A warning (52) is then emitted when this
+ constructor is pattern matched with a constant literal as argument. This
+ attribute denotes constructors whose argument is purely informative and
+ may change in the future. Therefore, pattern matching on this argument
+ with a constant literal is unreliable. For instance, all built-in exception
+ constructors are marked as ``warn_on_literal_pattern''.
+ Note that, due to an implementation limitation, this warning (52) is only
+ triggered for single argument constructor.
+\item
+ ``ocaml.tailcall'' or ``tailcall'' can be applied to function
+ application in order to check that the call is tailcall optimized.
+ If it it not the case, a warning (51) is emitted.
+\item
+ ``ocaml.inline'' or ``inline'' take either ``never'', ``always''
+ or nothing as payload on a function or functor definition. If no payload
+ is provided, the default value is ``always''. This payload controls when
+ applications of the annotated functions should be inlined.
+\item
+ ``ocaml.inlined'' or ``inlined'' can be applied to any function or functor
+ application to check that the call is inlined by the compiler. If the call
+ is not inlined, a warning (55) is emitted.
+\item
+ ``ocaml.noalloc'', ``ocaml.unboxed''and ``ocaml.untagged'' or
+ ``noalloc'', ``unboxed'' and ``untagged'' can be used on external
+ definitions to obtain finer control over the C-to-OCaml interface. See
+ \ref{s:C-cheaper-call} for more details.
+\item
+ ``ocaml.immediate'' or ``immediate'' applied on an abstract type mark the type as
+ having a non-pointer implementation (e.g. ``int'', ``bool'', ``char'' or
+ enumerated types). Mutation of these immediate types does not activate the
+ garbage collector's write barrier, which can significantly boost performance in
+ programs relying heavily on mutable state.
+\item
+ ``ocaml.immediate64'' or ``immediate64'' applied on an abstract type mark the
+ type as having a non-pointer implementation on 64 bit platforms. No assumption
+ is made on other platforms. In order to produce a type with the
+ ``immediate64`` attribute, one must use ``Sys.Immediate64.Make`` functor.
+\item
+ "ocaml.unboxed" or "unboxed" can be used on a type definition if the
+ type is a single-field record or a concrete type with a single
+ constructor that has a single argument. It tells the compiler to
+ optimize the representation of the type by removing the block that
+ represents the record or the constructor (i.e. a value of this type
+ is physically equal to its argument). In the case of GADTs, an
+ additional restriction applies: the argument must not be an
+ existential variable, represented by an existential type variable,
+ or an abstract type constructor applied to an existential type
+ variable.
+\item
+ "ocaml.boxed" or "boxed" can be used on type definitions to mean
+ the opposite of "ocaml.unboxed": keep the unoptimized
+ representation of the type. When there is no annotation, the
+ default is currently "boxed" but it may change in the future.
+ \item
+ "ocaml.local" or "local" take either "never", "always", "maybe" or
+ nothing as payload on a function definition. If no payload is
+ provided, the default is "always". The attribute controls an
+ optimization which consists in compiling a function into a static
+ continuation. Contrary to inlining, this optimization does not
+ duplicate the function's body. This is possible when all
+ references to the function are full applications, all sharing the
+ same continuation (for instance, the returned value of several
+ branches of a pattern matching). "never" disables the optimization,
+ "always" asserts that the optimization applies (otherwise a warning
+ 55 is emitted) and "maybe" lets the optimization apply when
+ possible (this is the default behavior when the attribute is not
+ specified). The optimization is implicitly disabled when using the
+ bytecode compiler in debug mode (-g), and for functions marked with
+ an "ocaml.inline always" or "ocaml.unrolled" attribute which
+ supersede "ocaml.local".
+\end{itemize}
+
+\begin{caml_example*}{verbatim}
+module X = struct
+ [@@@warning "+9"] (* locally enable warning 9 in this structure *)
+ [@@@ellipsis]
+end
+[@@deprecated "Please use module 'Y' instead."]
+
+let x = begin[@warning "+9"] [()[@ellipsis]] end
+
+type t = A | B
+ [@@deprecated "Please use type 's' instead."]
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}[warning=22]
+let fires_warning_22 x =
+ assert (x >= 0) [@ppwarning "TODO: remove this later"]
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}[warning=51]
+let rec is_a_tail_call = function
+ | [] -> ()
+ | _ :: q -> (is_a_tail_call[@tailcall]) q
+
+let rec not_a_tail_call = function
+ | [] -> []
+ | x :: q -> x :: (not_a_tail_call[@tailcall]) q
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}
+let f x = x [@@inline]
+
+let () = (f[@inlined]) ()
+\end{caml_example}
+
+\begin{caml_example*}{verbatim}
+type fragile =
+ | Int of int [@warn_on_literal_pattern]
+ | String of string [@warn_on_literal_pattern]
+\end{caml_example*}
+
+\begin{caml_example}{verbatim}[warning=52]
+let fragile_match_1 = function
+| Int 0 -> ()
+| _ -> ()
+\end{caml_example}
+
+\begin{caml_example}{verbatim}[warning=52]
+let fragile_match_2 = function
+| String "constant" -> ()
+| _ -> ()
+\end{caml_example}
+
+\begin{caml_example*}{verbatim}
+module Immediate: sig
+ type t [@@immediate]
+ val x: t ref
+end = struct
+ type t = A | B
+ let x = ref A
+end
+\end{caml_example*}
+
+\begin{caml_example*}{verbatim}
+module Int_or_int64 : sig
+ type t [@@immediate64]
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+end = struct
+
+ include Sys.Immediate64.Make(Int)(Int64)
+
+ module type S = sig
+ val zero : t
+ val one : t
+ val add : t -> t -> t
+ end
+
+ let impl : (module S) =
+ match repr with
+ | Immediate ->
+ (module Int : S)
+ | Non_immediate ->
+ (module Int64 : S)
+
+ include (val impl : S)
+end
+\end{caml_example*}
--- /dev/null
+(Introduced in Objective Caml 3.00)
+
+\begin{syntax}
+expr:
+ ...
+ | expr '.{' expr { ',' expr } '}'
+ | expr '.{' expr { ',' expr } '}' '<-' expr
+\end{syntax}
+
+This extension provides syntactic sugar for getting and setting
+elements in the arrays provided by the \stdmoduleref{Bigarray} module.
+
+The short expressions are translated into calls to functions of the
+"Bigarray" module as described in the following table.
+
+\begin{tableau}{|l|l|}{expression}{translation}
+\entree{@expr_0'.{'expr_1'}'@}
+ {"Bigarray.Array1.get "@expr_0 expr_1@}
+\entree{@expr_0'.{'expr_1'}' '<-'expr@}
+ {"Bigarray.Array1.set "@expr_0 expr_1 expr@}
+\entree{@expr_0'.{'expr_1',' expr_2'}'@}
+ {"Bigarray.Array2.get "@expr_0 expr_1 expr_2@}
+\entree{@expr_0'.{'expr_1',' expr_2'}' '<-'expr@}
+ {"Bigarray.Array2.set "@expr_0 expr_1 expr_2 expr@}
+\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}'@}
+ {"Bigarray.Array3.get "@expr_0 expr_1 expr_2 expr_3@}
+\entree{@expr_0'.{'expr_1',' expr_2',' expr_3'}' '<-'expr@}
+ {"Bigarray.Array3.set "@expr_0 expr_1 expr_2 expr_3 expr@}
+\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}'@}
+ {"Bigarray.Genarray.get "@ expr_0 '[|' expr_1',' \ldots ','
+ expr_n '|]'@}
+\entree{@expr_0'.{'expr_1',' \ldots',' expr_n'}' '<-'expr@}
+ {"Bigarray.Genarray.set "@ expr_0 '[|' expr_1',' \ldots ','
+ expr_n '|]' expr@}
+\end{tableau}
+
+The last two entries are valid for any $n > 3$.
--- /dev/null
+(Introduced in 4.08.0)
+
+\begin{syntax}
+let-operator:
+ | 'let' (core-operator-char || '<') { dot-operator-char }
+;
+and-operator:
+ | 'and' (core-operator-char || '<') { dot-operator-char }
+;
+operator-name :
+ ...
+ | let-operator
+ | and-operator
+;
+letop-binding :
+ pattern '=' expr
+ | value-name
+;
+expr:
+ ...
+ | let-operator letop-binding { and-operator letop-binding } in expr
+;
+\end{syntax}
+
+Users can define {\em let operators}:
+
+\begin{caml_example}{verbatim}
+let ( let* ) o f =
+ match o with
+ | None -> None
+ | Some x -> f x
+
+let return x = Some x
+\end{caml_example}
+
+and then apply them using this convenient syntax:
+
+\begin{caml_example}{verbatim}
+let find_and_sum tbl k1 k2 =
+ let* x1 = Hashtbl.find_opt tbl k1 in
+ let* x2 = Hashtbl.find_opt tbl k2 in
+ return (x1 + x2)
+\end{caml_example}
+
+which is equivalent to this expanded form:
+
+\begin{caml_example}{verbatim}
+let find_and_sum tbl k1 k2 =
+ ( let* ) (Hashtbl.find_opt tbl k1)
+ (fun x1 ->
+ ( let* ) (Hashtbl.find_opt tbl k2)
+ (fun x2 -> return (x1 + x2)))
+\end{caml_example}
+
+Users can also define {\em and operators}:
+
+\begin{caml_example}{verbatim}
+module ZipSeq = struct
+
+ type 'a t = 'a Seq.t
+
+ open Seq
+
+ let rec return x =
+ fun () -> Cons(x, return x)
+
+ let rec prod a b =
+ fun () ->
+ match a (), b () with
+ | Nil, _ | _, Nil -> Nil
+ | Cons(x, a), Cons(y, b) -> Cons((x, y), prod a b)
+
+ let ( let+ ) f s = map s f
+ let ( and+ ) a b = prod a b
+
+end
+\end{caml_example}
+
+to support the syntax:
+
+\begin{caml_example}{verbatim}
+open ZipSeq
+let sum3 z1 z2 z3 =
+ let+ x1 = z1
+ and+ x2 = z2
+ and+ x3 = z3 in
+ x1 + x2 + x3
+\end{caml_example}
+
+which is equivalent to this expanded form:
+
+\begin{caml_example}{verbatim}
+open ZipSeq
+let sum3 z1 z2 z3 =
+ ( let+ ) (( and+ ) (( and+ ) z1 z2) z3)
+ (fun ((x1, x2), x3) -> x1 + x2 + x3)
+\end{caml_example}
+
+
+\subsection{ss:letops-punning}{Short notation for variable bindings (let-punning)}
+
+(Introduced in 4.13.0)
+
+When the expression being bound is a variable, it can be convenient to
+use the shorthand notation "let+ x in ...", which expands to "let+ x =
+x in ...". This notation, also known as let-punning, allows the
+"sum3" function above can be written more concisely as:
+
+\begin{caml_example}{verbatim}
+open ZipSeq
+let sum3 z1 z2 z3 =
+ let+ z1 and+ z2 and+ z3 in
+ z1 + z2 + z3
+\end{caml_example}
+
+This notation is also supported for extension nodes, expanding
+"let%foo x in ..." to "let%foo x = x in ...". However, to avoid
+confusion, this notation is not supported for plain "let" bindings.
+
+\subsection{ss:letops-rationale}{Rationale}
+
+This extension is intended to provide a convenient syntax for working
+with monads and applicatives.
+
+An applicative should provide a module implementing the following
+interface:
+
+\begin{caml_example*}{verbatim}
+module type Applicative_syntax = sig
+ type 'a t
+ val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
+ val ( and+ ): 'a t -> 'b t -> ('a * 'b) t
+end
+\end{caml_example*}
+
+where "(let+)" is bound to the "map" operation and "(and+)" is bound to
+the monoidal product operation.
+
+A monad should provide a module implementing the following interface:
+
+\begin{caml_example*}{verbatim}
+module type Monad_syntax = sig
+ include Applicative_syntax
+ val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
+ val ( and* ): 'a t -> 'b t -> ('a * 'b) t
+end
+\end{caml_example*}
+
+where "(let*)" is bound to the "bind" operation, and "(and*)" is also
+bound to the monoidal product operation.
--- /dev/null
+(Introduced in OCaml 4.03)
+
+Comments which start with "**" are treated specially by the
+compiler. They are automatically converted during parsing into
+attributes (see \ref{s:attributes}) to allow tools to process them as
+documentation.
+
+Such comments can take three forms: {\em floating comments}, {\em item
+comments} and {\em label comments}. Any comment starting with "**" which
+does not match one of these forms will cause the compiler to emit
+warning 50.
+
+Comments which start with "**" are also used by the ocamldoc
+documentation generator (see \ref{c:ocamldoc}). The three comment forms
+recognised by the compiler are a subset of the forms accepted by
+ocamldoc (see \ref{s:ocamldoc-comments}).
+
+\subsection{ss:floating-comments}{Floating comments}
+
+Comments surrounded by blank lines that appear within structures,
+signatures, classes or class types are converted into
+@floating-attribute@s. For example:
+
+\begin{caml_example*}{verbatim}
+type t = T
+
+(** Now some definitions for [t] *)
+
+let mkT = T
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T
+
+[@@@ocaml.text " Now some definitions for [t] "]
+
+let mkT = T
+\end{caml_example*}
+
+\subsection{ss:item-comments}{Item comments}
+
+Comments which appear {\em immediately before} or {\em immediately
+after} a structure item, signature item, class item or class type item
+are converted into @item-attribute@s. Immediately before or immediately
+after means that there must be no blank lines, ";;", or other
+documentation comments between them. For example:
+
+\begin{caml_example*}{verbatim}
+type t = T
+(** A description of [t] *)
+
+\end{caml_example*}
+
+or
+
+\begin{caml_example*}{verbatim}
+
+(** A description of [t] *)
+type t = T
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T
+[@@ocaml.doc " A description of [t] "]
+\end{caml_example*}
+
+Note that, if a comment appears immediately next to multiple items,
+as in:
+
+\begin{caml_example*}{verbatim}
+type t = T
+(** An ambiguous comment *)
+type s = S
+\end{caml_example*}
+
+then it will be attached to both items:
+
+\begin{caml_example*}{verbatim}
+type t = T
+[@@ocaml.doc " An ambiguous comment "]
+type s = S
+[@@ocaml.doc " An ambiguous comment "]
+\end{caml_example*}
+
+and the compiler will emit warning 50.
+
+\subsection{ss:label-comments}{Label comments}
+
+Comments which appear {\em immediately after} a labelled argument,
+record field, variant constructor, object method or polymorphic variant
+constructor are are converted into @attribute@s. Immediately
+after means that there must be no blank lines or other documentation
+comments between them. For example:
+
+\begin{caml_example*}{verbatim}
+type t1 = lbl:int (** Labelled argument *) -> unit
+
+type t2 = {
+ fld: int; (** Record field *)
+ fld2: float;
+}
+
+type t3 =
+ | Cstr of string (** Variant constructor *)
+ | Cstr2 of string
+
+type t4 = < meth: int * int; (** Object method *) >
+
+type t5 = [
+ `PCstr (** Polymorphic variant constructor *)
+]
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t1 = lbl:(int [@ocaml.doc " Labelled argument "]) -> unit
+
+type t2 = {
+ fld: int [@ocaml.doc " Record field "];
+ fld2: float;
+}
+
+type t3 =
+ | Cstr of string [@ocaml.doc " Variant constructor "]
+ | Cstr2 of string
+
+type t4 = < meth : int * int [@ocaml.doc " Object method "] >
+
+type t5 = [
+ `PCstr [@ocaml.doc " Polymorphic variant constructor "]
+]
+\end{caml_example*}
+
+Note that label comments take precedence over item comments, so:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T of string [@ocaml.doc " Attaches to T not t "]
+\end{caml_example*}
+
+whilst:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(** Attaches to T not t *)
+(** Attaches to t *)
+\end{caml_example*}
+
+will be converted to:
+
+\begin{caml_example*}{verbatim}
+type t = T of string [@ocaml.doc " Attaches to T not t "]
+[@@ocaml.doc " Attaches to t "]
+\end{caml_example*}
+
+In the absence of meaningful comment on the last constructor of
+a type, an empty comment~"(**)" can be used instead:
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+(**)
+(** Attaches to t *)
+\end{caml_example*}
+
+will be converted directly to
+
+\begin{caml_example*}{verbatim}
+type t = T of string
+[@@ocaml.doc " Attaches to t "]
+\end{caml_example*}
--- /dev/null
+\begin{syntax}
+type-representation:
+ ...
+ | '=' '|'
+\end{syntax}
+This extension allows user to define empty variants.
+Empty variant type can be eliminated by refutation case of pattern matching.
+\begin{caml_example*}{verbatim}
+type t = |
+let f (x: t) = match x with _ -> .
+\end{caml_example*}
+
--- /dev/null
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+type-representation:
+ ...
+ | '=' '..'
+;
+specification:
+ ...
+ | 'type' [type-params] typeconstr type-extension-spec
+;
+definition:
+ ...
+ | 'type' [type-params] typeconstr type-extension-def
+;
+type-extension-spec: '+=' ['private'] ['|'] constr-decl { '|' constr-decl }
+;
+type-extension-def: '+=' ['private'] ['|'] constr-def { '|' constr-def }
+;
+constr-def:
+ constr-decl
+ | constr-name '=' constr
+;
+\end{syntax}
+
+Extensible variant types are variant types which can be extended with
+new variant constructors. Extensible variant types are defined using
+"..". New variant constructors are added using "+=".
+\begin{caml_example*}{verbatim}
+module Expr = struct
+ type attr = ..
+
+ type attr += Str of string
+
+ type attr +=
+ | Int of int
+ | Float of float
+end
+\end{caml_example*}
+
+Pattern matching on an extensible variant type requires a default case
+to handle unknown variant constructors:
+\begin{caml_example*}{verbatim}
+let to_string = function
+ | Expr.Str s -> s
+ | Expr.Int i -> Int.to_string i
+ | Expr.Float f -> string_of_float f
+ | _ -> "?"
+\end{caml_example*}
+
+A preexisting example of an extensible variant type is the built-in
+"exn" type used for exceptions. Indeed, exception constructors can be
+declared using the type extension syntax:
+\begin{caml_example*}{verbatim}
+type exn += Exc of int
+\end{caml_example*}
+
+Extensible variant constructors can be rebound to a different name. This
+allows exporting variants from another module.
+\begin{caml_example}{toplevel}[error]
+let not_in_scope = Str "Foo";;
+\end{caml_example}
+\begin{caml_example*}{verbatim}
+type Expr.attr += Str = Expr.Str
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+let now_works = Str "foo";;
+\end{caml_example}
+
+Extensible variant constructors can be declared "private". As with
+regular variants, this prevents them from being constructed directly by
+constructor application while still allowing them to be de-structured in
+pattern-matching.
+\begin{caml_example*}{verbatim}
+module B : sig
+ type Expr.attr += private Bool of int
+ val bool : bool -> Expr.attr
+end = struct
+ type Expr.attr += Bool of int
+ let bool p = if p then Bool 1 else Bool 0
+end
+\end{caml_example*}
+
+\begin{caml_example}{toplevel}
+let inspection_works = function
+ | B.Bool p -> (p = 1)
+ | _ -> true;;
+\end{caml_example}
+\begin{caml_example}{toplevel}[error]
+let construction_is_forbidden = B.Bool 1;;
+\end{caml_example}
+
+\subsection{ss:private-extensible}{Private extensible variant types}
+
+(Introduced in OCaml 4.06)
+
+\begin{syntax}
+type-representation:
+ ...
+ | '=' 'private' '..'
+;
+\end{syntax}
+
+Extensible variant types can be declared "private". This prevents new
+constructors from being declared directly, but allows extension
+constructors to be referred to in interfaces.
+\begin{caml_example*}{verbatim}
+module Msg : sig
+ type t = private ..
+ module MkConstr (X : sig type t end) : sig
+ type t += C of X.t
+ end
+end = struct
+ type t = ..
+ module MkConstr (X : sig type t end) = struct
+ type t += C of X.t
+ end
+end
+\end{caml_example*}
--- /dev/null
+(Introduced in OCaml 4.02,
+infix notations for constructs other than expressions added in 4.03,
+infix notation (e1 ;\%ext e2) added in 4.04.
+)
+
+Extension nodes are generic placeholders in the syntax tree. They are
+rejected by the type-checker and are intended to be ``expanded'' by external
+tools such as "-ppx" rewriters.
+
+Extension nodes share the same notion of identifier and payload as
+attributes~\ref{s:attributes}.
+
+The first form of extension node is used for ``algebraic'' categories:
+
+\begin{syntax}
+extension:
+ '[%' attr-id attr-payload ']'
+;
+expr: ...
+ | extension
+;
+typexpr: ...
+ | extension
+;
+pattern: ...
+ | extension
+;
+module-expr: ...
+ | extension
+;
+module-type: ...
+ | extension
+;
+class-expr: ...
+ | extension
+;
+class-type: ...
+ | extension
+;
+\end{syntax}
+
+A second form of extension node can be used in structures and
+signatures, both in the module and object languages:
+
+\begin{syntax}
+item-extension:
+ '[%%' attr-id attr-payload ']'
+;
+definition: ...
+ | item-extension
+;
+specification: ...
+ | item-extension
+;
+class-field-spec: ...
+ | item-extension
+;
+class-field: ...
+ | item-extension
+;
+\end{syntax}
+
+An infix form is available for extension nodes when
+the payload is of the same kind
+(expression with expression, pattern with pattern ...).
+
+Examples:
+
+\begin{verbatim}
+let%foo x = 2 in x + 1 === [%foo let x = 2 in x + 1]
+begin%foo ... end === [%foo begin ... end]
+x ;%foo 2 === [%foo x; 2]
+module%foo M = .. === [%%foo module M = ... ]
+val%foo x : t === [%%foo: val x : t]
+\end{verbatim}
+
+When this form is used together with the infix syntax for attributes,
+the attributes are considered to apply to the payload:
+
+\begin{verbatim}
+fun%foo[@bar] x -> x + 1 === [%foo (fun x -> x + 1)[@bar ] ];
+\end{verbatim}
+
+An additional shorthand "let%foo x in ..." is available for
+convenience when extension nodes are used to implement binding
+operators (See \ref{ss:letops-punning}).
+
+Furthermore, quoted strings "{|...|}" can be combined with extension nodes
+to embed foreign syntax fragments. Those fragments can be interpreted
+by a preprocessor and turned into OCaml code without requiring escaping
+quotes. A syntax shortcut is available for them:
+
+\begin{verbatim}
+{%%foo|...|} === [%%foo{|...|}]
+let x = {%foo|...|} === let x = [%foo{|...|}]
+let y = {%foo bar|...|bar} === let y = [%foo{bar|...|bar}]
+\end{verbatim}
+
+For instance, you can use "{%sql|...|}" to
+represent arbitrary SQL statements -- assuming you have a ppx-rewriter
+that recognizes the "%sql" extension.
+
+Note that the word-delimited form, for example "{sql|...|sql}", should
+not be used for signaling that an extension is in use.
+Indeed, the user cannot see from the code whether this string literal has
+different semantics than they expect. Moreover, giving semantics to a
+specific delimiter limits the freedom to change the delimiter to avoid
+escaping issues.
+
+\subsection{ss:builtin-extension-nodes}{Built-in extension nodes}
+
+(Introduced in OCaml 4.03)
+
+Some extension nodes are understood by the compiler itself:
+\begin{itemize}
+ \item
+ ``ocaml.extension_constructor'' or ``extension_constructor''
+ take as payload a constructor from an extensible variant type
+ (see \ref{s:extensible-variants}) and return its extension
+ constructor slot.
+\end{itemize}
+
+\begin{caml_example*}{verbatim}
+type t = ..
+type t += X of int | Y of string
+let x = [%extension_constructor X]
+let y = [%extension_constructor Y]
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+ x <> y;;
+\end{caml_example}
--- /dev/null
+(Introduced in OCaml 4.02.2, extended in 4.03)
+
+Some syntactic constructions are accepted during parsing and rejected
+during type checking. These syntactic constructions can therefore not
+be used directly in vanilla OCaml. However, "-ppx" rewriters and other
+external tools can exploit this parser leniency to extend the language
+with these new syntactic constructions by rewriting them to
+vanilla constructions.
+\subsection{ss:extension-operators}{Extension operators} \label{s:ext-ops}
+(Introduced in OCaml 4.02.2, extended to unary operators in OCaml 4.12.0)
+\begin{syntax}
+infix-symbol:
+ ...
+ | "#" {operator-char} "#" {operator-char || "#"}
+;
+prefix-symbol:
+ ...
+ | ('?'||'~'||'!') { operator-char } "#" { operator-char || "#"}
+;
+\end{syntax}
+
+There are two classes of operators available for extensions:
+infix operators with a name starting with a "#" character and containing more
+than one "#" character, and unary operators with a name (starting with a "?",
+"~", or "!" character) containing at least one "#" character.
+
+For instance:
+\begin{caml_example}{toplevel}[error]
+let infix x y = x##y;;
+let prefix x = !#x;;
+\end{caml_example}
+Note that both "##" and "!#" must be eliminated by a ppx rewriter to make
+this example valid.
+
+\subsection{ss:extension-literals}{Extension literals}
+(Introduced in OCaml 4.03)
+\begin{syntax}
+float-literal:
+ ...
+ | ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
+ [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+ ["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0x"||"0X")
+ ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }\\
+ ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
+ [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+ ["g"\ldots"z"||"G"\ldots"Z"]
+;
+int-literal:
+ ...
+ | ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
+ ["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
+ ["g"\ldots"z"||"G"\ldots"Z"]
+ | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
+ ["g"\ldots"z"||"G"\ldots"Z"]
+;
+\end{syntax}
+Int and float literals followed by an one-letter identifier in the
+range @["g".."z"||"G".."Z"]@ are extension-only literals.
--- /dev/null
+(Introduced in OCaml 3.12; pattern syntax and package type inference
+introduced in 4.00; structural comparison of package types introduced in 4.02.;
+fewer parens required starting from 4.05)
+
+\begin{syntax}
+typexpr:
+ ...
+ | '(''module' package-type')'
+;
+module-expr:
+ ...
+ | '(''val' expr [':' package-type]')'
+;
+expr:
+ ...
+ | '(''module' module-expr [':' package-type]')'
+;
+pattern:
+ ...
+ | '(''module' module-name [':' package-type]')'
+;
+package-type:
+ modtype-path
+ | modtype-path 'with' package-constraint { 'and' package-constraint }
+;
+package-constraint:
+ 'type' typeconstr '=' typexpr
+;
+\end{syntax}
+
+Modules are typically thought of as static components. This extension
+makes it possible to pack a module as a first-class value, which can
+later be dynamically unpacked into a module.
+
+The expression @'(' 'module' module-expr ':' package-type ')'@ converts the
+module (structure or functor) denoted by module expression @module-expr@
+to a value of the core language that encapsulates this module. The
+type of this core language value is @'(' 'module' package-type ')'@.
+The @package-type@ annotation can be omitted if it can be inferred
+from the context.
+
+Conversely, the module expression @'(' 'val' expr ':' package-type ')'@
+evaluates the core language expression @expr@ to a value, which must
+have type @'module' package-type@, and extracts the module that was
+encapsulated in this value. Again @package-type@ can be omitted if the
+type of @expr@ is known.
+If the module expression is already parenthesized, like the arguments
+of functors are, no additional parens are needed: "Map.Make(val key)".
+
+The pattern @'(' 'module' module-name ':' package-type ')'@ matches a
+package with type @package-type@ and binds it to @module-name@.
+It is not allowed in toplevel let bindings.
+Again @package-type@ can be omitted if it can be inferred from the
+enclosing pattern.
+
+The @package-type@ syntactic class appearing in the @'(' 'module'
+package-type ')'@ type expression and in the annotated forms represents a
+subset of module types.
+This subset consists of named module types with optional constraints
+of a limited form: only non-parametrized types can be specified.
+
+For type-checking purposes (and starting from OCaml 4.02), package types
+are compared using the structural comparison of module types.
+
+In general, the module expression @'(' "val" expr ":" package-type
+')'@ cannot be used in the body of a functor, because this could cause
+unsoundness in conjunction with applicative functors.
+Since OCaml 4.02, this is relaxed in two ways:
+if @package-type@ does not contain nominal type declarations ({\em
+ i.e.} types that are created with a proper identity), then this
+expression can be used anywhere, and even if it contains such types
+it can be used inside the body of a generative
+functor, described in section~\ref{s:generative-functors}.
+It can also be used anywhere in the context of a local module binding
+@'let' 'module' module-name '=' '(' "val" expr_1 ":" package-type ')'
+ "in" expr_2@.
+
+\lparagraph{p:fst-mod-example}{Basic example} A typical use of first-class modules is to
+select at run-time among several implementations of a signature.
+Each implementation is a structure that we can encapsulate as a
+first-class module, then store in a data structure such as a hash
+table:
+\begin{caml_example*}{verbatim}
+type picture = unit[@ellipsis]
+module type DEVICE = sig
+ val draw : picture -> unit
+ [@@@ellipsis]
+end
+let devices : (string, (module DEVICE)) Hashtbl.t = Hashtbl.create 17
+
+module SVG = struct let draw () = () [@@ellipsis] end
+let _ = Hashtbl.add devices "SVG" (module SVG : DEVICE)
+
+module PDF = struct let draw () = () [@@ellipsis] end
+let _ = Hashtbl.add devices "PDF" (module PDF : DEVICE)
+\end{caml_example*}
+
+We can then select one implementation based on command-line
+arguments, for instance:
+\begin{caml_example*}{verbatim}
+let parse_cmdline () = "SVG"[@ellipsis]
+module Device =
+ (val (let device_name = parse_cmdline () in
+ try Hashtbl.find devices device_name
+ with Not_found ->
+ Printf.eprintf "Unknown device %s\n" device_name;
+ exit 2)
+ : DEVICE)
+\end{caml_example*}
+Alternatively, the selection can be performed within a function:
+\begin{caml_example*}{verbatim}
+let draw_using_device device_name picture =
+ let module Device =
+ (val (Hashtbl.find devices device_name) : DEVICE)
+ in
+ Device.draw picture
+\end{caml_example*}
+
+\lparagraph{p:fst-mod-advexamples}{Advanced examples}
+With first-class modules, it is possible to parametrize some code over the
+implementation of a module without using a functor.
+
+\begin{caml_example}{verbatim}
+let sort (type s) (module Set : Set.S with type elt = s) l =
+ Set.elements (List.fold_right Set.add l Set.empty)
+\end{caml_example}
+
+To use this function, one can wrap the "Set.Make" functor:
+
+\begin{caml_example}{verbatim}
+let make_set (type s) cmp =
+ let module S = Set.Make(struct
+ type t = s
+ let compare = cmp
+ end) in
+ (module S : Set.S with type elt = s)
+\end{caml_example}
+
+\iffalse
+Another advanced use of first-class module is to encode existential
+types. In particular, they can be used to simulate generalized
+algebraic data types (GADT). To demonstrate this, we first define a type
+of witnesses for type equalities:
+
+\begin{caml_example*}{verbatim}
+module TypEq : sig
+ type ('a, 'b) t
+ val apply: ('a, 'b) t -> 'a -> 'b
+ val refl: ('a, 'a) t
+ val sym: ('a, 'b) t -> ('b, 'a) t
+end = struct
+ type ('a, 'b) t = ('a -> 'b) * ('b -> 'a)
+ let refl = (fun x -> x), (fun x -> x)
+ let apply (f, _) x = f x
+ let sym (f, g) = (g, f)
+end
+\end{caml_example*}
+
+We can then define a parametrized algebraic data type whose
+constructors provide some information about the type parameter:
+
+\begin{caml_example*}{verbatim}
+module rec Typ : sig
+ module type PAIR = sig
+ type t and t1 and t2
+ val eq: (t, t1 * t2) TypEq.t
+ val t1: t1 Typ.typ
+ val t2: t2 Typ.typ
+ end
+
+ type 'a typ =
+ | Int of ('a, int) TypEq.t
+ | String of ('a, string) TypEq.t
+ | Pair of (module PAIR with type t = 'a)
+end = Typ
+\end{caml_example*}
+
+Values of type "'a typ" are supposed to be runtime representations for
+the type "'a". The constructors "Int" and "String" are easy: they
+directly give a witness of type equality between the parameter "'a"
+and the ground types "int" (resp. "string"). The constructor "Pair" is
+more complex. One wants to give a witness of type equality between
+"'a" and a type of the form "t1 * t2" together with the representations
+for "t1" and "t2". However, these two types are unknown. The code above
+shows how to use first-class modules to simulate existentials.
+
+Here is how to construct values of type "'a typ":
+
+\begin{caml_example*}{verbatim}
+let int = Typ.Int TypEq.refl
+
+let str = Typ.String TypEq.refl
+
+let pair (type s1) (type s2) t1 t2 =
+ let module P = struct
+ type t = s1 * s2
+ type t1 = s1
+ type t2 = s2
+ let eq = TypEq.refl
+ let t1 = t1
+ let t2 = t2
+ end in
+ let pair = (module P : Typ.PAIR with type t = s1 * s2) in
+ Typ.Pair pair
+\end{caml_example*}
+
+And finally, here is an example of a polymorphic function that takes the
+runtime representation of some type "'a" and a value of the same type,
+then pretty-prints the value into a string:
+
+\begin{caml_example*}{verbatim}
+open Typ
+let rec to_string: 'a. 'a Typ.typ -> 'a -> string =
+ fun (type s) t x ->
+ match t with
+ | Int eq -> Int.to_string (TypEq.apply eq x)
+ | String eq -> Printf.sprintf "%S" (TypEq.apply eq x)
+ | Pair p ->
+ let module P = (val p : PAIR with type t = s) in
+ let (x1, x2) = TypEq.apply P.eq x in
+ Printf.sprintf "(%s,%s)" (to_string P.t1 x1) (to_string P.t2 x2)
+\end{caml_example*}
+
+Note that this function uses an explicit polymorphic annotation to obtain
+polymorphic recursion.
+\fi
--- /dev/null
+Generalized algebraic datatypes, or GADTs, extend usual sum types in
+two ways: constraints on type parameters may change depending on the
+value constructor, and some type variables may be existentially
+quantified. They are described in chapter \ref{c:gadts-tutorial}.
+
+(Introduced in OCaml 4.00)
+
+\begin{syntax}
+constr-decl:
+ ...
+ | constr-name ':' [ constr-args '->' ] typexpr
+;
+type-param:
+ ...
+ | [variance] '_'
+\end{syntax}
+
+Refutation cases. (Introduced in OCaml 4.03)
+
+\begin{syntax}
+matching-case:
+ pattern ['when' expr] '->' expr
+ | pattern '->' '.'
+\end{syntax}
+
+Explicit naming of existentials. (Introduced in OCaml 4.13.0)
+
+\begin{syntax}
+pattern:
+ ...
+ | constr '(' "type" {{typeconstr-name}} ')' '(' pattern ')'
+;
+\end{syntax}
\ No newline at end of file
--- /dev/null
+(Introduced in 4.08)
+
+\begin{syntax}
+definition:
+ ...
+ | 'open' module-expr
+ | 'open!' module-expr
+;
+specification:
+ ...
+ | 'open' extended-module-path
+ | 'open!' extended-module-path
+;
+expr:
+ ...
+ | 'let' 'open' module-expr 'in' expr
+ | 'let' 'open!' module-expr 'in' expr
+;
+\end{syntax}
+
+
+This extension makes it possible to open any module expression in
+module structures and expressions. A similar mechanism is also available
+inside module types, but only for extended module paths (e.g. "F(X).G(Y)").
+
+For instance, a module can be constrained when opened with
+
+\begin{caml_example*}{verbatim}[error]
+module M = struct let x = 0 let hidden = 1 end
+open (M:sig val x: int end)
+let y = hidden
+\end{caml_example*}
+
+
+Another possibility is to immediately open the result of a functor application
+
+\begin{caml_example}{verbatim}
+ let sort (type x) (x:x list) =
+ let open Set.Make(struct type t = x let compare=compare end) in
+ elements (of_list x)
+\end{caml_example}
+
+Going further, this construction can introduce local components inside a
+structure,
+
+\begin{caml_example}{verbatim}
+module M = struct
+ let x = 0
+ open! struct
+ let x = 0
+ let y = 1
+ end
+ let w = x + y
+end
+\end{caml_example}
+
+One important restriction is that types introduced by @'open' 'struct' ...
+'end'@ cannot appear in the signature of the enclosing structure, unless they
+are defined equal to some non-local type.
+So:
+
+\begin{caml_example}{verbatim}
+module M = struct
+ open struct type 'a t = 'a option = None | Some of 'a end
+ let x : int t = Some 1
+end
+\end{caml_example}
+is OK, but:
+
+\begin{caml_example}{verbatim}[error]
+module M = struct
+ open struct type t = A end
+ let x = A
+end
+\end{caml_example}
+is not because "x" cannot be given any type other than "t", which only exists
+locally. Although the above would be OK if "x" too was local:
+
+\begin{caml_example}{verbatim}
+module M: sig end = struct
+ open struct
+ type t = A
+ end
+ [@@@ellipsis]
+ open struct let x = A end
+ [@@@ellipsis]
+end
+\end{caml_example}
+
+Inside signatures, extended opens are limited to extended module paths,
+\begin{caml_example}{verbatim}
+module type S = sig
+ module F: sig end -> sig type t end
+ module X: sig end
+ open F(X)
+ val f: t
+end
+\end{caml_example}
+
+and not
+
+\begin{verbatim}
+ open struct type t = int end
+\end{verbatim}
+
+In those situations, local substitutions(see \ref{ss:local-substitution})
+can be used instead.
+
+Beware that this extension is not available inside class definitions:
+
+\begin{verbatim}
+class c =
+ let open Set.Make(Int) in
+ ...
+\end{verbatim}
--- /dev/null
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+module-expr:
+ ...
+ | 'functor' '()' '->' module-expr
+ | module-expr '()'
+;
+definition:
+ ...
+ | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
+ [ ':' module-type ] \\ '=' module-expr
+;
+module-type:
+ ...
+ | 'functor' '()' '->' module-type
+;
+specification:
+ ...
+ | 'module' module-name { '(' module-name ':' module-type ')' || '()' }
+ ':' module-type
+;
+\end{syntax}
+
+A generative functor takes a unit "()" argument.
+In order to use it, one must necessarily apply it to this unit argument,
+ensuring that all type components in the result of the functor behave
+in a generative way, {\em i.e.} they are different from types obtained
+by other applications of the same functor.
+This is equivalent to taking an argument of signature "sig end", and always
+applying to "struct end", but not to some defined module (in the
+latter case, applying twice to the same module would return identical
+types).
+
+As a side-effect of this generativity, one is allowed to unpack
+first-class modules in the body of generative functors.
+
--- /dev/null
+(Introduced in 4.06)
+
+\begin{syntax}
+
+dot-ext:
+ | dot-operator-char { operator-char }
+;
+dot-operator-char:
+ '!' || '?' || core-operator-char || '%' || ':'
+;
+expr:
+ ...
+ | expr '.' [module-path '.'] dot-ext ( '(' expr ')' || '[' expr ']' || '{' expr '}' ) [ '<-' expr ]
+;
+operator-name:
+ ...
+ | '.' dot-ext ('()' || '[]' || '{}') ['<-']
+;
+\end{syntax}
+
+
+This extension provides syntactic sugar for getting and setting elements
+for user-defined indexed types. For instance, we can define python-like
+dictionaries with
+\begin{caml_example*}{verbatim}
+module Dict = struct
+include Hashtbl
+let ( .%{} ) tabl index = find tabl index
+let ( .%{}<- ) tabl index value = add tabl index value
+end
+let dict =
+ let dict = Dict.create 10 in
+ let () =
+ dict.Dict.%{"one"} <- 1;
+ let open Dict in
+ dict.%{"two"} <- 2 in
+ dict
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+dict.Dict.%{"one"};;
+let open Dict in dict.%{"two"};;
+\end{caml_example}
+
+\subsection{ss:multiindexing}{Multi-index notation}
+\begin{syntax}
+expr:
+ ...
+ | expr '.' [module-path '.'] dot-ext '(' expr {{';' expr }} ')' [ '<-' expr ]
+ | expr '.' [module-path '.'] dot-ext '[' expr {{';' expr }} ']' [ '<-' expr ]
+ | expr '.' [module-path '.'] dot-ext '{' expr {{';' expr }} '}' [ '<-' expr ]
+;
+operator-name:
+ ...
+ | '.' dot-ext ('(;..)' || '[;..]' || '{;..}') ['<-']
+;
+\end{syntax}
+
+Multi-index are also supported through a second variant of indexing operators
+
+\begin{caml_example*}{verbatim}
+let (.%[;..]) = Bigarray.Genarray.get
+let (.%{;..}) = Bigarray.Genarray.get
+let (.%(;..)) = Bigarray.Genarray.get
+\end{caml_example*}
+
+which is called when an index literals contain a semicolon separated list
+of expressions with two and more elements:
+
+\begin{caml_example*}{verbatim}
+let sum x y = x.%[1;2;3] + y.%[1;2]
+(* is equivalent to *)
+let sum x y = (.%[;..]) x [|1;2;3|] + (.%[;..]) y [|1;2|]
+\end{caml_example*}
+
+In particular this multi-index notation makes it possible to uniformly handle
+indexing Genarray and other implementations of multidimensional arrays.
+
+\begin{caml_example*}{verbatim}
+module A = Bigarray.Genarray
+let (.%{;..}) = A.get
+let (.%{;..}<- ) = A.set
+let (.%{ }) a k = A.get a [|k|]
+let (.%{ }<-) a k x = A.set a [|k|] x
+let syntax_compare vec mat t3 t4 =
+ vec.%{0} = A.get vec [|0|]
+ && mat.%{0;0} = A.get mat [|0;0|]
+ && t3.%{0;0;0} = A.get t3 [|0;0;0|]
+ && t4.%{0;0;0;0} = t4.{0,0,0,0}
+\end{caml_example*}
+
+Beware that the differentiation between the multi-index and single index
+operators is purely syntactic: multi-index operators are restricted to
+index expressions that contain one or more semicolons ";". For instance,
+\begin{caml_example*}{verbatim}
+ let pair vec mat = vec.%{0}, mat.%{0;0}
+\end{caml_example*}
+is equivalent to
+\begin{caml_example*}{verbatim}
+ let pair vec mat = (.%{ }) vec 0, (.%{;..}) mat [|0;0|]
+\end{caml_example*}
+Notice that in the "vec" case, we are calling the single index operator, "(.%{})", and
+not the multi-index variant, "(.{;..})".
+For this reason, it is expected that most users of multi-index operators will need
+to define conjointly a single index variant
+\begin{caml_example*}{verbatim}
+let (.%{;..}) = A.get
+let (.%{ }) a k = A.get a [|k|]
+\end{caml_example*}
+to handle both cases uniformly.
--- /dev/null
+(Introduced in OCaml 4.03)
+\begin{syntax}
+ constr-args:
+ ...
+ | record-decl
+;
+\end{syntax}
+
+The arguments of sum-type constructors can now be defined using the
+same syntax as records. Mutable and polymorphic fields are allowed.
+GADT syntax is supported. Attributes can be specified on individual
+fields.
+
+Syntactically, building or matching constructors with such an inline
+record argument is similar to working with a unary constructor whose
+unique argument is a declared record type. A pattern can bind
+the inline record as a pseudo-value, but the record cannot escape the
+scope of the binding and can only be used with the dot-notation to
+extract or modify fields or to build new constructor values.
+
+\begin{caml_example*}{verbatim}
+type t =
+ | Point of {width: int; mutable x: float; mutable y: float}
+ | Other
+
+let v = Point {width = 10; x = 0.; y = 0.}
+
+let scale l = function
+ | Point p -> Point {p with x = l *. p.x; y = l *. p.y}
+ | Other -> Other
+
+let print = function
+ | Point {x; y; _} -> Printf.printf "%f/%f" x y
+ | Other -> ()
+
+let reset = function
+ | Point p -> p.x <- 0.; p.y <- 0.
+ | Other -> ()
+\end{caml_example*}
+
+\begin{caml_example}{verbatim}[error]
+let invalid = function
+ | Point p -> p
+\end{caml_example}
--- /dev/null
+(Introduced in Objective Caml 1.00)
+
+As mentioned in section~\ref{sss:expr-localdef}, the @'let' 'rec'@ binding
+construct, in addition to the definition of recursive functions,
+also supports a certain class of recursive definitions of
+non-functional values, such as
+\begin{center}
+@"let" "rec" name_1 "=" "1" "::" name_2
+"and" name_2 "=" "2" "::" name_1
+"in" expr@
+\end{center}
+which binds @name_1@ to the cyclic list "1::2::1::2::"\ldots, and
+@name_2@ to the cyclic list "2::1::2::1::"\ldots
+Informally, the class of accepted definitions consists of those
+definitions where the defined names occur only inside function
+bodies or as argument to a data constructor.
+
+More precisely, consider the expression:
+\begin{center}
+@"let" "rec" name_1 "=" expr_1 "and" \ldots "and" name_n "=" expr_n "in" expr@
+\end{center}
+It will be accepted if each one of @expr_1 \ldots expr_n@ is
+statically constructive with respect to @name_1 \ldots name_n@,
+is not immediately linked to any of @name_1 \ldots name_n@,
+and is not an array constructor whose arguments have abstract type.
+
+An expression @@e@@ is said to be {\em statically constructive
+with respect to} the variables @name_1 \ldots name_n@ if at least
+one of the following conditions is true:
+\begin{itemize}
+\item @@e@@ has no free occurrence of any of @name_1 \ldots name_n@
+\item @@e@@ is a variable
+\item @@e@@ has the form @"fun" \ldots "->" \ldots@
+\item @@e@@ has the form @"function" \ldots "->" \ldots@
+\item @@e@@ has the form @"lazy" "(" \ldots ")"@
+\item @@e@@ has one of the following forms, where each one of
+ @expr_1 \ldots expr_m@ is statically constructive with respect to
+ @name_1 \ldots name_n@, and @expr_0@ is statically constructive with
+ respect to @name_1 \ldots name_n, xname_1 \ldots xname_m@:
+ \begin{itemize}
+ \item @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
+ "and" xname_m "=" expr_m "in" expr_0@
+ \item @"let" "module" \ldots "in" expr_1@
+ \item @constr "("expr_1"," \ldots "," expr_m")"@
+ \item @"`"tag-name "("expr_1"," \ldots "," expr_m")"@
+ \item @"[|" expr_1";" \ldots ";" expr_m "|]"@
+ \item @"{" field_1 "=" expr_1";" \ldots ";" field_m = expr_m "}"@
+ \item @"{" expr_1 "with" field_2 "=" expr_2";" \ldots ";"
+ field_m = expr_m "}"@ where @expr_1@ is not immediately
+ linked to @name_1 \ldots name_n@
+ \item @"(" expr_1"," \ldots "," expr_m ")"@
+ \item @expr_1";" \ldots ";" expr_m@
+ \end{itemize}
+\end{itemize}
+
+An expression @@e@@ is said to be {\em immediately linked to} the variable
+@name@ in the following cases:
+\begin{itemize}
+\item @@e@@ is @name@
+\item @@e@@ has the form @expr_1";" \ldots ";" expr_m@ where @expr_m@
+ is immediately linked to @name@
+\item @@e@@ has the form @"let" ["rec"] xname_1 "=" expr_1 "and" \ldots
+ "and" xname_m "=" expr_m "in" expr_0@ where @expr_0@ is immediately
+ linked to @name@ or to one of the @xname_i@ such that @expr_i@
+ is immediately linked to @name@.
+\end{itemize}
--- /dev/null
+(Introduced in OCaml 3.12, short syntax added in 4.03)
+
+\begin{syntax}
+parameter:
+ ...
+ | '(' "type" {{typeconstr-name}} ')'
+\end{syntax}
+
+The expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ introduces a
+type constructor named @typeconstr-name@ which is considered abstract
+in the scope of the sub-expression, but then replaced by a fresh type
+variable. Note that contrary to what the syntax could suggest, the
+expression @"fun" '(' "type" typeconstr-name ')' "->" expr@ itself does not
+suspend the evaluation of @expr@ as a regular abstraction would. The
+syntax has been chosen to fit nicely in the context of function
+declarations, where it is generally used. It is possible to freely mix
+regular function parameters with pseudo type parameters, as in:
+\begin{caml_example*}{verbatim}
+let f = fun (type t) (foo : t list) -> (assert false)[@ellipsis]
+\end{caml_example*}
+and even use the alternative syntax for declaring functions:
+\begin{caml_example*}{verbatim}
+let f (type t) (foo : t list) = (assert false)[@ellipsis]
+\end{caml_example*}
+If several locally abstract types need to be introduced, it is possible to use
+the syntax
+@"fun" '(' "type" typeconstr-name_1 \ldots typeconstr-name_n ')' "->" expr@
+as syntactic sugar for @"fun" '(' "type" typeconstr-name_1 ')' "->" \ldots "->"
+"fun" '(' "type" typeconstr-name_n ')' "->" expr@. For instance,
+\begin{caml_example*}{verbatim}
+let f = fun (type t u v) -> fun (foo : (t * u * v) list) -> (assert false)[@ellipsis]
+let f' (type t u v) (foo : (t * u * v) list) = (assert false)[@ellipsis]
+\end{caml_example}
+
+This construction is useful because the type constructors it introduces
+can be used in places where a type variable is not allowed. For
+instance, one can use it to define an exception in a local module
+within a polymorphic function.
+\begin{caml_example*}{verbatim}
+let f (type t) () =
+ let module M = struct exception E of t end in
+ (fun x -> M.E x), (function M.E x -> Some x | _ -> None)
+\end{caml_example*}
+
+Here is another example:
+\begin{caml_example*}{verbatim}
+let sort_uniq (type s) (cmp : s -> s -> int) =
+ let module S = Set.Make(struct type t = s let compare = cmp end) in
+ fun l ->
+ S.elements (List.fold_right S.add l S.empty)
+\end{caml_example*}
+
+It is also extremely useful for first-class modules (see
+section~\ref{s:first-class-modules}) and generalized algebraic datatypes
+(GADTs: see section~\ref{s:gadts}).
+
+\lparagraph{p:polymorpic-locally-abstract}{Polymorphic syntax} (Introduced in OCaml 4.00)
+
+\begin{syntax}
+let-binding:
+ ...
+ | value-name ':' 'type' {{ typeconstr-name }} '.' typexpr '=' expr
+;
+class-field:
+ ...
+ | 'method' ['private'] method-name ':' 'type'
+ {{ typeconstr-name }} '.' typexpr '=' expr
+ | 'method!' ['private'] method-name ':' 'type'
+ {{ typeconstr-name }} '.' typexpr '=' expr
+\end{syntax}
+
+The @"(type" typeconstr-name")"@ syntax construction by itself does not make
+polymorphic the type variable it introduces, but it can be combined
+with explicit polymorphic annotations where needed.
+The above rule is provided as syntactic sugar to make this easier:
+\begin{caml_example*}{verbatim}
+let rec f : type t1 t2. t1 * t2 list -> t1 = (assert false)[@ellipsis]
+\end{caml_example*}
+\noindent
+is automatically expanded into
+\begin{caml_example*}{verbatim}
+let rec f : 't1 't2. 't1 * 't2 list -> 't1 =
+ fun (type t1) (type t2) -> ( (assert false)[@ellipsis] : t1 * t2 list -> t1)
+\end{caml_example*}
+This syntax can be very useful when defining recursive functions involving
+GADTs, see the section~\ref{s:gadts} for a more detailed explanation.
+
+The same feature is provided for method definitions.
--- /dev/null
+(Introduced in OCaml 4.02)
+
+\begin{syntax}
+specification:
+ ...
+ | 'module' module-name '=' module-path
+\end{syntax}
+
+The above specification, inside a signature, only matches a module
+definition equal to @module-path@. Conversely, a type-level module
+alias can be matched by itself, or by any supertype of the type of the
+module it references.
+
+There are several restrictions on @module-path@:
+\begin{enumerate}
+\item it should be of the form \(M_0.M_1...M_n\) ({\em i.e.} without
+ functor applications);
+\item inside the body of a functor, \(M_0\) should not be one of the
+ functor parameters;
+\item inside a recursive module definition, \(M_0\) should not be one of
+ the recursively defined modules.
+\end{enumerate}
+
+Such specifications are also inferred. Namely, when @P@ is a path
+satisfying the above constraints,
+\begin{caml_eval}
+module P = struct end
+\end{caml_eval}
+\begin{caml_example*}{verbatim}
+module N = P
+\end{caml_example*}
+has type
+\begin{caml_example*}{signature}
+module N = P
+\end{caml_example*}
+
+Type-level module aliases are used when checking module path
+equalities. That is, in a context where module name @N@ is known to be
+an alias for @P@, not only these two module paths check as equal, but
+@F(N)@ and @F(P)@ are also recognized as equal. In the default
+compilation mode, this is the only difference with the previous
+approach of module aliases having just the same module type as the
+module they reference.
+
+When the compiler flag @'-no-alias-deps'@ is enabled, type-level
+module aliases are also exploited to avoid introducing dependencies
+between compilation units. Namely, a module alias referring to a
+module inside another compilation unit does not introduce a link-time
+dependency on that compilation unit, as long as it is not
+dereferenced; it still introduces a compile-time dependency if the
+interface needs to be read, {\em i.e.} if the module is a submodule
+of the compilation unit, or if some type components are referred to.
+Additionally, accessing a module alias introduces a link-time
+dependency on the compilation unit containing the module referenced by
+the alias, rather than the compilation unit containing the alias.
+Note that these differences in link-time behavior may be incompatible
+with the previous behavior, as some compilation units might not be
+extracted from libraries, and their side-effects ignored.
+
+These weakened dependencies make possible to use module aliases in
+place of the @'-pack'@ mechanism. Suppose that you have a library
+@'Mylib'@ composed of modules @'A'@ and @'B'@. Using @'-pack'@, one
+would issue the command line
+\begin{verbatim}
+ocamlc -pack a.cmo b.cmo -o mylib.cmo
+\end{verbatim}
+and as a result obtain a @'Mylib'@ compilation unit, containing
+physically @'A'@ and @'B'@ as submodules, and with no dependencies on
+their respective compilation units.
+Here is a concrete example of a possible alternative approach:
+\begin{enumerate}
+\item Rename the files containing @'A'@ and @'B'@ to @'Mylib__A'@ and
+ @'Mylib__B'@.
+\item Create a packing interface @'Mylib.ml'@, containing the
+ following lines.
+\begin{verbatim}
+module A = Mylib__A
+module B = Mylib__B
+\end{verbatim}
+\item Compile @'Mylib.ml'@ using @'-no-alias-deps'@, and the other
+ files using @'-no-alias-deps'@ and @'-open' 'Mylib'@ (the last one is
+ equivalent to adding the line @'open!' 'Mylib'@ at the top of each
+ file).
+\begin{verbatim}
+ocamlc -c -no-alias-deps Mylib.ml
+ocamlc -c -no-alias-deps -open Mylib Mylib__*.mli Mylib__*.ml
+\end{verbatim}
+\item Finally, create a library containing all the compilation units,
+ and export all the compiled interfaces.
+\begin{verbatim}
+ocamlc -a Mylib*.cmo -o Mylib.cma
+\end{verbatim}
+\end{enumerate}
+This approach lets you access @'A'@ and @'B'@ directly inside the
+library, and as @'Mylib.A'@ and @'Mylib.B'@ from outside.
+It also has the advantage that @'Mylib'@ is no longer monolithic: if
+you use @'Mylib.A'@, only @'Mylib__A'@ will be linked in, not
+@'Mylib__B'@.
+%Note that in the above @'Mylib.cmo'@ is actually empty, and one could
+%name the interface @'Mylib.mli'@, but this would require that all
+%clients are compiled with the @'-no-alias-deps'@ flag.
+
+Note the use of double underscores in @'Mylib__A'@ and
+@'Mylib__B'@. These were chosen on purpose; the compiler uses the
+following heuristic when printing paths: given a path @'Lib__fooBar'@,
+if @'Lib.FooBar'@ exists and is an alias for @'Lib__fooBar'@, then the
+compiler will always display @'Lib.FooBar'@ instead of
+@'Lib__fooBar'@. This way the long @'Mylib__'@ names stay hidden and
+all the user sees is the nicer dot names. This is how the OCaml
+standard library is compiled.
--- /dev/null
+(Introduced in OCaml 3.12)
+
+\begin{syntax}
+module-type:
+ ...
+ | 'module' 'type' 'of' module-expr
+\end{syntax}
+
+The construction @'module' 'type' 'of' module-expr@ expands to the module type
+(signature or functor type) inferred for the module expression @module-expr@.
+To make this module type reusable in many situations, it is
+intentionally not strengthened: abstract types and datatypes are not
+explicitly related with the types of the original module.
+For the same reason, module aliases in the inferred type are expanded.
+
+A typical use, in conjunction with the signature-level @'include'@
+construct, is to extend the signature of an existing structure.
+In that case, one wants to keep the types equal to types in the
+original module. This can done using the following idiom.
+\begin{caml_example*}{verbatim}
+module type MYHASH = sig
+ include module type of struct include Hashtbl end
+ val replace: ('a, 'b) t -> 'a -> 'b -> unit
+end
+\end{caml_example*}
+The signature "MYHASH" then contains all the fields of the signature
+of the module "Hashtbl" (with strengthened type definitions), plus the
+new field "replace". An implementation of this signature can be
+obtained easily by using the @'include'@ construct again, but this
+time at the structure level:
+\begin{caml_example*}{verbatim}
+module MyHash : MYHASH = struct
+ include Hashtbl
+ let replace t k v = remove t k; add t k v
+end
+\end{caml_example*}
+
+Another application where the absence of strengthening comes handy, is
+to provide an alternative implementation for an existing module.
+\begin{caml_example*}{verbatim}
+module MySet : module type of Set = struct
+ include Set[@@ellipsis]
+end
+\end{caml_example*}
+This idiom guarantees that "Myset" is compatible with Set, but allows
+it to represent sets internally in a different way.
--- /dev/null
+(Introduced in OCaml 4.01)
+
+\begin{syntax}
+definition:
+ ...
+ | 'open!' module-path
+;
+specification:
+ ...
+ | 'open!' module-path
+;
+expr:
+ ...
+ | 'let' 'open!' module-path 'in' expr
+;
+class-body-type:
+ ...
+ | 'let' 'open!' module-path 'in' class-body-type
+;
+class-expr:
+ ...
+ | 'let' 'open!' module-path 'in' class-expr
+;
+\end{syntax}
+
+Since OCaml 4.01, @"open"@ statements shadowing an existing identifier
+(which is later used) trigger the warning 44. Adding a @"!"@
+character after the @"open"@ keyword indicates that such a shadowing is
+intentional and should not trigger the warning.
+
+This is also available (since OCaml 4.06) for local opens in class
+expressions and class type expressions.
--- /dev/null
+Private type declarations in module signatures, of the form
+"type t = private ...", enable libraries to
+reveal some, but not all aspects of the implementation of a type to
+clients of the library. In this respect, they strike a middle ground
+between abstract type declarations, where no information is revealed
+on the type implementation, and data type definitions and type
+abbreviations, where all aspects of the type implementation are
+publicized. Private type declarations come in three flavors: for
+variant and record types (section~\ref{ss:private-types-variant}),
+for type abbreviations (section~\ref{ss:private-types-abbrev}),
+and for row types (section~\ref{ss:private-rows}).
+
+\subsection{ss:private-types-variant}{Private variant and record types}
+
+
+(Introduced in Objective Caml 3.07)
+
+\begin{syntax}
+type-representation:
+ ...
+ | '=' 'private' [ '|' ] constr-decl { '|' constr-decl }
+ | '=' 'private' record-decl
+\end{syntax}
+
+Values of a variant or record type declared @"private"@
+can be de-structured normally in pattern-matching or via
+the @expr '.' field@ notation for record accesses. However, values of
+these types cannot be constructed directly by constructor application
+or record construction. Moreover, assignment on a mutable field of a
+private record type is not allowed.
+
+The typical use of private types is in the export signature of a
+module, to ensure that construction of values of the private type always
+go through the functions provided by the module, while still allowing
+pattern-matching outside the defining module. For example:
+\begin{caml_example*}{verbatim}
+module M : sig
+ type t = private A | B of int
+ val a : t
+ val b : int -> t
+end = struct
+ type t = A | B of int
+ let a = A
+ let b n = assert (n > 0); B n
+end
+\end{caml_example*}
+Here, the @"private"@ declaration ensures that in any value of type
+"M.t", the argument to the "B" constructor is always a positive integer.
+
+With respect to the variance of their parameters, private types are
+handled like abstract types. That is, if a private type has
+parameters, their variance is the one explicitly given by prefixing
+the parameter by a `"+"' or a `"-"', it is invariant otherwise.
+
+\subsection{ss:private-types-abbrev}{Private type abbreviations}
+
+(Introduced in Objective Caml 3.11)
+
+\begin{syntax}
+type-equation:
+ ...
+ | '=' 'private' typexpr
+\end{syntax}
+
+Unlike a regular type abbreviation, a private type abbreviation
+declares a type that is distinct from its implementation type @typexpr@.
+However, coercions from the type to @typexpr@ are permitted.
+Moreover, the compiler ``knows'' the implementation type and can take
+advantage of this knowledge to perform type-directed optimizations.
+
+The following example uses a private type abbreviation to define a
+module of nonnegative integers:
+\begin{caml_example*}{verbatim}
+module N : sig
+ type t = private int
+ val of_int: int -> t
+ val to_int: t -> int
+end = struct
+ type t = int
+ let of_int n = assert (n >= 0); n
+ let to_int n = n
+end
+\end{caml_example*}
+The type "N.t" is incompatible with "int", ensuring that nonnegative
+integers and regular integers are not confused. However, if "x" has
+type "N.t", the coercion "(x :> int)" is legal and returns the
+underlying integer, just like "N.to_int x". Deep coercions are also
+supported: if "l" has type "N.t list", the coercion "(l :> int list)"
+returns the list of underlying integers, like "List.map N.to_int l"
+but without copying the list "l".
+
+Note that the coercion @"(" expr ":>" typexpr ")"@ is actually an abbreviated
+form,
+and will only work in presence of private abbreviations if neither the
+type of @expr@ nor @typexpr@ contain any type variables. If they do,
+you must use the full form @"(" expr ":" typexpr_1 ":>" typexpr_2 ")"@ where
+@typexpr_1@ is the expected type of @expr@. Concretely, this would be "(x :
+N.t :> int)" and "(l : N.t list :> int list)" for the above examples.
+
+\subsection{ss:private-rows}{Private row types}
+\ikwd{private\@\texttt{private}}
+
+(Introduced in Objective Caml 3.09)
+
+\begin{syntax}
+type-equation:
+ ...
+ | '=' 'private' typexpr
+\end{syntax}
+
+Private row types are type abbreviations where part of the
+structure of the type is left abstract. Concretely @typexpr@ in the
+above should denote either an object type or a polymorphic variant
+type, with some possibility of refinement left. If the private
+declaration is used in an interface, the corresponding implementation
+may either provide a ground instance, or a refined private type.
+\begin{caml_example*}{verbatim}
+module M : sig type c = private < x : int; .. > val o : c end =
+struct
+ class c = object method x = 3 method y = 2 end
+ let o = new c
+end
+\end{caml_example*}
+This declaration does more than hiding the "y" method, it also makes
+the type "c" incompatible with any other closed object type, meaning
+that only "o" will be of type "c". In that respect it behaves
+similarly to private record types. But private row types are
+more flexible with respect to incremental refinement. This feature can
+be used in combination with functors.
+\begin{caml_example*}{verbatim}
+module F(X : sig type c = private < x : int; .. > end) =
+struct
+ let get_x (o : X.c) = o#x
+end
+module G(X : sig type c = private < x : int; y : int; .. > end) =
+struct
+ include F(X)
+ let get_y (o : X.c) = o#y
+end
+\end{caml_example*}
+
+A polymorphic variant type [t], for example
+\begin{caml_example*}{verbatim}
+type t = [ `A of int | `B of bool ]
+\end{caml_example*}
+can be refined in two ways. A definition [u] may add new field to [t],
+and the declaration
+\begin{caml_example*}{verbatim}
+type u = private [> t]
+\end{caml_example*}
+will keep those new fields abstract. Construction of values of type
+[u] is possible using the known variants of [t], but any
+pattern-matching will require a default case to handle the potential
+extra fields. Dually, a declaration [u] may restrict the fields of [t]
+through abstraction: the declaration
+\begin{caml_example*}{verbatim}
+type v = private [< t > `A]
+\end{caml_example*}
+corresponds to private variant types. One cannot create a value of the
+private type [v], except using the constructors that are explicitly
+listed as present, "(`A n)" in this example; yet, when
+patter-matching on a [v], one should assume that any of the
+constructors of [t] could be present.
+
+Similarly to abstract types, the variance of type parameters
+is not inferred, and must be given explicitly.
--- /dev/null
+(Introduced in Objective Caml 3.07)
+
+% TODO: relaxed syntax
+
+\begin{syntax}
+definition:
+ ...
+ | 'module' 'rec' module-name ':' module-type '=' module-expr \\
+ { 'and' module-name ':' module-type '=' module-expr }
+;
+specification:
+ ...
+ | 'module' 'rec' module-name ':' module-type
+ { 'and' module-name':' module-type }
+\end{syntax}
+
+Recursive module definitions, introduced by the @"module rec"@ \ldots
+@"and"@ \ldots\ construction, generalize regular module definitions
+@'module' module-name '=' module-expr@ and module specifications
+@'module' module-name ':' module-type@ by allowing the defining
+@module-expr@ and the @module-type@ to refer recursively to the module
+identifiers being defined. A typical example of a recursive module
+definition is:
+\begin{caml_example*}{verbatim}
+module rec A : sig
+ type t = Leaf of string | Node of ASet.t
+ val compare: t -> t -> int
+end = struct
+ type t = Leaf of string | Node of ASet.t
+ let compare t1 t2 =
+ match (t1, t2) with
+ | (Leaf s1, Leaf s2) -> Stdlib.compare s1 s2
+ | (Leaf _, Node _) -> 1
+ | (Node _, Leaf _) -> -1
+ | (Node n1, Node n2) -> ASet.compare n1 n2
+end
+and ASet
+ : Set.S with type elt = A.t
+ = Set.Make(A)
+\end{caml_example*}
+It can be given the following specification:
+\begin{caml_example*}{signature}
+module rec A : sig
+ type t = Leaf of string | Node of ASet.t
+ val compare: t -> t -> int
+end
+and ASet : Set.S with type elt = A.t
+\end{caml_example*}
+
+This is an experimental extension of OCaml: the class of
+recursive definitions accepted, as well as its dynamic semantics are
+not final and subject to change in future releases.
+
+Currently, the compiler requires that all dependency cycles between
+the recursively-defined module identifiers go through at least one
+``safe'' module. A module is ``safe'' if all value definitions that
+it contains have function types @typexpr_1 '->' typexpr_2@. Evaluation of a
+recursive module definition proceeds by building initial values for
+the safe modules involved, binding all (functional) values to
+@'fun' '_' '->' 'raise' @"Undefined_recursive_module". The defining
+module expressions are then evaluated, and the initial values
+for the safe modules are replaced by the values thus computed. If a
+function component of a safe module is applied during this computation
+(which corresponds to an ill-founded recursive definition), the
+"Undefined_recursive_module" exception is raised at runtime:
+
+\begin{caml_example}{verbatim}
+module rec M: sig val f: unit -> int end = struct let f () = N.x end
+and N:sig val x: int end = struct let x = M.f () end
+\end{caml_example}
+
+If there are no safe modules along a dependency cycle, an error is raised
+
+\begin{caml_example}{verbatim}[error]
+module rec M: sig val x: int end = struct let x = N.y end
+and N:sig val x: int val y:int end = struct let x = M.x let y = 0 end
+\end{caml_example}
+
+Note that, in the @specification@ case, the @module-type@s must be
+parenthesized if they use the @'with' mod-constraint@ construct.
--- /dev/null
+\subsection{ss:destructive-substitution}{Destructive substitutions}
+
+(Introduced in OCaml 3.12, generalized in 4.06)
+
+\begin{syntax}
+mod-constraint:
+ ...
+ | 'type' [type-params] typeconstr-name ':=' typexpr
+ | 'module' module-path ':=' extended-module-path
+\end{syntax}
+
+A ``destructive'' substitution (@'with' ... ':=' ...@) behaves essentially like
+normal signature constraints (@'with' ... '=' ...@), but it additionally removes
+the redefined type or module from the signature.
+
+Prior to OCaml 4.06, there were a number of restrictions: one could only remove
+types and modules at the outermost level (not inside submodules), and in the
+case of @'with type'@ the definition had to be another type constructor with the
+same type parameters.
+
+A natural application of destructive substitution is merging two
+signatures sharing a type name.
+\begin{caml_example*}{verbatim}
+module type Printable = sig
+ type t
+ val print : Format.formatter -> t -> unit
+end
+module type Comparable = sig
+ type t
+ val compare : t -> t -> int
+end
+module type PrintableComparable = sig
+ include Printable
+ include Comparable with type t := t
+end
+\end{caml_example*}
+
+One can also use this to completely remove a field:
+\begin{caml_example}{verbatim}
+module type S = Comparable with type t := int
+\end{caml_example}
+or to rename one:
+\begin{caml_example}{verbatim}
+module type S = sig
+ type u
+ include Comparable with type t := u
+end
+\end{caml_example}
+
+Note that you can also remove manifest types, by substituting with the
+same type.
+\begin{caml_example}{verbatim}
+module type ComparableInt = Comparable with type t = int ;;
+module type CompareInt = ComparableInt with type t := int
+\end{caml_example}
+
+\subsection{ss:local-substitution}{Local substitution declarations}
+
+(Introduced in OCaml 4.08)
+
+\begin{syntax}
+specification:
+ ...
+ | 'type' type-subst { 'and' type-subst }
+ | 'module' module-name ':=' extended-module-path
+ | 'module' 'type' module-name ':=' module-type
+
+;
+
+type-subst:
+ [type-params] typeconstr-name ':=' typexpr { type-constraint }
+\end{syntax}
+
+
+Local substitutions behave like destructive substitutions (@'with' ... ':=' ...@)
+but instead of being applied to a whole signature after the fact, they are
+introduced during the specification of the signature, and will apply to all the
+items that follow.
+
+This provides a convenient way to introduce local names for types and modules
+when defining a signature:
+
+\begin{caml_example}{verbatim}
+module type S = sig
+ type t
+ module Sub : sig
+ type outer := t
+ type t
+ val to_outer : t -> outer
+ end
+end
+\end{caml_example}
+
+Note that, unlike type declarations, type substitution declarations are not
+recursive, so substitutions like the following are rejected:
+
+\begin{caml_example}{toplevel}
+module type S = sig
+ type 'a poly_list := [ `Cons of 'a * 'a poly_list | `Nil ]
+end [@@expect error];;
+\end{caml_example}
+
+\subsection{ss:module-type-substitution}{Module type substitutions}
+
+(Introduced in OCaml 4.13)
+
+\begin{syntax}
+mod-constraint:
+ ...
+ | 'module ' 'type' modtype-path '=' module-type
+ | 'module ' 'type' modtype-path ':=' module-type
+\end{syntax}
+
+Module type substitution essentially behaves like type substitutions.
+They are useful to refine an abstract module type in a signature into
+a concrete module type,
+
+\begin{caml_example}{toplevel}
+module type ENDO = sig
+ module type T
+ module F: T -> T
+end
+module Endo(X: sig module type T end): ENDO with module type T = X.T =
+struct
+ module type T = X.T
+ module F(X:T) = X
+ end;;
+\end{caml_example}
+
+It is also possible to substitute a concrete module type with an
+equivalent module types.
+
+\begin{caml_example*}{verbatim}
+module type A = sig
+ type x
+ module type R = sig
+ type a = A of x
+ type b
+ end
+end
+module type S = sig
+ type a = A of int
+ type b
+end
+module type B = A with type x = int and module type R = S
+\end{caml_example*}
+However, such substitutions are never necessary.
+
+Destructive module type substitution removes the module type substitution
+from the signature
+\begin{caml_example}{toplevel}
+module type ENDO' = ENDO with module type T := ENDO;;
+\end{caml_example}
+If the right hand side of the substitution is not a path, then the destructive
+substitution is only valid if the left-hand side of the substitution is never
+used as the type of a first-class module in the original module type.
+
+\begin{caml_example}{verbatim}[error]
+module type T = sig module type S val x: (module S) end
+module type Error = T with module type S := sig end
+\end{caml_example}
--- /dev/null
+\section{s:lexical-conventions}{Lexical conventions}
+%HEVEA\cutname{lex.html}
+\subsubsection*{sss:lex:blanks}{Blanks}
+
+The following characters are considered as blanks: space,
+horizontal tabulation, carriage return, line feed and form feed. Blanks are
+ignored, but they separate adjacent identifiers, literals and
+keywords that would otherwise be confused as one single identifier,
+literal or keyword.
+
+\subsubsection*{sss:lex:comments}{Comments}
+
+Comments are introduced by the two characters @"(*"@, with no
+intervening blanks, and terminated by the characters @"*)"@, with
+no intervening blanks. Comments are treated as blank characters.
+Comments do not occur inside string or character literals. Nested
+comments are handled correctly.
+
+\begin{caml_example}{verbatim}
+(* single line comment *)
+
+(* multiple line comment, commenting out part of a program, and containing a
+nested comment:
+let f = function
+ | 'A'..'Z' -> "Uppercase"
+ (* Add other cases later... *)
+*)
+\end{caml_example}
+
+\subsubsection*{sss:lex:identifiers}{Identifiers}
+
+\begin{syntax}
+ident: ( letter || "_" ) { letter || "0" \ldots "9" || "_" || "'" } ;
+capitalized-ident: ("A" \ldots "Z") { letter || "0" \ldots "9" || "_" || "'" } ;
+lowercase-ident:
+ ("a" \ldots "z" || "_") { letter || "0" \ldots "9" || "_" || "'" } ;
+letter: "A" \ldots "Z" || "a" \ldots "z"
+\end{syntax}
+
+Identifiers are sequences of letters, digits, "_" (the underscore
+character), and "'" (the single quote), starting with a
+letter or an underscore.
+Letters contain at least the 52 lowercase and uppercase
+letters from the ASCII set. The current implementation
+also recognizes as letters some characters from the ISO
+8859-1 set (characters 192--214 and 216--222 as uppercase letters;
+characters 223--246 and 248--255 as lowercase letters). This
+feature is deprecated and should be avoided for future compatibility.
+
+All characters in an identifier are
+meaningful. The current implementation accepts identifiers up to
+16000000 characters in length.
+
+In many places, OCaml makes a distinction between capitalized
+identifiers and identifiers that begin with a lowercase letter. The
+underscore character is considered a lowercase letter for this
+purpose.
+
+\subsubsection*{sss:integer-literals}{Integer literals}
+
+\begin{syntax}
+integer-literal:
+ ["-"] ("0"\ldots"9") { "0"\ldots"9" || "_" }
+ | ["-"] ("0x"||"0X") ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }
+ | ["-"] ("0o"||"0O") ("0"\ldots"7") { "0"\ldots"7"||"_" }
+ | ["-"] ("0b"||"0B") ("0"\ldots"1") { "0"\ldots"1"||"_" }
+;
+int32-literal: integer-literal 'l'
+;
+int64-literal: integer-literal 'L'
+;
+nativeint-literal: integer-literal 'n'
+\end{syntax}
+
+An integer literal is a sequence of one or more digits, optionally
+preceded by a minus sign. By default, integer literals are in decimal
+(radix 10). The following prefixes select a different radix:
+\begin{tableau}{|l|l|}{Prefix}{Radix}
+\entree{"0x", "0X"}{hexadecimal (radix 16)}
+\entree{"0o", "0O"}{octal (radix 8)}
+\entree{"0b", "0B"}{binary (radix 2)}
+\end{tableau}
+(The initial @"0"@ is the digit zero; the @"O"@ for octal is the letter O.)
+An integer literal can be followed by one of the letters "l", "L" or "n"
+to indicate that this integer has type "int32", "int64" or "nativeint"
+respectively, instead of the default type "int" for integer literals.
+The interpretation of integer literals that fall outside the range of
+representable integer values is undefined.
+
+For convenience and readability, underscore characters (@"_"@) are accepted
+(and ignored) within integer literals.
+
+\begin{caml_example}{toplevel}
+let house_number = 37
+let million = 1_000_000
+let copyright = 0x00A9
+let counter64bit = ref 0L;;
+\end{caml_example}
+
+\subsubsection*{sss:floating-point-literals}{Floating-point literals}
+
+\begin{syntax}
+float-literal:
+ ["-"] ("0"\ldots"9") { "0"\ldots"9"||"_" } ["." { "0"\ldots"9"||"_" }]
+ [("e"||"E") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+ | ["-"] ("0x"||"0X")
+ ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" } \\
+ ["." { "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f"||"_" }]
+ [("p"||"P") ["+"||"-"] ("0"\ldots"9") { "0"\ldots"9"||"_" }]
+\end{syntax}
+
+Floating-point decimal literals consist in an integer part, a
+fractional part and
+an exponent part. The integer part is a sequence of one or more
+digits, optionally preceded by a minus sign. The fractional part is a
+decimal point followed by zero, one or more digits.
+The exponent part is the character @"e"@ or @"E"@ followed by an
+optional @"+"@ or @"-"@ sign, followed by one or more digits. It is
+interpreted as a power of 10.
+The fractional part or the exponent part can be omitted but not both, to
+avoid ambiguity with integer literals.
+The interpretation of floating-point literals that fall outside the
+range of representable floating-point values is undefined.
+
+Floating-point hexadecimal literals are denoted with the @"0x"@ or @"0X"@
+prefix. The syntax is similar to that of floating-point decimal
+literals, with the following differences.
+The integer part and the fractional part use hexadecimal
+digits. The exponent part starts with the character @"p"@ or @"P"@.
+It is written in decimal and interpreted as a power of 2.
+
+For convenience and readability, underscore characters (@"_"@) are accepted
+(and ignored) within floating-point literals.
+
+\begin{caml_example}{toplevel}
+let pi = 3.141_592_653_589_793_12
+let small_negative = -1e-5
+let machine_epsilon = 0x1p-52;;
+\end{caml_example}
+
+\subsubsection*{sss:character-literals}{Character literals}
+\label{s:characterliteral}
+
+\begin{syntax}
+char-literal:
+ "'" regular-char "'"
+ | "'" escape-sequence "'"
+;
+escape-sequence:
+ "\" ( "\" || '"' || "'" || "n" || "t" || "b" || "r" || space )
+ | "\" ("0"\ldots"9") ("0"\ldots"9") ("0"\ldots"9")
+ | "\x" ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ ("0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f")
+ | "\o" ("0"\ldots"3") ("0"\ldots"7") ("0"\ldots"7")
+\end{syntax}
+
+Character literals are delimited by @"'"@ (single quote) characters.
+The two single quotes enclose either one character different from
+@"'"@ and @'\'@, or one of the escape sequences below:
+\begin{tableau}{|l|l|}{Sequence}{Character denoted}
+\entree{"\\\\"}{backslash ("\\")}
+\entree{"\\\""}{double quote ("\"")}
+\entree{"\\'"}{single quote ("'")}
+\entree{"\\n"}{linefeed (LF)}
+\entree{"\\r"}{carriage return (CR)}
+\entree{"\\t"}{horizontal tabulation (TAB)}
+\entree{"\\b"}{backspace (BS)}
+\entree{"\\"\var{space}}{space (SPC)}
+\entree{"\\"\var{ddd}}{the character with ASCII code \var{ddd} in decimal}
+\entree{"\\x"\var{hh}}{the character with ASCII code \var{hh} in hexadecimal}
+\entree{"\\o"\var{ooo}}{the character with ASCII code \var{ooo} in octal}
+\end{tableau}
+
+\begin{caml_example}{toplevel}
+let a = 'a'
+let single_quote = '\''
+let copyright = '\xA9';;
+\end{caml_example}
+\subsubsection*{sss:stringliterals}{String literals}
+
+\begin{syntax}
+string-literal:
+ '"' { string-character } '"'
+ | '{' quoted-string-id '|' { any-char } '|' quoted-string-id '}'
+;
+quoted-string-id:
+ { 'a'...'z' || '_' }
+;
+string-character:
+ regular-string-char
+ | escape-sequence
+ | "\u{" {{ "0"\ldots"9"||"A"\ldots"F"||"a"\ldots"f" }} "}"
+ | '\' newline { space || tab }
+\end{syntax}
+
+String literals are delimited by @'"'@ (double quote) characters.
+The two double quotes enclose a sequence of either characters
+different from @'"'@ and @'\'@, or escape sequences from the
+table given above for character literals, or a Unicode character
+escape sequence.
+
+A Unicode character escape sequence is substituted by the UTF-8
+encoding of the specified Unicode scalar value. The Unicode scalar
+value, an integer in the ranges 0x0000...0xD7FF or 0xE000...0x10FFFF,
+is defined using 1 to 6 hexadecimal digits; leading zeros are allowed.
+
+\begin{caml_example}{toplevel}
+let greeting = "Hello, World!\n"
+let superscript_plus = "\u{207A}";;
+\end{caml_example}
+
+To allow splitting long string literals across lines, the sequence
+"\\"\var{newline}~\var{spaces-or-tabs} (a backslash at the end of a line
+followed by any number of spaces and horizontal tabulations at the
+beginning of the next line) is ignored inside string literals.
+
+\begin{caml_example}{toplevel}
+let longstr =
+ "Call me Ishmael. Some years ago — never mind how long \
+ precisely — having little or no money in my purse, and \
+ nothing particular to interest me on shore, I thought I\
+ \ would sail about a little and see the watery part of t\
+ he world.";;
+\end{caml_example}
+
+Quoted string literals provide an alternative lexical syntax for
+string literals. They are useful to represent strings of arbitrary content
+without escaping. Quoted strings are delimited by a matching pair
+of @'{' quoted-string-id '|'@ and @'|' quoted-string-id '}'@ with
+the same @quoted-string-id@ on both sides. Quoted strings do not interpret
+any character in a special way but requires that the
+sequence @'|' quoted-string-id '}'@ does not occur in the string itself.
+The identifier @quoted-string-id@ is a (possibly empty) sequence of
+lowercase letters and underscores that can be freely chosen to avoid
+such issue.
+
+\begin{caml_example}{toplevel}
+let quoted_greeting = {|"Hello, World!"|}
+let nested = {ext|hello {|world|}|ext};;
+\end{caml_example}
+
+The current implementation places practically no restrictions on the
+length of string literals.
+
+\subsubsection*{sss:labelname}{Naming labels}
+
+To avoid ambiguities, naming labels in expressions cannot just be defined
+syntactically as the sequence of the three tokens "~", @ident@ and
+":", and have to be defined at the lexical level.
+
+\begin{syntax}
+label-name: lowercase-ident
+;
+label: "~" label-name ":"
+;
+optlabel: "?" label-name ":"
+\end{syntax}
+
+Naming labels come in two flavours: @label@ for normal arguments and
+@optlabel@ for optional ones. They are simply distinguished by their
+first character, either "~" or "?".
+
+Despite @label@ and @optlabel@ being lexical entities in expressions,
+their expansions @'~' label-name ':'@ and @'?' label-name ':'@ will be
+used in grammars, for the sake of readability. Note also that inside
+type expressions, this expansion can be taken literally, {\em i.e.}
+there are really 3 tokens, with optional blanks between them.
+
+\subsubsection*{sss:lex-ops-symbols}{Prefix and infix symbols}
+
+%% || '`' lowercase-ident '`'
+
+\begin{syntax}
+infix-symbol:
+ ( core-operator-char || '%' || '<' ) { operator-char }
+ | "#" {{ operator-char }}
+;
+prefix-symbol:
+ '!' { operator-char }
+ | ('?' || '~') {{ operator-char }}
+;
+operator-char:
+ '~' || '!' || '?' || core-operator-char || '%' || '<' || ':' || '.'
+;
+core-operator-char:
+ '$' || '&' || '*' || '+' || '-' || '/' || '=' || '>' || '@' || '^' || '|'
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:ext-ops]{extension operators},
+\hyperref[s:index-operators]{extended indexing operators},
+and \hyperref[s:binding-operators]{binding operators}.
+
+Sequences of ``operator characters'', such as "<=>" or "!!",
+are read as a single token from the @infix-symbol@ or @prefix-symbol@
+class. These symbols are parsed as prefix and infix operators inside
+expressions, but otherwise behave like normal identifiers.
+%% Identifiers starting with a lowercase letter and enclosed
+%% between backquote characters @'`' lowercase-ident '`'@ are also parsed
+%% as infix operators.
+
+\subsubsection*{sss:keywords}{Keywords}
+
+The identifiers below are reserved as keywords, and cannot be employed
+otherwise:
+\begin{verbatim}
+ and as assert asr begin class
+ constraint do done downto else end
+ exception external false for fun function
+ functor if in include inherit initializer
+ land lazy let lor lsl lsr
+ lxor match method mod module mutable
+ new nonrec object of open or
+ private rec sig struct then to
+ true try type val virtual when
+ while with
+\end{verbatim}
+%
+\goodbreak%
+%
+The following character sequences are also keywords:
+%
+%% FIXME the token >] is not used anywhere in the syntax
+%
+\begin{alltt}
+" != # & && ' ( ) * + , -"
+" -. -> . .. .~ : :: := :> ; ;;"
+" < <- = > >] >} ? [ [< [> [|"
+" ] _ ` { {< | |] || } ~"
+\end{alltt}
+%
+Note that the following identifiers are keywords of the now unmaintained Camlp4
+system and should be avoided for backwards compatibility reasons.
+%
+\begin{verbatim}
+ parser value $ $$ $: <: << >> ??
+\end{verbatim}
+
+\subsubsection*{sss:lex-ambiguities}{Ambiguities}
+
+Lexical ambiguities are resolved according to the ``longest match''
+rule: when a character sequence can be decomposed into two tokens in
+several different ways, the decomposition retained is the one with the
+longest first token.
+
+\subsubsection*{sss:lex-linedir}{Line number directives}
+
+\begin{syntax}
+linenum-directive:
+ '#' {{"0" \ldots "9"}} '"' { string-character } '"'
+\end{syntax}
+
+Preprocessors that generate OCaml source code can insert line number
+directives in their output so that error messages produced by the
+compiler contain line numbers and file names referring to the source
+file before preprocessing, instead of after preprocessing.
+A line number directive starts at the beginning of a line,
+is composed of a @"#"@ (sharp sign), followed by
+a positive integer (the source line number), followed by a
+character string (the source file name).
+Line number directives are treated as blanks during lexical
+analysis.
+
+% FIXME spaces and tabs are allowed before and after the number
+% FIXME ``string-character'' is inaccurate: everything is allowed except
+% CR, LF, and doublequote; moreover, backslash escapes are not
+% interpreted (especially backslash-doublequote)
+% FIXME any number of random characters are allowed (and ignored) at the
+% end of the line, except CR and LF.
--- /dev/null
+\section{s:modtypes}{Module types (module specifications)}
+%HEVEA\cutname{modtypes.html}
+
+Module types are the module-level equivalent of type expressions: they
+specify the general shape and type properties of modules.
+
+\ikwd{sig\@\texttt{sig}}
+\ikwd{end\@\texttt{end}}
+\ikwd{functor\@\texttt{functor}}
+\ikwd{with\@\texttt{with}}
+\ikwd{and\@\texttt{and}}
+\ikwd{val\@\texttt{val}}
+\ikwd{external\@\texttt{external}}
+\ikwd{type\@\texttt{type}}
+\ikwd{exception\@\texttt{exception}}
+\ikwd{class\@\texttt{class}}
+\ikwd{module\@\texttt{module}}
+\ikwd{open\@\texttt{open}}
+\ikwd{include\@\texttt{include}}
+
+\begin{syntax}
+module-type:
+ modtype-path
+ | 'sig' { specification [';;'] } 'end'
+ | 'functor' '(' module-name ':' module-type ')' '->' module-type
+ | module-type '->' module-type
+ | module-type 'with' mod-constraint { 'and' mod-constraint }
+ | '(' module-type ')'
+;
+mod-constraint:
+ 'type' [type-params] typeconstr type-equation { type-constraint }
+ | 'module' module-path '=' extended-module-path
+;
+%BEGIN LATEX
+\end{syntax}
+\begin{syntax}
+%END LATEX
+specification:
+ 'val' value-name ':' typexpr
+ | 'external' value-name ':' typexpr '=' external-declaration
+ | type-definition
+ | 'exception' constr-decl
+ | class-specification
+ | classtype-definition
+ | 'module' module-name ':' module-type
+ | 'module' module-name { '(' module-name ':' module-type ')' }
+ ':' module-type
+ | 'module' 'type' modtype-name
+ | 'module' 'type' modtype-name '=' module-type
+ | 'open' module-path
+ | 'include' module-type
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:module-type-of]{recovering the type of a module},
+\hyperref[s:signature-substitution]{substitution inside a signature},
+\hyperref[s:module-alias]{type-level module aliases},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes},
+\hyperref[s:generative-functors]{generative functors},
+and \hyperref[ss:module-type-substitution]{module type substitutions}.
+
+\subsection{ss:mty-simple}{Simple module types}
+
+The expression @modtype-path@ is equivalent to the module type bound
+to the name @modtype-path@.
+The expression @'(' module-type ')'@ denotes the same type as
+@module-type@.
+
+\subsection{ss:mty-signatures}{Signatures}
+
+\ikwd{sig\@\texttt{sig}}
+\ikwd{end\@\texttt{end}}
+
+Signatures are type specifications for structures. Signatures
+@'sig' \ldots 'end'@ are collections of type specifications for value
+names, type names, exceptions, module names and module type names. A
+structure will match a signature if the structure provides definitions
+(implementations) for all the names specified in the signature (and
+possibly more), and these definitions meet the type requirements given
+in the signature.
+
+An optional @";;"@ is allowed after each specification in a
+signature. It serves as a syntactic separator with no semantic
+meaning.
+
+\subsubsection*{sss:mty-values}{Value specifications}
+
+\ikwd{val\@\texttt{val}}
+
+A specification of a value component in a signature is written
+@'val' value-name ':' typexpr@, where @value-name@ is the name of the
+value and @typexpr@ its expected type.
+
+\ikwd{external\@\texttt{external}}
+
+The form @'external' value-name ':' typexpr '=' external-declaration@
+is similar, except that it requires in addition the name to be
+implemented as the external function specified in @external-declaration@
+(see chapter~\ref{c:intf-c}).
+
+\subsubsection*{sss:mty-type}{Type specifications}
+
+\ikwd{type\@\texttt{type}}
+
+A specification of one or several type components in a signature is
+written @'type' typedef { 'and' typedef }@ and consists of a sequence
+of mutually recursive definitions of type names.
+
+Each type definition in the signature specifies an optional type
+equation @'=' typexpr@ and an optional type representation
+@'=' constr-decl \ldots@ or @'=' '{' field-decl \ldots '}'@.
+The implementation of the type name in a matching structure must
+be compatible with the type expression specified in the equation (if
+given), and have the specified representation (if given). Conversely,
+users of that signature will be able to rely on the type equation
+or type representation, if given. More precisely, we have the
+following four situations:
+
+\begin{description}
+\item[Abstract type: no equation, no representation.] ~ \\
+Names that are defined as abstract types in a signature can be
+implemented in a matching structure by any kind of type definition
+(provided it has the same number of type parameters). The exact
+implementation of the type will be hidden to the users of the
+structure. In particular, if the type is implemented as a variant type
+or record type, the associated constructors and fields will not be
+accessible to the users; if the type is implemented as an
+abbreviation, the type equality between the type name and the
+right-hand side of the abbreviation will be hidden from the users of the
+structure. Users of the structure consider that type as incompatible
+with any other type: a fresh type has been generated.
+
+\item[Type abbreviation: an equation @'=' typexpr@, no representation.] ~ \\
+The type name must be implemented by a type compatible with @typexpr@.
+All users of the structure know that the type name is
+compatible with @typexpr@.
+
+\item[New variant type or record type: no equation, a representation.] ~ \\
+The type name must be implemented by a variant type or record type
+with exactly the constructors or fields specified. All users of the
+structure have access to the constructors or fields, and can use them
+to create or inspect values of that type. However, users of the
+structure consider that type as incompatible with any other type: a
+fresh type has been generated.
+
+\item[Re-exported variant type or record type: an equation,
+a representation.] ~ \\
+This case combines the previous two: the representation of the type is
+made visible to all users, and no fresh type is generated.
+\end{description}
+
+\subsubsection*{sss:mty-exn}{Exception specification}
+
+\ikwd{exception\@\texttt{exception}}
+
+The specification @'exception' constr-decl@ in a signature requires the
+matching structure to provide an exception with the name and arguments
+specified in the definition, and makes the exception available to all
+users of the structure.
+
+\subsubsection*{sss:mty-class}{Class specifications}
+
+\ikwd{class\@\texttt{class}}
+
+A specification of one or several classes in a signature is written
+@'class' class-spec { 'and' class-spec }@ and consists of a sequence
+of mutually recursive definitions of class names.
+
+Class specifications are described more precisely in
+section~\ref{ss:class-spec}.
+
+\subsubsection*{sss:mty-classtype}{Class type specifications}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+
+A specification of one or several class types in a signature is
+written @'class' 'type' classtype-def@ @{ 'and' classtype-def }@ and
+consists of a sequence of mutually recursive definitions of class type
+names. Class type specifications are described more precisely in
+section~\ref{ss:classtype}.
+
+\subsubsection*{sss:mty-module}{Module specifications}
+
+\ikwd{module\@\texttt{module}}
+
+A specification of a module component in a signature is written
+@'module' module-name ':' module-type@, where @module-name@ is the
+name of the module component and @module-type@ its expected type.
+Modules can be nested arbitrarily; in particular, functors can appear
+as components of structures and functor types as components of
+signatures.
+
+For specifying a module component that is a functor, one may write
+\begin{center}
+@'module' module-name '(' name_1 ':' module-type_1 ')'
+ \ldots '(' name_n ':' module-type_n ')'
+ ':' module-type@
+\end{center}
+instead of
+\begin{center}
+@'module' module-name ':'
+ 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
+ '->' module-type@
+\end{center}
+
+\subsubsection*{sss:mty-mty}{Module type specifications}
+
+\ikwd{type\@\texttt{type}}
+\ikwd{module\@\texttt{module}}
+
+A module type component of a signature can be specified either as a
+manifest module type or as an abstract module type.
+
+An abstract module type specification
+@'module' 'type' modtype-name@ allows the name @modtype-name@ to be
+implemented by any module type in a matching signature, but hides the
+implementation of the module type to all users of the signature.
+
+A manifest module type specification
+@'module' 'type' modtype-name '=' module-type@
+requires the name @modtype-name@ to be implemented by the module type
+@module-type@ in a matching signature, but makes the equality between
+@modtype-name@ and @module-type@ apparent to all users of the signature.
+
+\subsubsection{sss:mty-open}{Opening a module path}
+
+\ikwd{open\@\texttt{open}}
+
+The expression @'open' module-path@ in a signature does not specify
+any components. It simply affects the parsing of the following items
+of the signature, allowing components of the module denoted by
+@module-path@ to be referred to by their simple names @name@ instead of
+path accesses @module-path '.' name@. The scope of the @"open"@
+stops at the end of the signature expression.
+
+\subsubsection{sss:mty-include}{Including a signature}
+
+\ikwd{include\@\texttt{include}}
+
+The expression @'include' module-type@ in a signature performs textual
+inclusion of the components of the signature denoted by @module-type@.
+It behaves as if the components of the included signature were copied
+at the location of the @'include'@. The @module-type@ argument must
+refer to a module type that is a signature, not a functor type.
+
+\subsection{ss:mty-functors}{Functor types}
+
+\ikwd{functor\@\texttt{functor}}
+
+The module type expression
+@'functor' '(' module-name ':' module-type_1 ')' '->' module-type_2@
+is the type of functors (functions from modules to modules) that take
+as argument a module of type @module-type_1@ and return as result a
+module of type @module-type_2@. The module type @module-type_2@ can
+use the name @module-name@ to refer to type components of the actual
+argument of the functor. If the type @module-type_2@ does not
+depend on type components of @module-name@, the module type expression
+can be simplified with the alternative short syntax
+@ module-type_1 '->' module-type_2 @.
+No restrictions are placed on the type of the functor argument; in
+particular, a functor may take another functor as argument
+(``higher-order'' functor).
+
+\subsection{ss:mty-with}{The "with" operator}
+
+\ikwd{with\@\texttt{with}}
+
+Assuming @module-type@ denotes a signature, the expression
+@module-type 'with' mod-constraint@ @{ 'and' mod-constraint }@ denotes
+the same signature where type equations have been added to some of the
+type specifications, as described by the constraints following the
+"with" keyword. The constraint @'type' [type-parameters] typeconstr
+'=' typexpr@ adds the type equation @'=' typexpr@ to the specification
+of the type component named @typeconstr@ of the constrained signature.
+The constraint @'module' module-path '=' extended-module-path@ adds
+type equations to all type components of the sub-structure denoted by
+@module-path@, making them equivalent to the corresponding type
+components of the structure denoted by @extended-module-path@.
+
+For instance, if the module type name "S" is bound to the signature
+\begin{verbatim}
+ sig type t module M: (sig type u end) end
+\end{verbatim}
+then "S with type t=int" denotes the signature
+\begin{verbatim}
+ sig type t=int module M: (sig type u end) end
+\end{verbatim}
+and "S with module M = N" denotes the signature
+\begin{verbatim}
+ sig type t module M: (sig type u=N.u end) end
+\end{verbatim}
+A functor taking two arguments of type "S" that share their "t" component
+is written
+\begin{verbatim}
+ functor (A: S) (B: S with type t = A.t) ...
+\end{verbatim}
+
+Constraints are added left to right. After each constraint has been
+applied, the resulting signature must be a subtype of the signature
+before the constraint was applied. Thus, the @'with'@ operator can
+only add information on the type components of a signature, but never
+remove information.
--- /dev/null
+\section{s:module-expr}{Module expressions (module implementations)}
+%HEVEA\cutname{modules.html}
+
+Module expressions are the module-level equivalent of value
+expressions: they evaluate to modules, thus providing implementations
+for the specifications expressed in module types.
+
+\ikwd{struct\@\texttt{struct}}
+\ikwd{end\@\texttt{end}}
+\ikwd{functor\@\texttt{functor}}
+\ikwd{let\@\texttt{let}}
+\ikwd{and\@\texttt{and}}
+\ikwd{external\@\texttt{external}}
+\ikwd{type\@\texttt{type}}
+\ikwd{exception\@\texttt{exception}}
+\ikwd{class\@\texttt{class}}
+\ikwd{module\@\texttt{module}}
+\ikwd{open\@\texttt{open}}
+\ikwd{include\@\texttt{include}}
+
+\begin{syntax}
+module-expr:
+ module-path
+ | 'struct' [ module-items ] 'end'
+ | 'functor' '(' module-name ':' module-type ')' '->' module-expr
+ | module-expr '(' module-expr ')'
+ | '(' module-expr ')'
+ | '(' module-expr ':' module-type ')'
+;
+module-items:
+ {';;'} ( definition || expr ) { {';;'} ( definition || ';;' expr) } {';;'}
+;
+%\end{syntax} \begin{syntax}
+definition:
+ 'let' ['rec'] let-binding { 'and' let-binding }
+ | 'external' value-name ':' typexpr '=' external-declaration
+ | type-definition
+ | exception-definition
+ | class-definition
+ | classtype-definition
+ | 'module' module-name { '(' module-name ':' module-type ')' }
+ [ ':' module-type ] \\ '=' module-expr
+ | 'module' 'type' modtype-name '=' module-type
+ | 'open' module-path
+ | 'include' module-expr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:recursive-modules]{recursive modules},
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:explicit-overriding-open]{overriding in open statements},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes} and
+\hyperref[s:generative-functors]{generative functors}.
+
+\subsection{ss:mexpr-simple}{Simple module expressions}
+
+The expression @module-path@ evaluates to the module bound to the name
+@module-path@.
+
+The expression @'(' module-expr ')'@ evaluates to the same module as
+@module-expr@.
+
+The expression @'(' module-expr ':' module-type ')'@ checks that the
+type of @module-expr@ is a subtype of @module-type@, that is, that all
+components specified in @module-type@ are implemented in
+@module-expr@, and their implementation meets the requirements given
+in @module-type@. In other terms, it checks that the implementation
+@module-expr@ meets the type specification @module-type@. The whole
+expression evaluates to the same module as @module-expr@, except that
+all components not specified in @module-type@ are hidden and can no
+longer be accessed.
+
+\subsection{ss:mexpr-structures}{Structures}
+
+\ikwd{struct\@\texttt{struct}}
+\ikwd{end\@\texttt{end}}
+
+Structures @'struct' \ldots 'end'@ are collections of definitions for
+value names, type names, exceptions, module names and module type
+names. The definitions are evaluated in the order in which they appear
+in the structure. The scopes of the bindings performed by the
+definitions extend to the end of the structure. As a consequence, a
+definition may refer to names bound by earlier definitions in the same
+structure.
+
+For compatibility with toplevel phrases (chapter~\ref{c:camllight}),
+optional @";;"@ are allowed after and before each definition in a structure. These
+@";;"@ have no semantic meanings. Similarly, an @expr@ preceded by ";;" is allowed as
+a component of a structure. It is equivalent to @'let' '_' '=' expr@, i.e. @expr@ is
+evaluated for its side-effects but is not bound to any identifier. If @expr@ is
+the first component of a structure, the preceding ";;" can be omitted.
+
+\subsubsection*{sss:mexpr-value-defs}{Value definitions}
+
+\ikwd{let\@\texttt{let}}
+
+A value definition @'let' ['rec'] let-binding { 'and' let-binding }@
+bind value names in the same way as a @'let' \ldots 'in' \ldots@ expression
+(see section~\ref{sss:expr-localdef}). The value names appearing in the
+left-hand sides of the bindings are bound to the corresponding values
+in the right-hand sides.
+
+\ikwd{external\@\texttt{external}}
+
+A value definition @'external' value-name ':' typexpr '=' external-declaration@
+implements @value-name@ as the external function specified in
+@external-declaration@ (see chapter~\ref{c:intf-c}).
+
+\subsubsection*{sss:mexpr-type-defs}{Type definitions}
+
+\ikwd{type\@\texttt{type}}
+
+A definition of one or several type components is written
+@'type' typedef { 'and' typedef }@ and consists of a sequence
+of mutually recursive definitions of type names.
+
+\subsubsection*{sss:mexpr-exn-defs}{Exception definitions}
+
+\ikwd{exception\@\texttt{exception}}
+
+Exceptions are defined with the syntax @'exception' constr-decl@
+or @'exception' constr-name '=' constr@.
+
+\subsubsection*{sss:mexpr-class-defs}{Class definitions}
+
+\ikwd{class\@\texttt{class}}
+
+A definition of one or several classes is written @'class'
+class-binding { 'and' class-binding }@ and consists of a sequence of
+mutually recursive definitions of class names. Class definitions are
+described more precisely in section~\ref{ss:class-def}.
+
+\subsubsection*{sss:mexpr-classtype-defs}{Class type definitions}
+
+\ikwd{class\@\texttt{class}}
+\ikwd{type\@\texttt{type}}
+
+A definition of one or several classes is written
+@'class' 'type' classtype-def { 'and' classtype-def }@ and consists of
+a sequence of mutually recursive definitions of class type names.
+Class type definitions are described more precisely in
+section~\ref{ss:classtype}.
+
+\subsubsection*{sss:mexpr-module-defs}{Module definitions}
+
+\ikwd{module\@\texttt{module}}
+
+The basic form for defining a module component is
+@'module' module-name '=' module-expr@, which evaluates @module-expr@ and binds
+the result to the name @module-name@.
+
+One can write
+\begin{center}
+@'module' module-name ':' module-type '=' module-expr@
+\end{center}
+instead of
+\begin{center}
+@'module' module-name '=' '(' module-expr ':' module-type ')'@.
+\end{center}
+Another derived form is
+\begin{center}
+@'module' module-name '(' name_1 ':' module-type_1 ')' \ldots
+ '(' name_n ':' module-type_n ')' '=' module-expr@
+\end{center}
+which is equivalent to
+\begin{center}
+@'module' module-name '='
+ 'functor' '(' name_1 ':' module-type_1 ')' '->' \ldots
+ '->' module-expr@
+\end{center}
+
+\subsubsection*{sss:mexpr-modtype-defs}{Module type definitions}
+
+\ikwd{type\@\texttt{type}}
+\ikwd{module\@\texttt{module}}
+
+A definition for a module type is written
+@'module' 'type' modtype-name '=' module-type@.
+It binds the name @modtype-name@ to the module type denoted by the
+expression @module-type@.
+
+\subsubsection*{sss:mexpr-open}{Opening a module path}
+
+\ikwd{open\@\texttt{open}}
+
+The expression @'open' module-path@ in a structure does not define any
+components nor perform any bindings. It simply affects the parsing of
+the following items of the structure, allowing components of the
+module denoted by @module-path@ to be referred to by their simple names
+@name@ instead of path accesses @module-path '.' name@. The scope of
+the @"open"@ stops at the end of the structure expression.
+
+\subsubsection*{sss:mexpr-include}{Including the components of another structure}
+
+\ikwd{include\@\texttt{include}}
+
+The expression @'include' module-expr@ in a structure re-exports in
+the current structure all definitions of the structure denoted by
+@module-expr@. For instance, if you define a module "S" as below
+\begin{caml_example*}{verbatim}
+module S = struct type t = int let x = 2 end
+\end{caml_example}
+defining the module "B" as
+\begin{caml_example*}{verbatim}
+module B = struct include S let y = (x + 1 : t) end
+\end{caml_example}
+is equivalent to defining it as
+\begin{caml_example*}{verbatim}
+module B = struct type t = S.t let x = S.x let y = (x + 1 : t) end
+\end{caml_example}
+The difference between @'open'@ and @'include'@ is that @'open'@
+simply provides short names for the components of the opened
+structure, without defining any components of the current structure,
+while @'include'@ also adds definitions for the components of the
+included structure.
+
+\subsection{ss:mexpr-functors}{Functors}
+
+\subsubsection*{sss:mexpr-functor-defs}{Functor definition}
+
+\ikwd{functor\@\texttt{functor}}
+
+The expression @'functor' '(' module-name ':' module-type ')' '->'
+module-expr@ evaluates to a functor that takes as argument modules of
+the type @module-type_1@, binds @module-name@ to these modules,
+evaluates @module-expr@ in the extended environment, and returns the
+resulting modules as results. No restrictions are placed on the type of the
+functor argument; in particular, a functor may take another functor as
+argument (``higher-order'' functor).
+
+\subsubsection*{sss:mexpr-functor-app}{Functor application}
+
+The expression @module-expr_1 '(' module-expr_2 ')'@ evaluates
+@module-expr_1@ to a functor and @module-expr_2@ to a module, and
+applies the former to the latter. The type of @module-expr_2@ must
+match the type expected for the arguments of the functor @module-expr_1@.
+
--- /dev/null
+\section{s:names}{Names}
+%HEVEA\cutname{names.html}
+
+Identifiers are used to give names to several classes of language
+objects and refer to these objects by name later:
+\begin{itemize}
+\item value names (syntactic class @value-name@),
+\item value constructors and exception constructors (class @constr-name@),
+\item labels (@label-name@, defined in section~\ref{sss:labelname}),
+\item polymorphic variant tags (@tag-name@),
+\item type constructors (@typeconstr-name@),
+\item record fields (@field-name@),
+\item class names (@class-name@),
+\item method names (@method-name@),
+\item instance variable names (@inst-var-name@),
+\item module names (@module-name@),
+\item module type names (@modtype-name@).
+\end{itemize}
+These eleven name spaces are distinguished both by the context and by the
+capitalization of the identifier: whether the first letter of the
+identifier is in lowercase (written @lowercase-ident@ below) or in
+uppercase (written @capitalized-ident@). Underscore is considered a
+lowercase letter for this purpose.
+
+\subsubsection*{sss:naming-objects}{Naming objects}
+\ikwd{mod\@\texttt{mod}}
+\ikwd{land\@\texttt{land}}
+\ikwd{lor\@\texttt{lor}}
+\ikwd{lxor\@\texttt{lxor}}
+\ikwd{lsl\@\texttt{lsl}}
+\ikwd{lsr\@\texttt{lsr}}
+\ikwd{asr\@\texttt{asr}}
+
+\begin{syntax}
+value-name:
+ lowercase-ident
+ | '(' operator-name ')'
+;
+operator-name:
+ prefix-symbol || infix-op
+;
+infix-op:
+ infix-symbol
+ | '*' || '+' || '-' || '-.' || '=' || '!=' || '<' || '>' || 'or' || '||'
+ || '&' || '&&' || ':='
+ | 'mod' || 'land' || 'lor' || 'lxor' || 'lsl' || 'lsr' || 'asr'
+;
+constr-name:
+ capitalized-ident
+;
+tag-name:
+ capitalized-ident
+;
+typeconstr-name:
+ lowercase-ident
+;
+field-name:
+ lowercase-ident
+;
+module-name:
+ capitalized-ident
+;
+modtype-name:
+ ident
+;
+class-name:
+ lowercase-ident
+;
+inst-var-name:
+ lowercase-ident
+;
+method-name:
+ lowercase-ident
+\end{syntax}
+See also the following language extension:
+\hyperref[s:index-operators]{extended indexing operators}.
+
+As shown above, prefix and infix symbols as well as some keywords can
+be used as value names, provided they are written between parentheses.
+The capitalization rules are summarized in the table below.
+
+\begin{tableau}{|l|l|}{Name space}{Case of first letter}
+\entree{Values}{lowercase}
+\entree{Constructors}{uppercase}
+\entree{Labels}{lowercase}
+\entree{Polymorphic variant tags}{uppercase}
+\entree{Exceptions}{uppercase}
+\entree{Type constructors}{lowercase}
+\entree{Record fields}{lowercase}
+\entree{Classes}{lowercase}
+\entree{Instance variables}{lowercase}
+\entree{Methods}{lowercase}
+\entree{Modules}{uppercase}
+\entree{Module types}{any}
+\end{tableau}
+
+{\it Note on polymorphic variant tags:\/} the current implementation accepts
+lowercase variant tags in addition to capitalized variant tags, but we
+suggest you avoid lowercase variant tags for portability and
+compatibility with future OCaml versions.
+
+\subsubsection*{sss:refer-named}{Referring to named objects}
+
+\begin{syntax}
+value-path:
+ [ module-path '.' ] value-name
+;
+constr:
+ [ module-path '.' ] constr-name
+;
+typeconstr:
+ [ extended-module-path '.' ] typeconstr-name
+;
+field:
+ [ module-path '.' ] field-name
+;
+modtype-path:
+ [ extended-module-path '.' ] modtype-name
+;
+class-path:
+ [ module-path '.' ] class-name
+;
+classtype-path:
+ [ extended-module-path '.' ] class-name
+;
+module-path:
+ module-name { '.' module-name }
+;
+extended-module-path:
+ extended-module-name { '.' extended-module-name }
+;
+extended-module-name:
+ module-name { '(' extended-module-path ')' }
+\end{syntax}
+
+A named object can be referred to either by its name (following the
+usual static scoping rules for names) or by an access path @prefix '.' name@,
+where @prefix@ designates a module and @name@ is the name of an object
+defined in that module. The first component of the path, @prefix@, is
+either a simple module name or an access path @name_1 '.' name_2 \ldots@,
+in case the defining module is itself nested inside other modules.
+For referring to type constructors, module types, or class types,
+the @prefix@ can
+also contain simple functor applications (as in the syntactic class
+@extended-module-path@ above) in case the defining module is the
+result of a functor application.
+
+Label names, tag names, method names and instance variable names need
+not be qualified: the former three are global labels, while the latter
+are local to a class.
--- /dev/null
+\section{s:patterns}{Patterns}
+\ikwd{as\@\texttt{as}}
+%HEVEA\cutname{patterns.html}
+\begin{syntax}
+pattern:
+ value-name
+ | '_'
+ | constant
+ | pattern 'as' value-name
+ | '(' pattern ')'
+ | '(' pattern ':' typexpr ')'
+ | pattern '|' pattern
+ | constr pattern
+ | "`"tag-name pattern
+ | "#"typeconstr
+ | pattern {{ ',' pattern }}
+ | '{' field [':' typexpr] ['=' pattern]%
+ { ';' field [':' typexpr] ['=' pattern] } [';' '_' ] [ ';' ] '}'
+ | '[' pattern { ';' pattern } [ ';' ] ']'
+ | pattern '::' pattern
+ | '[|' pattern { ';' pattern } [ ';' ] '|]'
+ | char-literal '..' char-literal
+ | 'lazy' pattern
+ | 'exception' pattern
+ | module-path '.(' pattern ')'
+ | module-path '.[' pattern ']'
+ | module-path '.[|' pattern '|]'
+ | module-path '.{' pattern '}'
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+The table below shows the relative precedences and associativity of
+operators and non-closed pattern constructions. The constructions with
+higher precedences come first.
+\ikwd{as\@\texttt{as}}
+\begin{tableau}{|l|l|}{Operator}{Associativity}
+\entree{".."}{--}
+\entree{"lazy" (see section~\ref{sss:pat-lazy})}{--}
+\entree{Constructor application, Tag application}{right}
+\entree{"::"}{right}
+\entree{","}{--}
+\entree{"|"}{left}
+\entree{"as"}{--}
+\end{tableau}
+
+Patterns are templates that allow selecting data structures of a
+given shape, and binding identifiers to components of the data
+structure. This selection operation is called pattern matching; its
+outcome is either ``this value does not match this pattern'', or
+``this value matches this pattern, resulting in the following bindings
+of names to values''.
+
+\subsubsection*{sss:pat-variable}{Variable patterns}
+
+A pattern that consists in a value name matches any value,
+binding the name to the value. The pattern @"_"@ also matches
+any value, but does not bind any name.
+
+\begin{caml_example}{toplevel}
+let is_empty = function
+ | [] -> true
+ | _ :: _ -> false;;
+\end{caml_example}
+
+Patterns are {\em linear\/}: a variable cannot be bound several times by
+a given pattern. In particular, there is no way to test for equality
+between two parts of a data structure using only a pattern:
+
+\begin{caml_example}{toplevel}[error]
+let pair_equal = function
+ | x, x -> true
+ | x, y -> false;;
+\end{caml_example}
+
+However, we can use a @"when"@ guard for this purpose:
+
+\begin{caml_example}{toplevel}
+let pair_equal = function
+ | x, y when x = y -> true
+ | _ -> false;;
+\end{caml_example}
+
+\subsubsection*{sss:pat-const}{Constant patterns}
+
+A pattern consisting in a constant matches the values that
+are equal to this constant.
+
+\begin{caml_example}{toplevel}
+let bool_of_string = function
+ | "true" -> true
+ | "false" -> false
+ | _ -> raise (Invalid_argument "bool_of_string");;
+\end{caml_example}
+
+%% FIXME for negative numbers, blanks are allowed between the minus
+%% sign and the first digit.
+
+\subsubsection*{sss:pat-alias}{Alias patterns}
+\ikwd{as\@\texttt{as}}
+
+The pattern @pattern_1 "as" value-name@ matches the same values as
+@pattern_1@. If the matching against @pattern_1@ is successful,
+the name @value-name@ is bound to the matched value, in addition to the
+bindings performed by the matching against @pattern_1@.
+
+\begin{caml_example}{toplevel}
+let sort_pair ((x, y) as p) =
+ if x <= y then p else (y, x);;
+\end{caml_example}
+
+\subsubsection*{sss:pat-parenthesized}{Parenthesized patterns}
+
+The pattern @"(" pattern_1 ")"@ matches the same values as
+@pattern_1@. A type constraint can appear in a
+parenthesized pattern, as in @"(" pattern_1 ":" typexpr ")"@. This
+constraint forces the type of @pattern_1@ to be compatible with
+@typexpr@.
+
+\begin{caml_example}{toplevel}
+let int_triple_is_ordered ((a, b, c) : int * int * int) =
+ a <= b && b <= c;;
+\end{caml_example}
+
+\subsubsection*{sss:pat-or}{``Or'' patterns}
+
+The pattern @pattern_1 "|" pattern_2@ represents the logical ``or'' of
+the two patterns @pattern_1@ and @pattern_2@. A value matches
+@pattern_1 "|" pattern_2@ if it matches @pattern_1@ or
+@pattern_2@. The two sub-patterns @pattern_1@ and @pattern_2@
+must bind exactly the same identifiers to values having the same types.
+Matching is performed from left to right.
+More precisely,
+in case some value~$v$ matches @pattern_1 "|" pattern_2@, the bindings
+performed are those of @pattern_1@ when $v$ matches @pattern_1@.
+Otherwise, value~$v$ matches @pattern_2@ whose bindings are performed.
+
+\begin{caml_example}{toplevel}
+type shape = Square of float | Rect of (float * float) | Circle of float
+
+let is_rectangular = function
+ | Square _ | Rect _ -> true
+ | Circle _ -> false;;
+\end{caml_example}
+
+\subsubsection*{sss:pat-variant}{Variant patterns}
+
+The pattern @constr '(' pattern_1 ',' \ldots ',' pattern_n ')'@ matches
+all variants whose
+constructor is equal to @constr@, and whose arguments match
+@pattern_1 \ldots pattern_n@. It is a type error if $n$ is not the
+number of arguments expected by the constructor.
+
+The pattern @constr '_'@ matches all variants whose constructor is
+@constr@.
+
+\begin{caml_example}{toplevel}
+type 'a tree = Lf | Br of 'a tree * 'a * 'a tree
+
+let rec total = function
+ | Br (l, x, r) -> total l + x + total r
+ | Lf -> 0;;
+\end{caml_example}
+
+The pattern @pattern_1 "::" pattern_2@ matches non-empty lists whose
+heads match @pattern_1@, and whose tails match @pattern_2@.
+
+The pattern @"[" pattern_1 ";" \ldots ";" pattern_n "]"@ matches lists
+of length $n$ whose elements match @pattern_1@ \ldots @pattern_n@,
+respectively. This pattern behaves like
+@pattern_1 "::" \ldots "::" pattern_n "::" "[]"@.
+
+\begin{caml_example}{toplevel}
+let rec destutter = function
+ | [] -> []
+ | [a] -> [a]
+ | a :: b :: t -> if a = b then destutter (b :: t) else a :: destutter (b :: t);;
+\end{caml_example}
+
+\subsubsection*{sss:pat-polyvar}{Polymorphic variant patterns}
+
+The pattern @"`"tag-name pattern_1@ matches all polymorphic variants
+whose tag is equal to @tag-name@, and whose argument matches
+@pattern_1@.
+
+\begin{caml_example}{toplevel}
+let rec split = function
+ | [] -> ([], [])
+ | h :: t ->
+ let ss, gs = split t in
+ match h with
+ | `Sheep _ as s -> (s :: ss, gs)
+ | `Goat _ as g -> (ss, g :: gs);;
+\end{caml_example}
+
+\subsubsection*{sss:pat-polyvar-abbrev}{Polymorphic variant abbreviation patterns}
+
+If the type @["('a,'b,"\ldots")"] typeconstr = "[" "`"tag-name_1 typexpr_1 "|"
+\ldots "|" "`"tag-name_n typexpr_n"]"@ is defined, then the pattern @"#"typeconstr@
+is a shorthand for the following or-pattern:
+@"(" "`"tag-name_1"(_" ":" typexpr_1")" "|" \ldots "|" "`"tag-name_n"(_"
+":" typexpr_n"))"@. It matches all values of type @"[<" typeconstr "]"@.
+
+\begin{caml_example}{toplevel}
+type 'a rectangle = [`Square of 'a | `Rectangle of 'a * 'a]
+type 'a shape = [`Circle of 'a | 'a rectangle]
+
+let try_rectangle = function
+ | #rectangle as r -> Some r
+ | `Circle _ -> None;;
+\end{caml_example}
+
+\subsubsection*{sss:pat-tuple}{Tuple patterns}
+
+The pattern @pattern_1 "," \ldots "," pattern_n@ matches $n$-tuples
+whose components match the patterns @pattern_1@ through @pattern_n@. That
+is, the pattern matches the tuple values $(v_1, \ldots, v_n)$ such that
+@pattern_i@ matches $v_i$ for \fromoneto{i}{n}.
+
+\begin{caml_example}{toplevel}
+let vector (x0, y0) (x1, y1) =
+ (x1 -. x0, y1 -. y0);;
+\end{caml_example}
+
+\subsubsection*{sss:pat-record}{Record patterns}
+
+The pattern @"{" field_1 ["=" pattern_1] ";" \ldots ";" field_n ["="
+pattern_n] "}"@ matches records that define at least the fields
+@field_1@ through @field_n@, and such that the value associated to
+@field_i@ matches the pattern @pattern_i@, for \fromoneto{i}{n}.
+A single identifier @field_k@ stands for @field_k '=' field_k @,
+and a single qualified identifier @module-path '.' field_k@ stands
+for @module-path '.' field_k '=' field_k @.
+The record value can define more fields than @field_1@ \ldots
+@field_n@; the values associated to these extra fields are not taken
+into account for matching. Optionally, a record pattern can be terminated
+by @';' '_'@ to convey the fact that not all fields of the record type are
+listed in the record pattern and that it is intentional.
+Optional type constraints can be added field by field with
+@"{" field_1 ":" typexpr_1 "=" pattern_1 ";"%
+\ldots ";"field_n ":" typexpr_n "=" pattern_n "}"@ to force the type
+of @field_k@ to be compatible with @typexpr_k@.
+
+\begin{caml_example}{toplevel}
+let bytes_allocated
+ {Gc.minor_words = minor;
+ Gc.major_words = major;
+ Gc.promoted_words = prom;
+ _}
+ =
+ (Sys.word_size / 4) * int_of_float (minor +. major -. prom);;
+\end{caml_example}
+
+\subsubsection*{sss:pat-array}{Array patterns}
+
+The pattern @"[|" pattern_1 ";" \ldots ";" pattern_n "|]"@
+matches arrays of length $n$ such that the $i$-th array element
+matches the pattern @pattern_i@, for \fromoneto{i}{n}.
+
+\begin{caml_example}{toplevel}
+let matrix3_is_symmetric = function
+ | [|[|_; b; c|];
+ [|d; _; f|];
+ [|g; h; _|]|] -> b = d && c = g && f = h
+ | _ -> failwith "matrix3_is_symmetric: not a 3x3 matrix";;
+\end{caml_example}
+
+\subsubsection*{sss:pat-range}{Range patterns}
+
+The pattern
+@"'" @c@ "'" ".." "'" @d@ "'"@ is a shorthand for the pattern
+\begin{center}
+@"'" @c@ "'" "|" "'" @c@_1 "'" "|" "'" @c@_2 "'" "|" \ldots
+ "|" "'" @c@_n "'" "|" "'" @d@ "'"@
+\end{center}
+where \nth{c}{1}, \nth{c}{2}, \ldots, \nth{c}{n} are the characters
+that occur between \var{c} and \var{d} in the ASCII character set. For
+instance, the pattern "'0'"@'..'@"'9'" matches all characters that are digits.
+
+\begin{caml_example}{toplevel}
+type char_class = Uppercase | Lowercase | Digit | Other
+
+let classify_char = function
+ | 'A'..'Z' -> Uppercase
+ | 'a'..'z' -> Lowercase
+ | '0'..'9' -> Digit
+ | _ -> Other;;
+\end{caml_example}
+
+\subsubsection{sss:pat-lazy}{Lazy patterns}
+
+\ikwd{lazy\@\texttt{lazy}}
+
+(Introduced in Objective Caml 3.11)
+
+\begin{syntax}
+pattern: ...
+\end{syntax}
+
+The pattern @"lazy" pattern@ matches a value \var{v} of type "Lazy.t",
+provided @pattern@ matches the result of forcing \var{v} with
+"Lazy.force". A successful match of a pattern containing @"lazy"@
+sub-patterns forces the corresponding parts of the value being matched, even
+those that imply no test such as @"lazy" value-name@ or @"lazy" "_"@.
+Matching a value with a @pattern-matching@ where some patterns
+contain @"lazy"@ sub-patterns may imply forcing parts of the value,
+even when the pattern selected in the end has no @"lazy"@ sub-pattern.
+
+\begin{caml_example}{toplevel}
+let force_opt = function
+ | Some (lazy n) -> n
+ | None -> 0;;
+\end{caml_example}
+
+For more information, see the description of module "Lazy" in the
+standard library (module \stdmoduleref{Lazy}).
+%
+\index{Lazy (module)\@\verb`Lazy` (module)}%
+\index{force\@\verb`force`}%
+
+\subsubsection*{sss:exception-match}{Exception patterns}
+(Introduced in OCaml 4.02)
+
+A new form of exception pattern, @ 'exception' pattern @, is allowed
+only as a toplevel pattern or inside a toplevel or-pattern under
+a "match"..."with" pattern-matching
+(other occurrences are rejected by the type-checker).
+
+Cases with such a toplevel pattern are called ``exception cases'',
+as opposed to regular ``value cases''. Exception cases are applied
+when the evaluation of the matched expression raises an exception.
+The exception value is then matched against all the exception cases
+and re-raised if none of them accept the exception (as with a
+"try"..."with" block). Since the bodies of all exception and value
+cases are outside the scope of the exception handler, they are all
+considered to be in tail-position: if the "match"..."with" block
+itself is in tail position in the current function, any function call
+in tail position in one of the case bodies results in an actual tail
+call.
+
+A pattern match must contain at least one value case. It is an error if
+all cases are exceptions, because there would be no code to handle
+the return of a value.
+
+\begin{caml_example}{toplevel}
+let find_opt p l =
+ match List.find p l with
+ | exception Not_found -> None
+ | x -> Some x;;
+\end{caml_example}
+
+\subsubsection*{sss:pat-open}{Local opens for patterns}
+\ikwd{open\@\texttt{open}}
+(Introduced in OCaml 4.04)
+
+For patterns, local opens are limited to the
+@module-path'.('pattern')'@ construction. This
+construction locally opens the module referred to by the module path
+@module-path@ in the scope of the pattern @pattern@.
+
+When the body of a local open pattern is delimited by
+@'[' ']'@, @'[|' '|]'@, or @'{' '}'@, the parentheses can be omitted.
+For example, @module-path'.['pattern']'@ is equivalent to
+@module-path'.(['pattern'])'@, and @module-path'.[|' pattern '|]'@ is
+equivalent to @module-path'.([|' pattern '|])'@.
+
+\begin{caml_example}{toplevel}
+let bytes_allocated Gc.{minor_words; major_words; promoted_words; _} =
+ (Sys.word_size / 4)
+ * int_of_float (minor_words +. major_words -. promoted_words);;
+\end{caml_example}
--- /dev/null
+\chapter{The OCaml language} \label{c:refman}
+%HEVEA\cutname{language.html}
+
+%better html output that way, sniff.
+%HEVEA\subsection*{ss:foreword}{Foreword}
+%BEGIN LATEX
+\section*{s:foreword}{Foreword}
+%END LATEX
+
+This document is intended as a reference manual for the OCaml
+language. It lists the language constructs, and gives their precise
+syntax and informal semantics. It is by no means a tutorial
+introduction to the language. A good
+working knowledge of OCaml is assumed.
+
+No attempt has been made at mathematical rigor: words are employed
+with their intuitive meaning, without further definition. As a
+consequence, the typing rules have been left out, by lack of the
+mathematical framework required to express them, while they are
+definitely part of a full formal definition of the language.
+
+
+\subsection*{ss:notations}{Notations}
+
+The syntax of the language is given in BNF-like notation. Terminal
+symbols are set in typewriter font (@'like' 'this'@).
+Non-terminal symbols are set in italic font (@like that@).
+Square brackets @[\ldots]@ denote optional components. Curly brackets
+@{\ldots}@ denotes zero, one or several repetitions of the enclosed
+components. Curly brackets with a trailing plus sign @{{\ldots}}@
+denote one or several repetitions of the enclosed components.
+Parentheses @(\ldots)@ denote grouping.
+
+%HEVEA\cutdef{section}
+\input{lex}
+\input{values}
+\input{names}
+\input{types}
+\input{const}
+\input{patterns}
+\input{expr}
+\input{typedecl}
+\input{classes}
+\input{modtypes}
+\input{modules}
+\input{compunit}
+%HEVEA\cutend
--- /dev/null
+\section{s:tydef}{Type and exception definitions}
+%HEVEA\cutname{typedecl.html}%
+
+\subsection{ss:typedefs}{Type definitions}
+
+Type definitions bind type constructors to data types: either
+variant types, record types, type abbreviations, or abstract data
+types. They also bind the value constructors and record fields
+associated with the definition.
+
+\ikwd{type\@\texttt{type}}
+\ikwd{and\@\texttt{and}}
+\ikwd{nonrec\@\texttt{nonrec}}
+\ikwd{of\@\texttt{of}}
+
+\begin{syntax}
+type-definition:
+ 'type' ['nonrec'] typedef { 'and' typedef }
+;
+typedef:
+ [type-params] typeconstr-name type-information
+;
+type-information:
+ [type-equation] [type-representation] { type-constraint }
+;
+type-equation:
+ '=' typexpr
+;
+type-representation:
+ '=' ['|'] constr-decl { '|' constr-decl }
+ | '=' record-decl
+ | '=' '|'
+;
+type-params:
+ type-param
+ | '(' type-param { "," type-param } ')'
+;
+type-param:
+ [ext-variance] "'" ident
+;
+ext-variance:
+ variance [injectivity]
+ | injectivity [variance]
+;
+variance:
+ '+'
+ | '-'
+;
+injectivity: '!'
+;
+record-decl:
+ '{' field-decl { ';' field-decl } [';'] '}'
+;
+constr-decl:
+ (constr-name || '[]' || '(::)') [ 'of' constr-args ]
+;
+constr-args:
+ typexpr { '*' typexpr }
+;
+field-decl:
+ ['mutable'] field-name ':' poly-typexpr
+;
+type-constraint:
+ 'constraint' typexpr '=' typexpr
+\end{syntax}
+\ikwd{mutable\@\texttt{mutable}}
+\ikwd{constraint\@\texttt{constraint}}
+See also the following language extensions:
+\hyperref[s:private-types]{private types},
+\hyperref[s:gadts]{generalized algebraic datatypes},
+\hyperref[s:attributes]{attributes},
+\hyperref[s:extension-nodes]{extension nodes},
+\hyperref[s:extensible-variants]{extensible variant types} and
+\hyperref[s:inline-records]{inline records}.
+
+Type definitions are introduced by the "type" keyword, and
+consist in one or several simple definitions, possibly mutually
+recursive, separated by the "and" keyword. Each simple definition
+defines one type constructor.
+
+A simple definition consists in a lowercase identifier, possibly
+preceded by one or several type parameters, and followed by an
+optional type equation, then an optional type representation, and then
+a constraint clause. The identifier is the name of the type
+constructor being defined.
+
+\begin{verbatim}
+type colour =
+ | Red | Green | Blue | Yellow | Black | White
+ | RGB of {r : int; g : int; b : int}
+
+type 'a tree = Lf | Br of 'a * 'a tree * 'a;;
+
+type t = {decoration : string; substance : t'}
+and t' = Int of int | List of t list
+\end{verbatim}
+
+In the right-hand side of type definitions, references to one of the
+type constructor name being defined are considered as recursive,
+unless "type" is followed by "nonrec". The "nonrec" keyword was
+introduced in OCaml 4.02.2.
+
+The optional type parameters are either one type variable @"'" ident@,
+for type constructors with one parameter, or a list of type variables
+@"('"ident_1,\ldots,"'"ident_n")"@, for type constructors with several
+parameters. Each type parameter may be prefixed by a variance
+constraint @"+"@ (resp. @"-"@) indicating that the parameter is
+covariant (resp. contravariant), and an injectivity annotation @"!"@
+indicating that the parameter can be deduced from the whole type.
+These type parameters can appear in
+the type expressions of the right-hand side of the definition,
+optionally restricted by a variance constraint ; {\em i.e.\/} a
+covariant parameter may only appear on the right side of a functional
+arrow (more precisely, follow the left branch of an even number of
+arrows), and a contravariant parameter only the left side (left branch of
+an odd number of arrows). If the type has a representation or
+an equation, and the parameter is free ({\em i.e.\/} not bound via a
+type constraint to a constructed type), its variance constraint is
+checked but subtyping {\em etc.\/} will use the inferred variance of the
+parameter, which may be less restrictive; otherwise ({\em i.e.\/} for abstract
+types or non-free parameters), the variance must be given explicitly,
+and the parameter is invariant if no variance is given.
+
+The optional type equation @'=' typexpr@ makes the defined type
+equivalent to the type expression @typexpr@:
+one can be substituted for the other during typing.
+If no type equation is given, a new type is generated: the defined type
+is incompatible with any other type.
+
+The optional type representation describes the data structure
+representing the defined type, by giving the list of associated
+constructors (if it is a variant type) or associated fields (if it is
+a record type). If no type representation is given, nothing is
+assumed on the structure of the type besides what is stated in the
+optional type equation.
+
+The type representation @'=' ['|'] constr-decl { '|' constr-decl }@
+describes a variant type. The constructor declarations
+@constr-decl_1, \ldots, constr-decl_n@ describe the constructors
+associated to this variant type. The constructor
+declaration @constr-name 'of' typexpr_1 '*' \ldots '*' typexpr_n@
+declares the name @constr-name@ as a non-constant constructor, whose
+arguments have types @typexpr_1@ \ldots @typexpr_n@.
+The constructor declaration @constr-name@
+declares the name @constr-name@ as a constant
+constructor. Constructor names must be capitalized.
+
+The type representation @'=' '{' field-decl { ';' field-decl } [';'] '}'@
+describes a record type. The field declarations @field-decl_1, \ldots,
+field-decl_n@ describe the fields associated to this record type.
+The field declaration @field-name ':' poly-typexpr@ declares
+@field-name@ as a field whose argument has type @poly-typexpr@.
+The field declaration @'mutable' field-name ':' poly-typexpr@
+\ikwd{mutable\@\texttt{mutable}}
+behaves similarly; in addition, it allows physical modification of
+this field.
+Immutable fields are covariant, mutable fields are non-variant.
+Both mutable and immutable fields may have explicitly polymorphic
+types. The polymorphism of the contents is statically checked whenever
+a record value is created or modified. Extracted values may have their
+types instantiated.
+
+The two components of a type definition, the optional equation and the
+optional representation, can be combined independently, giving
+rise to four typical situations:
+
+\begin{description}
+\item[Abstract type: no equation, no representation.] ~\\
+When appearing in a module signature, this definition specifies
+nothing on the type constructor, besides its number of parameters:
+its representation is hidden and it is assumed incompatible with any
+other type.
+
+\item[Type abbreviation: an equation, no representation.] ~\\
+This defines the type constructor as an abbreviation for the type
+expression on the right of the @'='@ sign.
+
+\item[New variant type or record type: no equation, a representation.] ~\\
+This generates a new type constructor and defines associated
+constructors or fields, through which values of that type can be
+directly built or inspected.
+
+\item[Re-exported variant type or record type: an equation,
+a representation.] ~\\
+In this case, the type constructor is defined as an abbreviation for
+the type expression given in the equation, but in addition the
+constructors or fields given in the representation remain attached to
+the defined type constructor. The type expression in the equation part
+must agree with the representation: it must be of the same kind
+(record or variant) and have exactly the same constructors or fields,
+in the same order, with the same arguments. Moreover, the new type
+constructor must have the same arity and the same type constraints as the
+original type constructor.
+\end{description}
+
+The type variables appearing as type parameters can optionally be
+prefixed by "+" or "-" to indicate that the type constructor is
+covariant or contravariant with respect to this parameter. This
+variance information is used to decide subtyping relations when
+checking the validity of @":>"@ coercions
+(see section \ref{ss:expr-coercions}).
+
+For instance, "type +'a t" declares "t" as an abstract type that is
+covariant in its parameter; this means that if the type $\tau$ is a
+subtype of the type $\sigma$, then $\tau$" t" is a subtype of $\sigma$" t".
+Similarly, "type -'a t" declares that the abstract type "t" is
+contravariant in its parameter: if $\tau$ is a subtype of $\sigma$, then
+$\sigma$" t" is a subtype of $\tau$" t". If no "+" or "-" variance
+annotation is given, the type constructor is assumed non-variant in the
+corresponding parameter. For instance, the abstract type declaration
+"type 'a t" means that $\tau$" t" is neither a subtype nor a
+supertype of $\sigma$" t" if $\tau$ is subtype of $\sigma$.
+
+The variance indicated by the "+" and "-" annotations on parameters
+is enforced only for abstract and private types, or when there are
+type constraints.
+Otherwise, for abbreviations, variant and record types without type
+constraints, the variance properties of the type constructor
+are inferred from its definition, and the variance annotations are
+only checked for conformance with the definition.
+
+Injectivity annotations are only necessary for abstract types and
+private row types, since they can otherwise be deduced from the type
+declaration: all parameters are injective for record and variant type
+declarations (including extensible types); for type abbreviations a
+parameter is injective if it has an injective occurrence in its
+defining equation (be it private or not). For constrained type
+parameters in type abbreviations, they are injective if either they
+appear at an injective position in the body, or if all their type
+variables are injective; in particular, if a constrained type
+parameter contains a variable that doesn't appear in the body, it
+cannot be injective.
+
+\ikwd{constraint\@\texttt{constraint}}
+The construct @ 'constraint' "'" ident '=' typexpr @ allows the
+specification of
+type parameters. Any actual type argument corresponding to the type
+parameter @ident@ has to be an instance of @typexpr@ (more precisely,
+@ident@ and @typexpr@ are unified). Type variables of @typexpr@ can
+appear in the type equation and the type declaration.
+
+\subsection{ss:exndef}{Exception definitions}
+\ikwd{exception\@\texttt{exception}}
+
+\begin{syntax}
+exception-definition:
+ 'exception' constr-decl
+ | 'exception' constr-name '=' constr
+\end{syntax}
+
+Exception definitions add new constructors to the built-in variant
+type \verb"exn" of exception values. The constructors are declared as
+for a definition of a variant type.
+
+\begin{caml_example}{toplevel}
+exception E of int * string;;
+\end{caml_example}
+
+The form @'exception' constr-decl@
+generates a new exception, distinct from all other exceptions in the system.
+The form @'exception' constr-name '=' constr@
+gives an alternate name to an existing exception.
+
+\begin{caml_example}{toplevel}
+exception E of int * string
+
+exception F = E
+
+let eq =
+ E (1, "one") = F (1, "one");;
+\end{caml_example}
--- /dev/null
+\section{s:typexpr}{Type expressions}
+%HEVEA\cutname{types.html}
+\ikwd{as\@\texttt{as}}
+
+\begin{syntax}
+typexpr:
+ "'" ident
+ | "_"
+ | '(' typexpr ')'
+ | [['?']label-name':'] typexpr '->' typexpr
+ | typexpr {{ '*' typexpr }}
+ | typeconstr
+ | typexpr typeconstr
+ | '(' typexpr { ',' typexpr } ')' typeconstr
+ | typexpr 'as' "'" ident
+ | polymorphic-variant-type
+ | '<' ['..'] '>'
+ | '<' method-type { ';' method-type } [';' || ';' '..'] '>'
+ | '#' classtype-path
+ | typexpr '#' class-path
+ | '(' typexpr { ',' typexpr } ')' '#' class-path
+;
+poly-typexpr:
+ typexpr
+ | {{ "'" ident }} '.' typexpr
+;
+method-type:
+ method-name ':' poly-typexpr
+\end{syntax}
+See also the following language extensions:
+\hyperref[s:first-class-modules]{first-class modules},
+\hyperref[s:attributes]{attributes} and
+\hyperref[s:extension-nodes]{extension nodes}.
+
+The table below shows the relative precedences and associativity of
+operators and non-closed type constructions. The constructions with
+higher precedences come first.
+\ikwd{as\@\texttt{as}}
+\begin{tableau}{|l|l|}{Operator}{Associativity}
+\entree{Type constructor application}{--}
+\entree{"#"}{--}
+\entree{"*"}{--}
+\entree{"->"}{right}
+\entree{"as"}{--}
+\end{tableau}
+
+Type expressions denote types in definitions of data types as well as
+in type constraints over patterns and expressions.
+
+\subsubsection*{sss:typexpr-variables}{Type variables}
+
+The type expression @"'" ident@ stands for the type variable named
+@ident@. The type expression @"_"@ stands for either an anonymous type
+variable or anonymous type parameters. In data type definitions, type
+variables are names for the data type parameters. In type constraints,
+they represent unspecified types that can be instantiated by any type
+to satisfy the type constraint. In general the scope of a named type
+variable is the whole top-level phrase where it appears, and it can
+only be generalized when leaving this scope. Anonymous variables have
+no such restriction. In the following cases, the scope of named type
+variables is restricted to the type expression where they appear:
+1) for universal (explicitly polymorphic) type variables;
+2) for type variables that only appear in public method specifications
+(as those variables will be made universal, as described in
+section~\ref{sss:clty-meth});
+3) for variables used as aliases, when the type they are aliased to
+would be invalid in the scope of the enclosing definition ({\it i.e.}
+when it contains free universal type variables, or locally
+defined types.)
+
+\subsubsection*{sss:typexr:parenthesized}{Parenthesized types}
+
+The type expression @"(" typexpr ")"@ denotes the same type as
+@typexpr@.
+
+\subsubsection*{sss:typexr-fun}{Function types}
+
+The type expression @typexpr_1 '->' typexpr_2@ denotes the type of
+functions mapping arguments of type @typexpr_1@ to results of type
+@typexpr_2@.
+
+@label-name ':' typexpr_1 '->' typexpr_2@ denotes the same function type, but
+the argument is labeled @label@.
+
+@'?' label-name ':' typexpr_1 '->' typexpr_2@ denotes the type of functions
+mapping an optional labeled argument of type @typexpr_1@ to results of
+type @typexpr_2@. That is, the physical type of the function will be
+@typexpr_1 "option" '->' typexpr_2@.
+
+\subsubsection*{sss:typexpr-tuple}{Tuple types}
+
+The type expression @typexpr_1 '*' \ldots '*' typexpr_n@
+denotes the type of tuples whose elements belong to types @typexpr_1,
+\ldots typexpr_n@ respectively.
+
+\subsubsection*{sss:typexpr-constructed}{Constructed types}
+
+Type constructors with no parameter, as in @typeconstr@, are type
+expressions.
+
+The type expression @typexpr typeconstr@, where @typeconstr@ is a type
+constructor with one parameter, denotes the application of the unary type
+constructor @typeconstr@ to the type @typexpr@.
+
+The type expression @(typexpr_1,\ldots,typexpr_n) typeconstr@, where
+@typeconstr@ is a type constructor with $n$ parameters, denotes the
+application of the $n$-ary type constructor @typeconstr@ to the types
+@typexpr_1@ through @typexpr_n@.
+
+In the type expression @ "_" typeconstr @, the anonymous type expression
+@ "_" @ stands in for anonymous type parameters and is equivalent to
+@ ("_", \ldots,"_") @ with as many repetitions of "_" as the arity of
+@typeconstr@.
+
+\subsubsection*{sss:typexpr-aliased-recursive}{Aliased and recursive types}
+
+\ikwd{as\@\texttt{as}}
+
+The type expression @typexpr 'as' "'" ident@ denotes the same type as
+@typexpr@, and also binds the type variable @ident@ to type @typexpr@ both
+in @typexpr@ and in other types. In general the scope of an alias is
+the same as for a named type variable, and covers the whole enclosing
+definition. If the type variable
+@ident@ actually occurs in @typexpr@, a recursive type is created. Recursive
+types for which there exists a recursive path that does not contain
+an object or polymorphic variant type constructor are rejected, except
+when the "-rectypes" mode is selected.
+
+If @"'" ident@ denotes an explicit polymorphic variable, and @typexpr@
+denotes either an object or polymorphic variant type, the row variable
+of @typexpr@ is captured by @"'" ident@, and quantified upon.
+
+\subsubsection*{sss:typexpr-polyvar}{Polymorphic variant types}
+\ikwd{of\@\texttt{of}}
+
+\begin{syntax}
+polymorphic-variant-type:
+ '[' tag-spec-first { '|' tag-spec } ']'
+ | '[>' [ tag-spec ] { '|' tag-spec } ']'
+ | '[<' ['|'] tag-spec-full { '|' tag-spec-full }
+ [ '>' {{ '`'tag-name }} ] ']'
+;
+%\end{syntax} \begin{syntax}
+tag-spec-first:
+ '`'tag-name [ 'of' typexpr ]
+ | [ typexpr ] '|' tag-spec
+;
+tag-spec:
+ '`'tag-name [ 'of' typexpr ]
+ | typexpr
+;
+tag-spec-full:
+ '`'tag-name [ 'of' ['&'] typexpr { '&' typexpr } ]
+ | typexpr
+\end{syntax}
+
+Polymorphic variant types describe the values a polymorphic variant
+may take.
+
+The first case is an exact variant type: all possible tags are
+known, with their associated types, and they can all be present.
+Its structure is fully known.
+
+The second case is an open variant type, describing a polymorphic
+variant value: it gives the list of all tags the value could take,
+with their associated types. This type is still compatible with a
+variant type containing more tags. A special case is the unknown
+type, which does not define any tag, and is compatible with any
+variant type.
+
+The third case is a closed variant type. It gives information about
+all the possible tags and their associated types, and which tags are
+known to potentially appear in values. The exact variant type (first
+case) is
+just an abbreviation for a closed variant type where all possible tags
+are also potentially present.
+
+In all three cases, tags may be either specified directly in the
+@'`'tag-name ["of" typexpr]@ form, or indirectly through a type
+expression, which must expand to an
+exact variant type, whose tag specifications are inserted in its
+place.
+
+Full specifications of variant tags are only used for non-exact closed
+types. They can be understood as a conjunctive type for the argument:
+it is intended to have all the types enumerated in the
+specification.
+
+Such conjunctive constraints may be unsatisfiable. In such a case the
+corresponding tag may not be used in a value of this type. This
+does not mean that the whole type is not valid: one can still use
+other available tags.
+Conjunctive constraints are mainly intended as output from the type
+checker. When they are used in source programs, unsolvable constraints
+may cause early failures.
+
+\subsubsection*{sss:typexpr-obj}{Object types}
+
+An object type
+@'<' [method-type { ';' method-type }] '>'@
+is a record of method types.
+
+Each method may have an explicit polymorphic type: @{{ "'" ident }}
+'.' typexpr@. Explicit polymorphic variables have a local scope, and
+an explicit polymorphic type can only be unified to an
+equivalent one, where only the order and names of polymorphic
+variables may change.
+
+The type @'<' {method-type ';'} '..' '>'@ is the
+type of an object whose method names and types are described by
+@method-type_1, \ldots, method-type_n@, and possibly some other
+methods represented by the ellipsis. This ellipsis actually is
+a special kind of type variable (called {\em row variable} in the
+literature) that stands for any number of extra method types.
+
+\subsubsection*{sss:typexpr-sharp-types}{\#-types}
+
+The type @'#' classtype-path@ is a special kind of abbreviation. This
+abbreviation unifies with the type of any object belonging to a subclass
+of the class type @classtype-path@.
+%
+It is handled in a special way as it usually hides a type variable (an
+ellipsis, representing the methods that may be added in a subclass).
+In particular, it vanishes when the ellipsis gets instantiated.
+%
+Each type expression @'#' classtype-path@ defines a new type variable, so
+type @'#' classtype-path '->' '#' classtype-path@ is usually not the same as
+type @('#' classtype-path 'as' "'" ident) '->' "'" ident@.
+%
+
+Use of \#-types to abbreviate polymorphic variant types is deprecated.
+If @@t@@ is an exact variant type then @"#"@t@@ translates to @"[<" @t@"]"@,
+and @"#"@t@"[>" "`"tag_1 \dots"`"tag_k"]"@ translates to
+@"[<" @t@ ">" "`"tag_1 \dots"`"tag_k"]"@
+
+\subsubsection*{sss:typexpr-variant-record}{Variant and record types}
+
+There are no type expressions describing (defined) variant types nor
+record types, since those are always named, i.e. defined before use
+and referred to by name. Type definitions are described in
+section~\ref{ss:typedefs}.
--- /dev/null
+\section{s:values}{Values}
+%HEVEA\cutname{values.html}
+
+This section describes the kinds of values that are manipulated by
+OCaml programs.
+
+\subsection{ss:values:base}{Base values}
+
+\subsubsection*{sss:values:integer}{Integer numbers}
+
+Integer values are integer numbers from $-2^{30}$ to $2^{30}-1$, that
+is $-1073741824$ to $1073741823$. The implementation may support a
+wider range of integer values: on 64-bit platforms, the current
+implementation supports integers ranging from $-2^{62}$ to $2^{62}-1$.
+
+\subsubsection*{sss:values:float}{Floating-point numbers}
+
+Floating-point values are numbers in floating-point representation.
+The current implementation uses double-precision floating-point
+numbers conforming to the IEEE 754 standard, with 53 bits of mantissa
+and an exponent ranging from $-1022$ to $1023$.
+
+\subsubsection*{sss:values:char}{Characters}
+
+Character values are represented as 8-bit integers between 0 and 255.
+Character codes between 0 and 127 are interpreted following the ASCII
+standard. The current implementation interprets character codes
+between 128 and 255 following the ISO 8859-1 standard.
+
+\subsubsection*{sss:values:string}{Character strings}
+
+String values are finite sequences of characters. The current
+implementation supports strings containing up to $2^{24} - 5$
+characters (16777211 characters); on 64-bit platforms, the limit is
+$2^{57} - 9$.
+
+\subsection{ss:values:tuple}{Tuples}
+
+Tuples of values are written @'('@v@_1',' \ldots',' @v@_n')'@, standing for the
+$n$-tuple of values @@v@_1@ to @@v@_n@. The current implementation
+supports tuple of up to $2^{22} - 1$ elements (4194303 elements).
+
+\subsection{ss:values:records}{Records}
+
+Record values are labeled tuples of values. The record value written
+@'{' field_1 '=' @v@_1';' \ldots';' field_n '=' @v@_n '}'@ associates the value
+@@v@_i@ to the record field @field_i@, for $i = 1 \ldots n$. The current
+implementation supports records with up to $2^{22} - 1$ fields
+(4194303 fields).
+
+\subsection{ss:values:array}{Arrays}
+
+Arrays are finite, variable-sized sequences of values of the same
+type. The current implementation supports arrays containing up to
+$2^{22} - 1$ elements (4194303 elements) unless the elements are
+floating-point numbers (2097151 elements in this case); on 64-bit
+platforms, the limit is $2^{54} - 1$ for all arrays.
+
+\subsection{ss:values:variant}{Variant values}
+
+Variant values are either a constant constructor, or a non-constant
+constructor applied to a number of values. The former case is written
+@constr@; the latter case is written @constr '('@v@_1',' ... ',' @v@_n
+')'@, where the @@v@_i@ are said to be the arguments of the non-constant
+constructor @constr@. The parentheses may be omitted if there is only
+one argument.
+
+The following constants are treated like built-in constant
+constructors:
+\begin{tableau}{|l|l|}{Constant}{Constructor}
+\entree{"false"}{the boolean false}
+\entree{"true"}{the boolean true}
+\entree{"()"}{the ``unit'' value}
+\entree{"[]"}{the empty list}
+\end{tableau}
+
+The current implementation limits each variant type to have at most
+246 non-constant constructors and $2^{30}-1$ constant constructors.
+
+\subsection{ss:values:polyvars}{Polymorphic variants}
+
+Polymorphic variants are an alternate form of variant values, not
+belonging explicitly to a predefined variant type, and following
+specific typing rules. They can be either constant, written
+@"`"tag-name@, or non-constant, written @"`"tag-name'('@v@')'@.
+
+\subsection{ss:values:fun}{Functions}
+
+Functional values are mappings from values to values.
+
+\subsection{ss:values:obj}{Objects}
+
+Objects are composed of a hidden internal state which is a
+record of instance variables, and a set of methods for accessing and
+modifying these variables. The structure of an object is described by
+the toplevel class that created it.
--- /dev/null
+/* fira-sans-regular - latin */
+@font-face {
+ font-family: 'Fira Sans';
+ font-style: normal;
+ font-weight: 400;
+ src: url('../fonts/fira-sans-v8-latin-regular.eot'); /* IE9 Compat Modes */
+ src: local('Fira Sans Regular'), local('FiraSans-Regular'),
+ url('../fonts/fira-sans-v8-latin-regular.eot?#iefix') format('embedded-opentype'), /* IE6-IE8 */
+ url('../fonts/fira-sans-v8-latin-regular.woff2') format('woff2'), /* Super Modern Browsers */
+ url('../fonts/fira-sans-v8-latin-regular.woff') format('woff'), /* Modern Browsers */
+ url('../fonts/fira-sans-v8-latin-regular.ttf') format('truetype'), /* Safari, Android, iOS */
+ url('../fonts/fira-sans-v8-latin-regular.svg#FiraSans') format('svg'); /* Legacy iOS */
+}
+
+
+a:visited {color : #416DFF; text-decoration : none; }
+a:link {color : #416DFF; text-decoration : none; }
+a:hover {color : Black; text-decoration : underline; }
+a:active {color : Black; text-decoration : underline; }
+.keyword { font-weight : bold ; color : Red }
+.keywordsign { color : #C04600 }
+.comment { color : Green }
+.constructor { color : Blue }
+.type { color : #5C6585 }
+.string { color : Maroon }
+.warning { color : Red ; font-weight : bold }
+.info { margin-left : 3em; margin-right : 3em }
+.code { color : #465F91 ; }
+h1 { font-size : 2rem ; text-align: center; }
+
+h2, h3, h4, h5, h6, div.h7, div.h8, div.h9 {
+ font-size: 1.75rem;
+ border: 1px solid #000;
+ margin-top: 20px;
+ margin-bottom: 2px;
+ text-align: center;
+ padding: 8px;
+ font-family: "Fira Sans", sans-serif;
+ font-weight: normal;
+}
+h1 {
+ font-family: "Fira Sans", sans-serif;
+ padding: 10px;
+}
+
+h2 { background-color: #90BDFF; }
+h3 { background-color: #90DDFF; }
+h4 { background-color: #90EDFF; }
+h5 { background-color: #90FDFF; }
+h6 { background-color: #90BDFF; }
+div.h7 { background-color: #90DDFF; }
+div.h8 { background-color: #F0FFFF; }
+div.h9 { background-color: #FFFFFF; }
+
+.typetable { border-style : hidden }
+.indextable { border-style : hidden }
+.paramstable { border-style : hidden ; padding: 5pt 5pt}
+body {
+ background-color : #f7f7f7;
+ font-size: 1rem;
+ max-width: 800px;
+ width: 85%;
+ margin: auto;
+ padding-bottom: 30px;
+}
+td {
+ font-size: 1rem;
+}
+.navbar { /* previous - up - next */
+ position: absolute;
+ left: 10px;
+ top: 10px;
+}
+tr { background-color : #f7f7f7 }
+td.typefieldcomment { background-color : #f7f7f7 }
+pre { margin-bottom: 4px; white-space: pre-wrap; }
+div.sig_block {margin-left: 2em}
+ul.info-attributes { list-style: none; margin: 0; padding: 0; }
+div.info > p:first-child{ margin-top:0; }
+div.info-desc > p:first-child { margin-top:0; margin-bottom:0; }
--- /dev/null
+*.aux
+*.dvi
+*.idx
+*.ilg
+*.ind
+*.log
+*.toc
+*.ipr
+*.txt
+*.pdf
+*.ps
+manual.out
+manual.out
--- /dev/null
+manual.txt
+manual.hmanual.kwd
+*.haux
+*.hind
+*.htoc
--- /dev/null
+*.tex
+*.htex
--- /dev/null
+ROOTDIR = ../../..
+include $(ROOTDIR)/Makefile.common
+
+LD_PATH = "$(ROOTDIR)/otherlibs/str:$(ROOTDIR)/otherlibs/unix"
+
+TOOLS = ../../tools
+CAMLLATEX = $(SET_LD_PATH) \
+ $(OCAMLRUN) $(ROOTDIR)/tools/caml-tex \
+ -repo-root $(ROOTDIR) -n 80 -v false
+TEXQUOTE = $(OCAMLRUN) $(TOOLS)/texquote2
+TRANSF = $(SET_LD_PATH) $(OCAMLRUN) $(TOOLS)/transf
+
+
+FILES = coreexamples.tex lablexamples.tex polyvariant.tex objectexamples.tex \
+ gadtexamples.tex moduleexamples.tex advexamples.tex polymorphism.tex
+
+
+etex-files: $(FILES)
+all: $(FILES)
+
+
+%.gen.tex: %.etex
+ $(CAMLLATEX) $< -o $@
+
+%.tex: %.gen.tex
+ $(TEXQUOTE) < $< > $*.texquote_error.tex
+ mv $*.texquote_error.tex $@
+
+
+.PHONY: clean
+clean:
+ rm -f *.tex
--- /dev/null
+\chapter{Advanced examples with classes and modules}
+%HEVEA\cutname{advexamples.html}
+\label{c:advexamples}
+
+{\it (Chapter written by Didier Rémy)}
+
+\bigskip
+
+\noindent
+
+In this chapter, we show some larger examples using objects, classes
+and modules. We review many of the object features simultaneously on
+the example of a bank account. We show how modules taken from the
+standard library can be expressed as classes. Lastly, we describe a
+programming pattern known as {\em virtual types} through the example
+of window managers.
+
+\section{s:extended-bank-accounts}{Extended example: bank accounts}
+
+In this section, we illustrate most aspects of Object and inheritance
+by refining, debugging, and specializing the following
+initial naive definition of a simple bank account. (We reuse the
+module "Euro" defined at the end of chapter~\ref{c:objectexamples}.)
+\begin{caml_eval}
+module type MONEY =
+ sig
+ type t
+ class c : float ->
+ object ('a)
+ val repr : t
+ method value : t
+ method print : unit
+ method times : float -> 'a
+ method leq : 'a -> bool
+ method plus : 'a -> 'a
+ end
+ end;;
+module Euro : MONEY =
+ struct
+ type t = float
+ class c x =
+ object (self : 'a)
+ val repr = x
+ method value = repr
+ method print = print_float repr
+ method times k = {< repr = k *. x >}
+ method leq (p : 'a) = repr <= p#value
+ method plus (p : 'a) = {< repr = x +. p#value >}
+ end
+ end;;
+\end{caml_eval}
+\begin{caml_example}{toplevel}
+let euro = new Euro.c;;
+let zero = euro 0.;;
+let neg x = x#times (-1.);;
+class account =
+ object
+ val mutable balance = zero
+ method balance = balance
+ method deposit x = balance <- balance # plus x
+ method withdraw x =
+ if x#leq balance then (balance <- balance # plus (neg x); x) else zero
+ end;;
+let c = new account in c # deposit (euro 100.); c # withdraw (euro 50.);;
+\end{caml_example}
+We now refine this definition with a method to compute interest.
+\begin{caml_example}{toplevel}
+class account_with_interests =
+ object (self)
+ inherit account
+ method private interest = self # deposit (self # balance # times 0.03)
+ end;;
+\end{caml_example}
+We make the method "interest" private, since clearly it should not be
+called freely from the outside. Here, it is only made accessible to subclasses
+that will manage monthly or yearly updates of the account.
+
+We should soon fix a bug in the current definition: the deposit method can
+be used for withdrawing money by depositing negative amounts. We can
+fix this directly:
+\begin{caml_example}{toplevel}
+class safe_account =
+ object
+ inherit account
+ method deposit x = if zero#leq x then balance <- balance#plus x
+ end;;
+\end{caml_example}
+However, the bug might be fixed more safely by the following definition:
+\begin{caml_example}{toplevel}
+class safe_account =
+ object
+ inherit account as unsafe
+ method deposit x =
+ if zero#leq x then unsafe # deposit x
+ else raise (Invalid_argument "deposit")
+ end;;
+\end{caml_example}
+In particular, this does not require the knowledge of the implementation of
+the method "deposit".
+
+To keep track of operations, we extend the class with a mutable field
+"history" and a private method "trace" to add an operation in the
+log. Then each method to be traced is redefined.
+\begin{caml_example}{toplevel}
+type 'a operation = Deposit of 'a | Retrieval of 'a;;
+class account_with_history =
+ object (self)
+ inherit safe_account as super
+ val mutable history = []
+ method private trace x = history <- x :: history
+ method deposit x = self#trace (Deposit x); super#deposit x
+ method withdraw x = self#trace (Retrieval x); super#withdraw x
+ method history = List.rev history
+ end;;
+\end{caml_example}
+%% \label{ss:bank:initializer}
+One may wish to open an account and simultaneously deposit some initial
+amount. Although the initial implementation did not address this
+requirement, it can be achieved by using an initializer.
+\begin{caml_example}{toplevel}
+class account_with_deposit x =
+ object
+ inherit account_with_history
+ initializer balance <- x
+ end;;
+\end{caml_example}
+A better alternative is:
+\begin{caml_example}{toplevel}
+class account_with_deposit x =
+ object (self)
+ inherit account_with_history
+ initializer self#deposit x
+ end;;
+\end{caml_example}
+Indeed, the latter is safer since the call to "deposit" will automatically
+benefit from safety checks and from the trace.
+Let's test it:
+\begin{caml_example}{toplevel}
+let ccp = new account_with_deposit (euro 100.) in
+let _balance = ccp#withdraw (euro 50.) in
+ccp#history;;
+\end{caml_example}
+Closing an account can be done with the following polymorphic function:
+\begin{caml_example}{toplevel}
+let close c = c#withdraw c#balance;;
+\end{caml_example}
+Of course, this applies to all sorts of accounts.
+
+Finally, we gather several versions of the account into a module "Account"
+abstracted over some currency.
+\begin{caml_example*}{toplevel}
+let today () = (01,01,2000) (* an approximation *)
+module Account (M:MONEY) =
+ struct
+ type m = M.c
+ let m = new M.c
+ let zero = m 0.
+
+ class bank =
+ object (self)
+ val mutable balance = zero
+ method balance = balance
+ val mutable history = []
+ method private trace x = history <- x::history
+ method deposit x =
+ self#trace (Deposit x);
+ if zero#leq x then balance <- balance # plus x
+ else raise (Invalid_argument "deposit")
+ method withdraw x =
+ if x#leq balance then
+ (balance <- balance # plus (neg x); self#trace (Retrieval x); x)
+ else zero
+ method history = List.rev history
+ end
+
+ class type client_view =
+ object
+ method deposit : m -> unit
+ method history : m operation list
+ method withdraw : m -> m
+ method balance : m
+ end
+
+ class virtual check_client x =
+ let y = if (m 100.)#leq x then x
+ else raise (Failure "Insufficient initial deposit") in
+ object (self)
+ initializer self#deposit y
+ method virtual deposit: m -> unit
+ end
+
+ module Client (B : sig class bank : client_view end) =
+ struct
+ class account x : client_view =
+ object
+ inherit B.bank
+ inherit check_client x
+ end
+
+ let discount x =
+ let c = new account x in
+ if today() < (1998,10,30) then c # deposit (m 100.); c
+ end
+ end;;
+\end{caml_example*}
+This shows the use of modules to group several class definitions that can in
+fact be thought of as a single unit. This unit would be provided by a bank
+for both internal and external uses.
+This is implemented as a functor that abstracts over the currency so that
+the same code can be used to provide accounts in different currencies.
+
+The class "bank" is the {\em real} implementation of the bank account (it
+could have been inlined). This is the one that will be used for further
+extensions, refinements, etc. Conversely, the client will only be given the client view.
+\begin{caml_example*}{toplevel}
+module Euro_account = Account(Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_example*}
+Hence, the clients do not have direct access to the "balance", nor the
+"history" of their own accounts. Their only way to change their balance is
+to deposit or withdraw money. It is important to give the clients
+a class and not just the ability to create accounts (such as the
+promotional "discount" account), so that they can
+personalize their account.
+For instance, a client may refine the "deposit" and "withdraw" methods
+so as to do his own financial bookkeeping, automatically. On the
+other hand, the function "discount" is given as such, with no
+possibility for further personalization.
+
+It is important to provide the client's view as a functor
+"Client" so that client accounts can still be built after a possible
+specialization of the "bank".
+The functor "Client" may remain unchanged and be passed
+the new definition to initialize a client's view of the extended account.
+\begin{caml_example*}{toplevel}
+module Investment_account (M : MONEY) =
+ struct
+ type m = M.c
+ module A = Account(M)
+
+ class bank =
+ object
+ inherit A.bank as super
+ method deposit x =
+ if (new M.c 1000.)#leq x then
+ print_string "Would you like to invest?";
+ super#deposit x
+ end
+
+ module Client = A.Client
+ end;;
+\end{caml_example*}
+\begin{caml_eval}
+module Euro_account = Investment_account (Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_eval}
+The functor "Client" may also be redefined when some new features of the
+account can be given to the client.
+\begin{caml_example*}{toplevel}
+module Internet_account (M : MONEY) =
+ struct
+ type m = M.c
+ module A = Account(M)
+
+ class bank =
+ object
+ inherit A.bank
+ method mail s = print_string s
+ end
+
+ class type client_view =
+ object
+ method deposit : m -> unit
+ method history : m operation list
+ method withdraw : m -> m
+ method balance : m
+ method mail : string -> unit
+ end
+
+ module Client (B : sig class bank : client_view end) =
+ struct
+ class account x : client_view =
+ object
+ inherit B.bank
+ inherit A.check_client x
+ end
+ end
+ end;;
+\end{caml_example*}
+\begin{caml_eval}
+module Euro_account = Internet_account (Euro);;
+module Client = Euro_account.Client (Euro_account);;
+new Client.account (new Euro.c 100.);;
+\end{caml_eval}
+
+
+\section{s:modules-as-classes}{Simple modules as classes}
+
+One may wonder whether it is possible to treat primitive types such as
+integers and strings as objects. Although this is usually uninteresting
+for integers or strings, there may be some situations where
+this is desirable. The class "money" above is such an example.
+We show here how to do it for strings.
+
+\subsection{ss:string-as-class}{Strings}
+
+A naive definition of strings as objects could be:
+\begin{caml_example}{toplevel}
+class ostring s =
+ object
+ method get n = String.get s n
+ method print = print_string s
+ method escaped = new ostring (String.escaped s)
+ end;;
+\end{caml_example}
+However, the method "escaped" returns an object of the class "ostring",
+and not an object of the current class. Hence, if the class is further
+extended, the method "escaped" will only return an object of the parent
+class.
+\begin{caml_example}{toplevel}
+class sub_string s =
+ object
+ inherit ostring s
+ method sub start len = new sub_string (String.sub s start len)
+ end;;
+\end{caml_example}
+As seen in section~\ref{s:binary-methods}, the solution is to use
+functional update instead. We need to create an instance variable
+containing the representation "s" of the string.
+\begin{caml_example}{toplevel}
+class better_string s =
+ object
+ val repr = s
+ method get n = String.get repr n
+ method print = print_string repr
+ method escaped = {< repr = String.escaped repr >}
+ method sub start len = {< repr = String.sub s start len >}
+ end;;
+\end{caml_example}
+As shown in the inferred type, the methods "escaped" and "sub" now return
+objects of the same type as the one of the class.
+
+Another difficulty is the implementation of the method "concat".
+In order to concatenate a string with another string of the same class,
+one must be able to access the instance variable externally. Thus, a method
+"repr" returning s must be defined. Here is the correct definition of
+strings:
+\begin{caml_example}{toplevel}
+class ostring s =
+ object (self : 'mytype)
+ val repr = s
+ method repr = repr
+ method get n = String.get repr n
+ method print = print_string repr
+ method escaped = {< repr = String.escaped repr >}
+ method sub start len = {< repr = String.sub s start len >}
+ method concat (t : 'mytype) = {< repr = repr ^ t#repr >}
+ end;;
+\end{caml_example}
+Another constructor of the class string can be defined to return a new
+string of a given length:
+\begin{caml_example}{toplevel}
+class cstring n = ostring (String.make n ' ');;
+\end{caml_example}
+Here, exposing the representation of strings is probably harmless. We do
+could also hide the representation of strings as we hid the currency in the
+class "money" of section~\ref{s:friends}.
+
+\subsubsection{sss:stack-as-class}{Stacks}
+
+There is sometimes an alternative between using modules or classes for
+parametric data types.
+Indeed, there are situations when the two approaches are quite similar.
+For instance, a stack can be straightforwardly implemented as a class:
+\begin{caml_example}{toplevel}
+exception Empty;;
+class ['a] stack =
+ object
+ val mutable l = ([] : 'a list)
+ method push x = l <- x::l
+ method pop = match l with [] -> raise Empty | a::l' -> l <- l'; a
+ method clear = l <- []
+ method length = List.length l
+ end;;
+\end{caml_example}
+However, writing a method for iterating over a stack is more
+problematic. A method "fold" would have type
+"('b -> 'a -> 'b) -> 'b -> 'b". Here "'a" is the parameter of the stack.
+The parameter "'b" is not related to the class "'a stack" but to the
+argument that will be passed to the method "fold".
+%The intuition is that method "fold" should be polymorphic, i.e. of type
+%"All ('a) ('b -> 'a -> 'b) -> 'b -> 'b".
+A naive approach is to make "'b" an extra parameter of class "stack":
+\begin{caml_example}{toplevel}
+class ['a, 'b] stack2 =
+ object
+ inherit ['a] stack
+ method fold f (x : 'b) = List.fold_left f x l
+ end;;
+\end{caml_example}
+However, the method "fold" of a given object can only be
+applied to functions that all have the same type:
+\begin{caml_example}{toplevel}
+let s = new stack2;;
+s#fold ( + ) 0;;
+s;;
+\end{caml_example}
+A better solution is to use polymorphic methods, which were
+introduced in OCaml version 3.05. Polymorphic methods makes
+it possible to treat the type variable "'b" in the type of "fold" as
+universally quantified, giving "fold" the polymorphic type
+"Forall 'b. ('b -> 'a -> 'b) -> 'b -> 'b".
+An explicit type declaration on the method "fold" is required, since
+the type checker cannot infer the polymorphic type by itself.
+\begin{caml_example}{toplevel}
+class ['a] stack3 =
+ object
+ inherit ['a] stack
+ method fold : 'b. ('b -> 'a -> 'b) -> 'b -> 'b
+ = fun f x -> List.fold_left f x l
+ end;;
+\end{caml_example}
+
+% However, the nice correspondence between the implementations of stacks as
+% modules or classes is a very particular case.
+
+% XXX Maps
+
+\subsection{ss:hashtbl-as-class}{Hashtbl}
+
+A simplified version of object-oriented hash tables should have the
+following class type.
+\begin{caml_example}{toplevel}
+class type ['a, 'b] hash_table =
+ object
+ method find : 'a -> 'b
+ method add : 'a -> 'b -> unit
+ end;;
+\end{caml_example}
+A simple implementation, which is quite reasonable for small hash tables is
+to use an association list:
+\begin{caml_example}{toplevel}
+class ['a, 'b] small_hashtbl : ['a, 'b] hash_table =
+ object
+ val mutable table = []
+ method find key = List.assoc key table
+ method add key value = table <- (key, value) :: table
+ end;;
+\end{caml_example}
+A better implementation, and one that scales up better, is to use a
+true hash table\ldots\ whose elements are small hash tables!
+\begin{caml_example}{toplevel}
+class ['a, 'b] hashtbl size : ['a, 'b] hash_table =
+ object (self)
+ val table = Array.init size (fun i -> new small_hashtbl)
+ method private hash key =
+ (Hashtbl.hash key) mod (Array.length table)
+ method find key = table.(self#hash key) # find key
+ method add key = table.(self#hash key) # add key
+ end;;
+\end{caml_example}
+
+% problem
+
+% solution
+
+\subsection{ss:set-as-class}{Sets}
+
+Implementing sets leads to another difficulty. Indeed, the method
+"union" needs to be able to access the internal representation of
+another object of the same class.
+
+This is another instance of friend functions as seen in
+section~\ref{s:friends}. Indeed, this is the same mechanism used in the module
+"Set" in the absence of objects.
+
+In the object-oriented version of sets, we only need to add an additional
+method "tag" to return the representation of a set. Since sets are
+parametric in the type of elements, the method "tag" has a parametric type
+"'a tag", concrete within
+the module definition but abstract in its signature.
+From outside, it will then be guaranteed that two objects with a method "tag"
+of the same type will share the same representation.
+\begin{caml_example*}{toplevel}
+module type SET =
+ sig
+ type 'a tag
+ class ['a] c :
+ object ('b)
+ method is_empty : bool
+ method mem : 'a -> bool
+ method add : 'a -> 'b
+ method union : 'b -> 'b
+ method iter : ('a -> unit) -> unit
+ method tag : 'a tag
+ end
+ end;;
+module Set : SET =
+ struct
+ let rec merge l1 l2 =
+ match l1 with
+ [] -> l2
+ | h1 :: t1 ->
+ match l2 with
+ [] -> l1
+ | h2 :: t2 ->
+ if h1 < h2 then h1 :: merge t1 l2
+ else if h1 > h2 then h2 :: merge l1 t2
+ else merge t1 l2
+ type 'a tag = 'a list
+ class ['a] c =
+ object (_ : 'b)
+ val repr = ([] : 'a list)
+ method is_empty = (repr = [])
+ method mem x = List.exists (( = ) x) repr
+ method add x = {< repr = merge [x] repr >}
+ method union (s : 'b) = {< repr = merge repr s#tag >}
+ method iter (f : 'a -> unit) = List.iter f repr
+ method tag = repr
+ end
+ end;;
+\end{caml_example*}
+
+\section{s:subject-observer}{The subject/observer pattern}
+
+The following example, known as the subject/observer pattern, is often
+presented in the literature as a difficult inheritance problem with
+inter-connected classes.
+The general pattern amounts to the definition a pair of two
+classes that recursively interact with one another.
+
+The class "observer" has a distinguished method "notify" that requires
+two arguments, a subject and an event to execute an action.
+\begin{caml_example}{toplevel}
+class virtual ['subject, 'event] observer =
+ object
+ method virtual notify : 'subject -> 'event -> unit
+ end;;
+\end{caml_example}
+The class "subject" remembers a list of observers in an instance variable,
+and has a distinguished method "notify_observers" to broadcast the message
+"notify" to all observers with a particular event "e".
+\begin{caml_example}{toplevel}
+class ['observer, 'event] subject =
+ object (self)
+ val mutable observers = ([]:'observer list)
+ method add_observer obs = observers <- (obs :: observers)
+ method notify_observers (e : 'event) =
+ List.iter (fun x -> x#notify self e) observers
+ end;;
+\end{caml_example}
+The difficulty usually lies in defining instances of the pattern above
+by inheritance. This can be done in a natural and obvious manner in
+OCaml, as shown on the following example manipulating windows.
+\begin{caml_example}{toplevel}
+type event = Raise | Resize | Move;;
+let string_of_event = function
+ Raise -> "Raise" | Resize -> "Resize" | Move -> "Move";;
+let count = ref 0;;
+class ['observer] window_subject =
+ let id = count := succ !count; !count in
+ object (self)
+ inherit ['observer, event] subject
+ val mutable position = 0
+ method identity = id
+ method move x = position <- position + x; self#notify_observers Move
+ method draw = Printf.printf "{Position = %d}\n" position;
+ end;;
+class ['subject] window_observer =
+ object
+ inherit ['subject, event] observer
+ method notify s e = s#draw
+ end;;
+\end{caml_example}
+As can be expected, the type of "window" is recursive.
+\begin{caml_example}{toplevel}
+let window = new window_subject;;
+\end{caml_example}
+However, the two classes of "window_subject" and "window_observer" are not
+mutually recursive.
+\begin{caml_example}{toplevel}
+let window_observer = new window_observer;;
+window#add_observer window_observer;;
+window#move 1;;
+\end{caml_example}
+
+Classes "window_observer" and "window_subject" can still be extended by
+inheritance. For instance, one may enrich the "subject" with new
+behaviors and refine the behavior of the observer.
+\begin{caml_example}{toplevel}
+class ['observer] richer_window_subject =
+ object (self)
+ inherit ['observer] window_subject
+ val mutable size = 1
+ method resize x = size <- size + x; self#notify_observers Resize
+ val mutable top = false
+ method raise = top <- true; self#notify_observers Raise
+ method draw = Printf.printf "{Position = %d; Size = %d}\n" position size;
+ end;;
+class ['subject] richer_window_observer =
+ object
+ inherit ['subject] window_observer as super
+ method notify s e = if e <> Raise then s#raise; super#notify s e
+ end;;
+\end{caml_example}
+We can also create a different kind of observer:
+\begin{caml_example}{toplevel}
+class ['subject] trace_observer =
+ object
+ inherit ['subject, event] observer
+ method notify s e =
+ Printf.printf
+ "<Window %d <== %s>\n" s#identity (string_of_event e)
+ end;;
+\end{caml_example}
+and attach several observers to the same object:
+\begin{caml_example}{toplevel}
+let window = new richer_window_subject;;
+window#add_observer (new richer_window_observer);;
+window#add_observer (new trace_observer);;
+window#move 1; window#resize 2;;
+\end{caml_example}
+
+%\subsection{ss:Classes used as modules with inheritance}
+%
+% to be filled for next release...
+%
+% an example of stateless objects used to provide inheritance in modules
+%
+
+
+% LocalWords: objectexamples bsection init caml val int Oo succ incr ref
+% LocalWords: typecheck leq bool cp eval sig struct ABSPOINT Abspoint iter neg
+% LocalWords: accu mem rec repr Euro euro ccp inlined ostring len concat OCaml
--- /dev/null
+\chapter{The core language} \label{c:core-xamples}
+%HEVEA\cutname{coreexamples.html}
+
+This part of the manual is a tutorial introduction to the OCaml language. A
+good familiarity with programming in a conventional languages (say, C or Java)
+is assumed, but no prior exposure to functional languages is required. The
+present chapter introduces the core language. Chapter~\ref{c:moduleexamples}
+deals with the module system, chapter~\ref{c:objectexamples} with the
+object-oriented features, chapter~\ref{c:labl-examples} with labeled
+arguments, chapter~\ref{c:poly-variant} with polymorphic variants,
+chapter~\ref{c:polymorphism} with the limitations of polymorphism, and
+chapter~\ref{c:advexamples} gives some advanced examples.
+
+\section{s:basics}{Basics}
+
+For this overview of OCaml, we use the interactive system, which is started by
+running "ocaml" from the Unix shell or Windows command prompt. This tutorial is
+presented as the transcript of a session with the interactive system: lines
+starting with "#" represent user input; the system responses are printed below,
+without a leading "#".
+
+Under the interactive system, the user types OCaml phrases terminated
+by ";;" in response to the "#" prompt, and the system compiles them
+on the fly, executes them, and prints the outcome of evaluation.
+Phrases are either simple expressions, or "let" definitions of
+identifiers (either values or functions).
+\begin{caml_example}{toplevel}
+1 + 2 * 3;;
+let pi = 4.0 *. atan 1.0;;
+let square x = x *. x;;
+square (sin pi) +. square (cos pi);;
+\end{caml_example}
+The OCaml system computes both the value and the type for
+each phrase. Even function parameters need no explicit type declaration:
+the system infers their types from their usage in the
+function. Notice also that integers and floating-point numbers are
+distinct types, with distinct operators: "+" and "*" operate on
+integers, but "+." and "*." operate on floats.
+\begin{caml_example}{toplevel}[error]
+1.0 * 2;;
+\end{caml_example}
+
+Recursive functions are defined with the "let rec" binding:
+\begin{caml_example}{toplevel}
+let rec fib n =
+ if n < 2 then n else fib (n - 1) + fib (n - 2);;
+fib 10;;
+\end{caml_example}
+
+\section{s:datatypes}{Data types}
+
+In addition to integers and floating-point numbers, OCaml offers the
+usual basic data types:
+\begin{itemize}%
+\item booleans
+\begin{caml_example}{toplevel}
+(1 < 2) = false;;
+let one = if true then 1 else 2;;
+\end{caml_example}
+\item characters
+\begin{caml_example}{toplevel}
+ 'a';;
+ int_of_char '\n';;
+\end{caml_example}
+\item immutable character strings
+\begin{caml_example}{toplevel}
+"Hello" ^ " " ^ "world";;
+{|This is a quoted string, here, neither \ nor " are special characters|};;
+{|"\\"|}="\"\\\\\"";;
+ {delimiter|the end of this|}quoted string is here|delimiter}
+= "the end of this|}quoted string is here";;
+\end{caml_example}
+\end{itemize}
+
+Predefined data structures include tuples, arrays, and lists. There are also
+general mechanisms for defining your own data structures, such as records and
+variants, which will be covered in more detail later; for now, we concentrate
+on lists. Lists are either given in extension as a bracketed list of
+semicolon-separated elements, or built from the empty list "[]"
+(pronounce ``nil'') by adding elements in front using the "::"
+(``cons'') operator.
+\begin{caml_example}{toplevel}
+let l = ["is"; "a"; "tale"; "told"; "etc."];;
+"Life" :: l;;
+\end{caml_example}
+As with all other OCaml data structures, lists do not need to be
+explicitly allocated and deallocated from memory: all memory
+management is entirely automatic in OCaml. Similarly, there is no
+explicit handling of pointers: the OCaml compiler silently introduces
+pointers where necessary.
+
+As with most OCaml data structures, inspecting and destructuring lists
+is performed by pattern-matching. List patterns have exactly the same
+form as list expressions, with identifiers representing unspecified
+parts of the list. As an example, here is insertion sort on a list:
+\begin{caml_example}{toplevel}
+let rec sort lst =
+ match lst with
+ [] -> []
+ | head :: tail -> insert head (sort tail)
+and insert elt lst =
+ match lst with
+ [] -> [elt]
+ | head :: tail -> if elt <= head then elt :: lst else head :: insert elt tail
+;;
+sort l;;
+\end{caml_example}
+
+The type inferred for "sort", "'a list -> 'a list", means that "sort"
+can actually apply to lists of any type, and returns a list of the
+same type. The type "'a" is a {\em type variable}, and stands for any
+given type. The reason why "sort" can apply to lists of any type is
+that the comparisons ("=", "<=", etc.) are {\em polymorphic} in OCaml:
+they operate between any two values of the same type. This makes
+"sort" itself polymorphic over all list types.
+\begin{caml_example}{toplevel}
+sort [6; 2; 5; 3];;
+sort [3.14; 2.718];;
+\end{caml_example}
+
+The "sort" function above does not modify its input list: it builds
+and returns a new list containing the same elements as the input list,
+in ascending order. There is actually no way in OCaml to modify
+a list in-place once it is built: we say that lists are {\em immutable}
+data structures. Most OCaml data structures are immutable, but a few
+(most notably arrays) are {\em mutable}, meaning that they can be
+modified in-place at any time.
+
+The OCaml notation for the type of a function with multiple arguments is \\
+"arg1_type -> arg2_type -> ... -> return_type". For example,
+the type inferred for "insert", "'a -> 'a list -> 'a list", means that "insert"
+takes two arguments, an element of any type "'a" and a list with elements of
+the same type "'a" and returns a list of the same type.
+\section{s:functions-as-values}{Functions as values}
+
+OCaml is a functional language: functions in the full mathematical
+sense are supported and can be passed around freely just as any other
+piece of data. For instance, here is a "deriv" function that takes any
+float function as argument and returns an approximation of its
+derivative function:
+\begin{caml_example}{toplevel}
+let deriv f dx = function x -> (f (x +. dx) -. f x) /. dx;;
+let sin' = deriv sin 1e-6;;
+sin' pi;;
+\end{caml_example}
+Even function composition is definable:
+\begin{caml_example}{toplevel}
+let compose f g = function x -> f (g x);;
+let cos2 = compose square cos;;
+\end{caml_example}
+
+Functions that take other functions as arguments are called
+``functionals'', or ``higher-order functions''. Functionals are
+especially useful to provide iterators or similar generic operations
+over a data structure. For instance, the standard OCaml library
+provides a "List.map" functional that applies a given function to each
+element of a list, and returns the list of the results:
+\begin{caml_example}{toplevel}
+List.map (function n -> n * 2 + 1) [0;1;2;3;4];;
+\end{caml_example}
+This functional, along with a number of other list and array
+functionals, is predefined because it is often useful, but there is
+nothing magic with it: it can easily be defined as follows.
+\begin{caml_example}{toplevel}
+let rec map f l =
+ match l with
+ [] -> []
+ | hd :: tl -> f hd :: map f tl;;
+\end{caml_example}
+
+\section{s:tut-recvariants}{Records and variants}
+
+User-defined data structures include records and variants. Both are
+defined with the "type" declaration. Here, we declare a record type to
+represent rational numbers.
+\begin{caml_example}{toplevel}
+type ratio = {num: int; denom: int};;
+let add_ratio r1 r2 =
+ {num = r1.num * r2.denom + r2.num * r1.denom;
+ denom = r1.denom * r2.denom};;
+add_ratio {num=1; denom=3} {num=2; denom=5};;
+\end{caml_example}
+Record fields can also be accessed through pattern-matching:
+\begin{caml_example}{toplevel}
+let integer_part r =
+ match r with
+ {num=num; denom=denom} -> num / denom;;
+\end{caml_example}
+Since there is only one case in this pattern matching, it
+is safe to expand directly the argument "r" in a record pattern:
+\begin{caml_example}{toplevel}
+let integer_part {num=num; denom=denom} = num / denom;;
+\end{caml_example}
+Unneeded fields can be omitted:
+\begin{caml_example}{toplevel}
+let get_denom {denom=denom} = denom;;
+\end{caml_example}
+Optionally, missing fields can be made explicit by ending the list of
+fields with a trailing wildcard "_"::
+\begin{caml_example}{toplevel}
+let get_num {num=num; _ } = num;;
+\end{caml_example}
+When both sides of the "=" sign are the same, it is possible to avoid
+repeating the field name by eliding the "=field" part:
+\begin{caml_example}{toplevel}
+let integer_part {num; denom} = num / denom;;
+\end{caml_example}
+This short notation for fields also works when constructing records:
+\begin{caml_example}{toplevel}
+let ratio num denom = {num; denom};;
+\end{caml_example}
+At last, it is possible to update few fields of a record at once:
+\begin{caml_example}{toplevel}
+let integer_product integer ratio = { ratio with num = integer * ratio.num };;
+\end{caml_example}
+With this functional update notation, the record on the left-hand side
+of "with" is copied except for the fields on the right-hand side which
+are updated.
+
+The declaration of a variant type lists all possible forms for values
+of that type. Each case is identified by a name, called a constructor,
+which serves both for constructing values of the variant type and
+inspecting them by pattern-matching. Constructor names are capitalized
+to distinguish them from variable names (which must start with a
+lowercase letter). For instance, here is a variant
+type for doing mixed arithmetic (integers and floats):
+\begin{caml_example}{toplevel}
+type number = Int of int | Float of float | Error;;
+\end{caml_example}
+This declaration expresses that a value of type "number" is either an
+integer, a floating-point number, or the constant "Error" representing
+the result of an invalid operation (e.g. a division by zero).
+
+Enumerated types are a special case of variant types, where all
+alternatives are constants:
+\begin{caml_example}{toplevel}
+type sign = Positive | Negative;;
+let sign_int n = if n >= 0 then Positive else Negative;;
+\end{caml_example}
+
+To define arithmetic operations for the "number" type, we use
+pattern-matching on the two numbers involved:
+\begin{caml_example}{toplevel}
+let add_num n1 n2 =
+ match (n1, n2) with
+ (Int i1, Int i2) ->
+ (* Check for overflow of integer addition *)
+ if sign_int i1 = sign_int i2 && sign_int (i1 + i2) <> sign_int i1
+ then Float(float i1 +. float i2)
+ else Int(i1 + i2)
+ | (Int i1, Float f2) -> Float(float i1 +. f2)
+ | (Float f1, Int i2) -> Float(f1 +. float i2)
+ | (Float f1, Float f2) -> Float(f1 +. f2)
+ | (Error, _) -> Error
+ | (_, Error) -> Error;;
+add_num (Int 123) (Float 3.14159);;
+\end{caml_example}
+
+Another interesting example of variant type is the built-in
+"'a option" type which represents either a value of type "'a" or an
+absence of value:
+\begin{caml_example}{toplevel}
+type 'a option = Some of 'a | None;;
+\end{caml_example}
+This type is particularly useful when defining function that can
+fail in common situations, for instance
+\begin{caml_example}{toplevel}
+let safe_square_root x = if x > 0. then Some(sqrt x) else None;;
+\end{caml_example}
+
+The most common usage of variant types is to describe recursive data
+structures. Consider for example the type of binary trees:
+\begin{caml_example}{toplevel}
+type 'a btree = Empty | Node of 'a * 'a btree * 'a btree;;
+\end{caml_example}
+This definition reads as follows: a binary tree containing values of
+type "'a" (an arbitrary type) is either empty, or is a node containing
+one value of type "'a" and two subtrees also containing values of type
+"'a", that is, two "'a btree".
+
+Operations on binary trees are naturally expressed as recursive functions
+following the same structure as the type definition itself. For
+instance, here are functions performing lookup and insertion in
+ordered binary trees (elements increase from left to right):
+\begin{caml_example}{toplevel}
+let rec member x btree =
+ match btree with
+ Empty -> false
+ | Node(y, left, right) ->
+ if x = y then true else
+ if x < y then member x left else member x right;;
+let rec insert x btree =
+ match btree with
+ Empty -> Node(x, Empty, Empty)
+ | Node(y, left, right) ->
+ if x <= y then Node(y, insert x left, right)
+ else Node(y, left, insert x right);;
+\end{caml_example}
+
+
+\subsection{ss:record-and-variant-disambiguation}{Record and variant disambiguation}
+( This subsection can be skipped on the first reading )
+
+Astute readers may have wondered what happens when two or more record
+fields or constructors share the same name
+
+\begin{caml_example*}{toplevel}
+type first_record = { x:int; y:int; z:int }
+type middle_record = { x:int; z:int }
+type last_record = { x:int };;
+type first_variant = A | B | C
+type last_variant = A;;
+\end{caml_example*}
+
+The answer is that when confronted with multiple options, OCaml tries to
+use locally available information to disambiguate between the various fields
+and constructors. First, if the type of the record or variant is known,
+OCaml can pick unambiguously the corresponding field or constructor.
+For instance:
+
+\begin{caml_example}{toplevel}
+let look_at_x_then_z (r:first_record) =
+ let x = r.x in
+ x + r.z;;
+let permute (x:first_variant) = match x with
+ | A -> (B:first_variant)
+ | B -> A
+ | C -> C;;
+type wrapped = First of first_record
+let f (First r) = r, r.x;;
+\end{caml_example}
+
+In the first example, "(r:first_record)" is an explicit annotation
+telling OCaml that the type of "r" is "first_record". With this
+annotation, Ocaml knows that "r.x" refers to the "x" field of the first
+record type. Similarly, the type annotation in the second example makes
+it clear to OCaml that the constructors "A", "B" and "C" come from the
+first variant type. Contrarily, in the last example, OCaml has inferred
+by itself that the type of "r" can only be "first_record" and there are
+no needs for explicit type annotations.
+
+Those explicit type annotations can in fact be used anywhere.
+Most of the time they are unnecessary, but they are useful to guide
+disambiguation, to debug unexpected type errors, or combined with some
+of the more advanced features of OCaml described in later chapters.
+
+Secondly, for records, OCaml can also deduce the right record type by
+looking at the whole set of fields used in a expression or pattern:
+\begin{caml_example}{toplevel}
+let project_and_rotate {x; y; _} = { x= - y; y = x; z = 0} ;;
+\end{caml_example}
+Since the fields "x" and "y" can only appear simultaneously in the first
+record type, OCaml infers that the type of "project_and_rotate" is
+"first_record -> first_record".
+
+In last resort, if there is not enough information to disambiguate between
+different fields or constructors, Ocaml picks the last defined type
+amongst all locally valid choices:
+
+\begin{caml_example}{toplevel}
+let look_at_xz {x; z} = x;;
+\end{caml_example}
+
+Here, OCaml has inferred that the possible choices for the type of
+"{x;z}" are "first_record" and "middle_record", since the type
+"last_record" has no field "z". Ocaml then picks the type "middle_record"
+as the last defined type between the two possibilities.
+
+Beware that this last resort disambiguation is local: once Ocaml has
+chosen a disambiguation, it sticks to this choice, even if it leads to
+an ulterior type error:
+
+\begin{caml_example}{toplevel}[error]
+let look_at_x_then_y r =
+ let x = r.x in (* Ocaml deduces [r: last_record] *)
+ x + r.y;;
+let is_a_or_b x = match x with
+ | A -> true (* OCaml infers [x: last_variant] *)
+ | B -> true;;
+\end{caml_example}
+
+Moreover, being the last defined type is a quite unstable position that
+may change surreptitiously after adding or moving around a type
+definition, or after opening a module (see chapter \ref{c:moduleexamples}).
+Consequently, adding explicit type annotations to guide disambiguation is
+more robust than relying on the last defined type disambiguation.
+
+\section{s:imperative-features}{Imperative features}
+
+Though all examples so far were written in purely applicative style,
+OCaml is also equipped with full imperative features. This includes the
+usual "while" and "for" loops, as well as mutable data structures such
+as arrays. Arrays are either created by listing semicolon-separated element
+values between "[|" and "|]" brackets, or allocated and initialized with the
+"Array.make" function, then filled up later by assignments. For instance, the
+function below sums two vectors (represented as float arrays) componentwise.
+\begin{caml_example}{toplevel}
+let add_vect v1 v2 =
+ let len = min (Array.length v1) (Array.length v2) in
+ let res = Array.make len 0.0 in
+ for i = 0 to len - 1 do
+ res.(i) <- v1.(i) +. v2.(i)
+ done;
+ res;;
+add_vect [| 1.0; 2.0 |] [| 3.0; 4.0 |];;
+\end{caml_example}
+
+Record fields can also be modified by assignment, provided they are
+declared "mutable" in the definition of the record type:
+\begin{caml_example}{toplevel}
+type mutable_point = { mutable x: float; mutable y: float };;
+let translate p dx dy =
+ p.x <- p.x +. dx; p.y <- p.y +. dy;;
+let mypoint = { x = 0.0; y = 0.0 };;
+translate mypoint 1.0 2.0;;
+mypoint;;
+\end{caml_example}
+
+OCaml has no built-in notion of variable -- identifiers whose current
+value can be changed by assignment. (The "let" binding is not an
+assignment, it introduces a new identifier with a new scope.)
+However, the standard library provides references, which are mutable
+indirection cells, with operators "!" to fetch
+the current contents of the reference and ":=" to assign the contents.
+Variables can then be emulated by "let"-binding a reference. For
+instance, here is an in-place insertion sort over arrays:
+\begin{caml_example}{toplevel}
+let insertion_sort a =
+ for i = 1 to Array.length a - 1 do
+ let val_i = a.(i) in
+ let j = ref i in
+ while !j > 0 && val_i < a.(!j - 1) do
+ a.(!j) <- a.(!j - 1);
+ j := !j - 1
+ done;
+ a.(!j) <- val_i
+ done;;
+\end{caml_example}
+
+References are also useful to write functions that maintain a current
+state between two calls to the function. For instance, the following
+pseudo-random number generator keeps the last returned number in a
+reference:
+\begin{caml_example}{toplevel}
+let current_rand = ref 0;;
+let random () =
+ current_rand := !current_rand * 25713 + 1345;
+ !current_rand;;
+\end{caml_example}
+
+Again, there is nothing magical with references: they are implemented as
+a single-field mutable record, as follows.
+\begin{caml_example}{toplevel}
+type 'a ref = { mutable contents: 'a };;
+let ( ! ) r = r.contents;;
+let ( := ) r newval = r.contents <- newval;;
+\end{caml_example}
+
+In some special cases, you may need to store a polymorphic function in
+a data structure, keeping its polymorphism. Doing this requires
+user-provided type annotations, since polymorphism is only introduced
+automatically for global definitions. However, you can explicitly give
+polymorphic types to record fields.
+\begin{caml_example}{toplevel}
+type idref = { mutable id: 'a. 'a -> 'a };;
+let r = {id = fun x -> x};;
+let g s = (s.id 1, s.id true);;
+r.id <- (fun x -> print_string "called id\n"; x);;
+g r;;
+\end{caml_example}
+
+\section{s:exceptions}{Exceptions}
+
+OCaml provides exceptions for signalling and handling exceptional
+conditions. Exceptions can also be used as a general-purpose non-local
+control structure, although this should not be overused since it can
+make the code harder to understand. Exceptions are declared with the
+"exception" construct, and signalled with the "raise" operator. For instance,
+the function below for taking the head of a list uses an exception to
+signal the case where an empty list is given.
+\begin{caml_example}{toplevel}
+exception Empty_list;;
+let head l =
+ match l with
+ [] -> raise Empty_list
+ | hd :: tl -> hd;;
+head [1; 2];;
+head [];;
+\end{caml_example}
+
+Exceptions are used throughout the standard library to signal cases
+where the library functions cannot complete normally. For instance,
+the "List.assoc" function, which returns the data associated with a
+given key in a list of (key, data) pairs, raises the predefined
+exception "Not_found" when the key does not appear in the list:
+\begin{caml_example}{toplevel}
+List.assoc 1 [(0, "zero"); (1, "one")];;
+List.assoc 2 [(0, "zero"); (1, "one")];;
+\end{caml_example}
+
+Exceptions can be trapped with the "try"\ldots"with" construct:
+\begin{caml_example}{toplevel}
+let name_of_binary_digit digit =
+ try
+ List.assoc digit [0, "zero"; 1, "one"]
+ with Not_found ->
+ "not a binary digit";;
+name_of_binary_digit 0;;
+name_of_binary_digit (-1);;
+\end{caml_example}
+
+The "with" part does pattern matching on the
+exception value with the same syntax and behavior as "match". Thus,
+several exceptions can be caught by one
+"try"\ldots"with" construct:
+\begin{caml_example}{toplevel}
+let rec first_named_value values names =
+ try
+ List.assoc (head values) names
+ with
+ | Empty_list -> "no named value"
+ | Not_found -> first_named_value (List.tl values) names;;
+first_named_value [0; 10] [1, "one"; 10, "ten"];;
+\end{caml_example}
+
+Also, finalization can be performed by
+trapping all exceptions, performing the finalization, then re-raising
+the exception:
+\begin{caml_example}{toplevel}
+let temporarily_set_reference ref newval funct =
+ let oldval = !ref in
+ try
+ ref := newval;
+ let res = funct () in
+ ref := oldval;
+ res
+ with x ->
+ ref := oldval;
+ raise x;;
+\end{caml_example}
+
+An alternative to "try"\ldots"with" is to catch the exception while
+pattern matching:
+\begin{caml_example}{toplevel}
+let assoc_may_map f x l =
+ match List.assoc x l with
+ | exception Not_found -> None
+ | y -> f y;;
+\end{caml_example}
+Note that this construction is only useful if the exception is raised
+between "match"\ldots"with". Exception patterns can be combined
+with ordinary patterns at the toplevel,
+\begin{caml_example}{toplevel}
+let flat_assoc_opt x l =
+ match List.assoc x l with
+ | None | exception Not_found -> None
+ | Some _ as v -> v;;
+\end{caml_example}
+but they cannot be nested inside other patterns. For instance,
+the pattern "Some (exception A)" is invalid.
+
+When exceptions are used as a control structure, it can be useful to make
+them as local as possible by using a locally defined exception.
+For instance, with
+\begin{caml_eval}
+ let ref x: _ ref = {contents=x};;
+\end{caml_eval}
+\begin{caml_example}{toplevel}
+let fixpoint f x =
+ let exception Done in
+ let x = ref x in
+ try while true do
+ let y = f !x in
+ if !x = y then raise Done else x := y
+ done; assert false
+ with Done -> !x;;
+\end{caml_example}
+the function "f" cannot raise a "Done" exception, which removes an
+entire class of misbehaving functions.
+
+\section{s:lazy-expr}{Lazy expressions}
+
+OCaml allows us to defer some computation until later when we need the result of
+ that computation.
+
+We use "lazy (expr)" to delay the evaluation of some expression "expr". For
+example, we can defer the computation of "1+1" until we need the result of that
+expression, "2". Let us see how we initialize a lazy expression.
+
+\begin{caml_example}{toplevel}
+let lazy_two = lazy (print_endline "lazy_two evaluation"; 1 + 1);;
+\end{caml_example}
+
+We added "print_endline \"lazy_two evaluation\"" to see when the lazy
+ expression is being evaluated.
+
+The value of "lazy_two" is displayed as "<lazy>", which means the expression
+has not been evaluated yet, and its final value is unknown.
+
+Note that "lazy_two" has type "int lazy_t". However, the type "'a lazy_t" is an
+internal type name, so the type "'a Lazy.t" should be preferred when possible.
+
+When we finally need the result of a lazy expression, we can call "Lazy.force"
+on that expression to force its evaluation. The function "force" comes from
+standard-library module \stdmoduleref{Lazy}.
+
+\begin{caml_example}{toplevel}
+Lazy.force lazy_two;;
+\end{caml_example}
+
+Notice that our function call above prints ``lazy_two evaluation'' and then
+returns the plain value of the computation.
+
+Now if we look at the value of "lazy_two", we see that it is not displayed as
+"<lazy>" anymore but as "lazy 2".
+
+\begin{caml_example}{toplevel}
+lazy_two;;
+\end{caml_example}
+
+This is because "Lazy.force" memoizes the result of the forced expression. In other
+words, every subsequent call of "Lazy.force" on that expression returns the
+result of the first computation without recomputing the lazy expression. Let us
+force "lazy_two" once again.
+
+\begin{caml_example}{toplevel}
+Lazy.force lazy_two;;
+\end{caml_example}
+
+The expression is not evaluated this time; notice that ``lazy_two evaluation'' is
+not printed. The result of the initial computation is simply returned.
+
+Lazy patterns provide another way to force a lazy expression.
+
+\begin{caml_example}{toplevel}
+let lazy_l = lazy ([1; 2] @ [3; 4]);;
+let lazy l = lazy_l;;
+\end{caml_example}
+
+We can also use lazy patterns in pattern matching.
+
+\begin{caml_example}{toplevel}
+let maybe_eval lazy_guard lazy_expr =
+ match lazy_guard, lazy_expr with
+ | lazy false, _ -> "matches if (Lazy.force lazy_guard = false); lazy_expr not forced"
+ | lazy true, lazy _ -> "matches if (Lazy.force lazy_guard = true); lazy_expr forced";;
+\end{caml_example}
+
+The lazy expression "lazy_expr" is forced only if the "lazy_guard" value yields
+"true" once computed. Indeed, a simple wildcard pattern (not lazy) never forces
+the lazy expression's evaluation. However, a pattern with keyword "lazy", even
+if it is wildcard, always forces the evaluation of the deferred computation.
+
+\section{s:symb-expr}{Symbolic processing of expressions}
+
+We finish this introduction with a more complete example
+representative of the use of OCaml for symbolic processing: formal
+manipulations of arithmetic expressions containing variables. The
+following variant type describes the expressions we shall manipulate:
+\begin{caml_example}{toplevel}
+type expression =
+ Const of float
+ | Var of string
+ | Sum of expression * expression (* e1 + e2 *)
+ | Diff of expression * expression (* e1 - e2 *)
+ | Prod of expression * expression (* e1 * e2 *)
+ | Quot of expression * expression (* e1 / e2 *)
+;;
+\end{caml_example}
+
+We first define a function to evaluate an expression given an
+environment that maps variable names to their values. For simplicity,
+the environment is represented as an association list.
+\begin{caml_example}{toplevel}
+exception Unbound_variable of string;;
+let rec eval env exp =
+ match exp with
+ Const c -> c
+ | Var v ->
+ (try List.assoc v env with Not_found -> raise (Unbound_variable v))
+ | Sum(f, g) -> eval env f +. eval env g
+ | Diff(f, g) -> eval env f -. eval env g
+ | Prod(f, g) -> eval env f *. eval env g
+ | Quot(f, g) -> eval env f /. eval env g;;
+eval [("x", 1.0); ("y", 3.14)] (Prod(Sum(Var "x", Const 2.0), Var "y"));;
+\end{caml_example}
+
+Now for a real symbolic processing, we define the derivative of an
+expression with respect to a variable "dv":
+\begin{caml_example}{toplevel}
+let rec deriv exp dv =
+ match exp with
+ Const c -> Const 0.0
+ | Var v -> if v = dv then Const 1.0 else Const 0.0
+ | Sum(f, g) -> Sum(deriv f dv, deriv g dv)
+ | Diff(f, g) -> Diff(deriv f dv, deriv g dv)
+ | Prod(f, g) -> Sum(Prod(f, deriv g dv), Prod(deriv f dv, g))
+ | Quot(f, g) -> Quot(Diff(Prod(deriv f dv, g), Prod(f, deriv g dv)),
+ Prod(g, g))
+;;
+deriv (Quot(Const 1.0, Var "x")) "x";;
+\end{caml_example}
+
+\section{s:pretty-printing}{Pretty-printing}
+
+As shown in the examples above, the internal representation (also
+called {\em abstract syntax\/}) of expressions quickly becomes hard to
+read and write as the expressions get larger. We need a printer and a
+parser to go back and forth between the abstract syntax and the {\em
+concrete syntax}, which in the case of expressions is the familiar
+algebraic notation (e.g. "2*x+1").
+
+For the printing function, we take into account the usual precedence
+rules (i.e. "*" binds tighter than "+") to avoid printing unnecessary
+parentheses. To this end, we maintain the current operator precedence
+and print parentheses around an operator only if its precedence is
+less than the current precedence.
+\begin{caml_example}{toplevel}
+let print_expr exp =
+ (* Local function definitions *)
+ let open_paren prec op_prec =
+ if prec > op_prec then print_string "(" in
+ let close_paren prec op_prec =
+ if prec > op_prec then print_string ")" in
+ let rec print prec exp = (* prec is the current precedence *)
+ match exp with
+ Const c -> print_float c
+ | Var v -> print_string v
+ | Sum(f, g) ->
+ open_paren prec 0;
+ print 0 f; print_string " + "; print 0 g;
+ close_paren prec 0
+ | Diff(f, g) ->
+ open_paren prec 0;
+ print 0 f; print_string " - "; print 1 g;
+ close_paren prec 0
+ | Prod(f, g) ->
+ open_paren prec 2;
+ print 2 f; print_string " * "; print 2 g;
+ close_paren prec 2
+ | Quot(f, g) ->
+ open_paren prec 2;
+ print 2 f; print_string " / "; print 3 g;
+ close_paren prec 2
+ in print 0 exp;;
+let e = Sum(Prod(Const 2.0, Var "x"), Const 1.0);;
+print_expr e; print_newline ();;
+print_expr (deriv e "x"); print_newline ();;
+\end{caml_example}
+
+\section{s:printf}{Printf formats}
+
+There is a "printf" function in the \stdmoduleref{Printf} module
+(see chapter~\ref{c:moduleexamples}) that allows you to make formatted
+output more concisely.
+It follows the behavior of the "printf" function from the C standard library.
+The "printf" function takes a format string that describes the desired output
+as a text interspersed with specifiers (for instance "%d", "%f").
+Next, the specifiers are substituted by the following arguments in their order
+of apparition in the format string:
+\begin{caml_example}{toplevel}
+Printf.printf "%i + %i is an integer value, %F * %F is a float, %S\n"
+3 2 4.5 1. "this is a string";;
+\end{caml_example}
+The OCaml type system checks that the type of the arguments and the specifiers are
+compatible. If you pass it an argument of a type that does not correspond to
+the format specifier, the compiler will display an error message:
+\begin{caml_example}{toplevel}[error]
+Printf.printf "Float value: %F" 42;;
+\end{caml_example}
+The "fprintf" function is like "printf" except that it takes an output channel as
+the first argument. The "%a" specifier can be useful to define custom printer
+(for custom types). For instance, we can create a printing template that converts
+an integer argument to signed decimal:
+\begin{caml_example}{toplevel}
+let pp_int ppf n = Printf.fprintf ppf "%d" n;;
+Printf.printf "Outputting an integer using a custom printer: %a " pp_int 42;;
+\end{caml_example}
+The advantage of those printers based on the "%a" specifier is that they can be
+composed together to create more complex printers step by step.
+We can define a combinator that can turn a printer for "'a" type into a printer
+for "'a optional":
+\begin{caml_example}{toplevel}
+let pp_option printer ppf = function
+ | None -> Printf.fprintf ppf "None"
+ | Some v -> Printf.fprintf ppf "Some(%a)" printer v;;
+Printf.fprintf stdout
+ "The current setting is %a. \nThere is only %a\n"
+ (pp_option pp_int) (Some 3)
+ (pp_option pp_int) None
+;;
+\end{caml_example}
+If the value of its argument its "None", the printer returned by pp_option
+printer prints "None" otherwise it uses the provided printer to print "Some ".
+
+Here is how to rewrite the pretty-printer using "fprintf":
+\begin{caml_example}{toplevel}
+let pp_expr ppf expr =
+ let open_paren prec op_prec output =
+ if prec > op_prec then Printf.fprintf output "%s" "(" in
+ let close_paren prec op_prec output =
+ if prec > op_prec then Printf.fprintf output "%s" ")" in
+ let rec print prec ppf expr =
+ match expr with
+ | Const c -> Printf.fprintf ppf "%F" c
+ | Var v -> Printf.fprintf ppf "%s" v
+ | Sum(f, g) ->
+ open_paren prec 0 ppf;
+ Printf.fprintf ppf "%a + %a" (print 0) f (print 0) g;
+ close_paren prec 0 ppf
+ | Diff(f, g) ->
+ open_paren prec 0 ppf;
+ Printf.fprintf ppf "%a - %a" (print 0) f (print 1) g;
+ close_paren prec 0 ppf
+ | Prod(f, g) ->
+ open_paren prec 2 ppf;
+ Printf.fprintf ppf "%a * %a" (print 2) f (print 2) g;
+ close_paren prec 2 ppf
+ | Quot(f, g) ->
+ open_paren prec 2 ppf;
+ Printf.fprintf ppf "%a / %a" (print 2) f (print 3) g;
+ close_paren prec 2 ppf
+ in print 0 ppf expr;;
+pp_expr stdout e; print_newline ();;
+pp_expr stdout (deriv e "x"); print_newline ();;
+\end{caml_example}
+
+Due to the way that format string are build, storing a format string requires
+an explicit type annotation:
+\begin{caml_example*}{toplevel}
+let str : _ format =
+ "%i is an integer value, %F is a float, %S\n";;
+\end{caml_example*}
+\begin{caml_example}{toplevel}
+Printf.printf str 3 4.5 "string value";;
+\end{caml_example}
+
+\section{s:standalone-programs}{Standalone OCaml programs}
+
+All examples given so far were executed under the interactive system.
+OCaml code can also be compiled separately and executed
+non-interactively using the batch compilers "ocamlc" and "ocamlopt".
+The source code must be put in a file with extension ".ml". It
+consists of a sequence of phrases, which will be evaluated at runtime
+in their order of appearance in the source file. Unlike in interactive
+mode, types and values are not printed automatically; the program must
+call printing functions explicitly to produce some output. The ";;" used
+in the interactive examples is not required in
+source files created for use with OCaml compilers, but can be helpful
+to mark the end of a top-level expression unambiguously even when
+there are syntax errors.
+Here is a
+sample standalone program to print the greatest common divisor
+(gcd) of two numbers:
+\begin{verbatim}
+(* File gcd.ml *)
+let rec gcd a b =
+ if b = 0 then a
+ else gcd b (a mod b);;
+
+let main () =
+ let a = int_of_string Sys.argv.(1) in
+ let b = int_of_string Sys.argv.(2) in
+ Printf.printf "%d\n" (gcd a b);
+ exit 0;;
+main ();;
+\end{verbatim}
+"Sys.argv" is an array of strings containing the command-line
+parameters. "Sys.argv.(1)" is thus the first command-line parameter.
+The program above is compiled and executed with the following shell
+commands:
+\begin{verbatim}
+$ ocamlc -o gcd gcd.ml
+$ ./gcd 6 9
+3
+$ ./gcd 7 11
+1
+\end{verbatim}
+
+More complex standalone OCaml programs are typically composed of
+multiple source files, and can link with precompiled libraries.
+Chapters~\ref{c:camlc} and~\ref{c:nativecomp} explain how to use the
+batch compilers "ocamlc" and "ocamlopt". Recompilation of
+multi-file OCaml projects can be automated using third-party
+build systems, such as \href{https://github.com/ocaml/dune}{dune}.
--- /dev/null
+\chapter{Generalized algebraic datatypes} \label{c:gadts-tutorial}
+%HEVEA\cutname{gadts-tutorial.html}
+
+Generalized algebraic datatypes, or GADTs, extend usual sum types in
+two ways: constraints on type parameters may change depending on the
+value constructor, and some type variables may be existentially
+quantified.
+Adding constraints is done by giving an explicit return type, where type
+parameters are instantiated:
+
+\begin{caml_example*}{verbatim}
+type _ term =
+ | Int : int -> int term
+ | Add : (int -> int -> int) term
+ | App : ('b -> 'a) term * 'b term -> 'a term
+\end{caml_example*}
+
+This return type must use the same type constructor as the type being
+defined, and have the same number of parameters.
+Variables are made existential when they appear inside a constructor's
+argument, but not in its return type.
+Since the use of a return type often eliminates the need to name type
+parameters in the left-hand side of a type definition, one can replace
+them with anonymous types "_" in that case.
+
+The constraints associated to each constructor can be recovered
+through pattern-matching.
+Namely, if the type of the scrutinee of a pattern-matching contains
+a locally abstract type, this type can be refined according to the
+constructor used.
+These extra constraints are only valid inside the corresponding branch
+of the pattern-matching.
+If a constructor has some existential variables, fresh locally
+abstract types are generated, and they must not escape the
+scope of this branch.
+
+\section{s:gadts-recfun}{Recursive functions}
+
+We write an "eval" function:
+
+\begin{caml_example*}{verbatim}
+let rec eval : type a. a term -> a = function
+ | Int n -> n (* a = int *)
+ | Add -> (fun x y -> x+y) (* a = int -> int -> int *)
+ | App(f,x) -> (eval f) (eval x)
+ (* eval called at types (b->a) and b for fresh b *)
+\end{caml_example*}
+
+And use it:
+
+\begin{caml_example}{verbatim}
+let two = eval (App (App (Add, Int 1), Int 1))
+\end{caml_example}
+It is important to remark that the function "eval" is using the
+polymorphic syntax for locally abstract types. When defining a recursive
+function that manipulates a GADT, explicit polymorphic recursion should
+generally be used. For instance, the following definition fails with a
+type error:
+\begin{caml_example}{verbatim}[error]
+let rec eval (type a) : a term -> a = function
+ | Int n -> n
+ | Add -> (fun x y -> x+y)
+ | App(f,x) -> (eval f) (eval x)
+\end{caml_example}
+In absence of an explicit polymorphic annotation, a monomorphic type
+is inferred for the recursive function. If a recursive call occurs
+inside the function definition at a type that involves an existential
+GADT type variable, this variable flows to the type of the recursive
+function, and thus escapes its scope. In the above example, this happens
+in the branch "App(f,x)" when "eval" is called with "f" as an argument.
+In this branch, the type of "f" is "($App_ 'b-> a)". The prefix "$" in
+"$App_ 'b" denotes an existential type named by the compiler
+(see~\ref{s:existential-names}). Since the type of "eval" is
+"'a term -> 'a", the call "eval f" makes the existential type "$App_'b"
+flow to the type variable "'a" and escape its scope. This triggers the
+above error.
+
+\section{s:gadts-type-inference}{Type inference}
+
+Type inference for GADTs is notoriously hard.
+This is due to the fact some types may become ambiguous when escaping
+from a branch.
+For instance, in the "Int" case above, "n" could have either type "int"
+or "a", and they are not equivalent outside of that branch.
+As a first approximation, type inference will always work if a
+pattern-matching is annotated with types containing no free type
+variables (both on the scrutinee and the return type).
+This is the case in the above example, thanks to the type annotation
+containing only locally abstract types.
+
+In practice, type inference is a bit more clever than that: type
+annotations do not need to be immediately on the pattern-matching, and
+the types do not have to be always closed.
+As a result, it is usually enough to only annotate functions, as in
+the example above. Type annotations are
+propagated in two ways: for the scrutinee, they follow the flow of
+type inference, in a way similar to polymorphic methods; for the
+return type, they follow the structure of the program, they are split
+on functions, propagated to all branches of a pattern matching,
+and go through tuples, records, and sum types.
+Moreover, the notion of ambiguity used is stronger: a type is only
+seen as ambiguous if it was mixed with incompatible types (equated by
+constraints), without type annotations between them.
+For instance, the following program types correctly.
+\begin{caml_example}{verbatim}
+let rec sum : type a. a term -> _ = fun x ->
+ let y =
+ match x with
+ | Int n -> n
+ | Add -> 0
+ | App(f,x) -> sum f + sum x
+ in y + 1
+\end{caml_example}
+Here the return type "int" is never mixed with "a", so it is seen as
+non-ambiguous, and can be inferred.
+When using such partial type annotations we strongly suggest
+specifying the "-principal" mode, to check that inference is
+principal.
+
+The exhaustiveness check is aware of GADT constraints, and can
+automatically infer that some cases cannot happen.
+For instance, the following pattern matching is correctly seen as
+exhaustive (the "Add" case cannot happen).
+\begin{caml_example*}{verbatim}
+let get_int : int term -> int = function
+ | Int n -> n
+ | App(_,_) -> 0
+\end{caml_example*}
+
+
+\section{s:gadt-refutation-cases}{Refutation cases}
+
+Usually, the exhaustiveness check only tries to check whether the
+cases omitted from the pattern matching are typable or not.
+However, you can force it to try harder by adding {\em refutation cases},
+written as a full stop.
+In the presence of a refutation case, the exhaustiveness check will first
+compute the intersection of the pattern with the complement of the
+cases preceding it. It then checks whether the resulting patterns can
+really match any concrete values by trying to type-check them.
+Wild cards in the generated patterns are handled in a special way: if
+their type is a variant type with only GADT constructors, then the
+pattern is split into the different constructors, in order to check whether
+any of them is possible (this splitting is not done for arguments of these
+constructors, to avoid non-termination). We also split tuples and
+variant types with only one case, since they may contain GADTs inside.
+For instance, the following code is deemed exhaustive:
+
+\begin{caml_example*}{verbatim}
+type _ t =
+ | Int : int t
+ | Bool : bool t
+
+let deep : (char t * int) option -> char = function
+ | None -> 'c'
+ | _ -> .
+\end{caml_example*}
+
+Namely, the inferred remaining case is "Some _", which is split into
+"Some (Int, _)" and "Some (Bool, _)", which are both untypable because
+"deep" expects a non-existing "char t" as the first element of the tuple.
+Note that the refutation case could be omitted here, because it is
+automatically added when there is only one case in the pattern
+matching.
+
+Another addition is that the redundancy check is now aware of GADTs: a
+case will be detected as redundant if it could be replaced by a
+refutation case using the same pattern.
+
+\section{s:gadts-advexamples}{Advanced examples}
+The "term" type we have defined above is an {\em indexed} type, where
+a type parameter reflects a property of the value contents.
+Another use of GADTs is {\em singleton} types, where a GADT value
+represents exactly one type. This value can be used as runtime
+representation for this type, and a function receiving it can have a
+polytypic behavior.
+
+Here is an example of a polymorphic function that takes the
+runtime representation of some type "t" and a value of the same type,
+then pretty-prints the value as a string:
+\begin{caml_example*}{verbatim}
+type _ typ =
+ | Int : int typ
+ | String : string typ
+ | Pair : 'a typ * 'b typ -> ('a * 'b) typ
+
+let rec to_string: type t. t typ -> t -> string =
+ fun t x ->
+ match t with
+ | Int -> Int.to_string x
+ | String -> Printf.sprintf "%S" x
+ | Pair(t1,t2) ->
+ let (x1, x2) = x in
+ Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2)
+\end{caml_example*}
+
+Another frequent application of GADTs is equality witnesses.
+\begin{caml_example*}{verbatim}
+type (_,_) eq = Eq : ('a,'a) eq
+
+let cast : type a b. (a,b) eq -> a -> b = fun Eq x -> x
+\end{caml_example*}
+Here type "eq" has only one constructor, and by matching on it one
+adds a local constraint allowing the conversion between "a" and "b".
+By building such equality witnesses, one can make equal types which
+are syntactically different.
+
+Here is an example using both singleton types and equality witnesses
+to implement dynamic types.
+\begin{caml_example*}{verbatim}
+let rec eq_type : type a b. a typ -> b typ -> (a,b) eq option =
+ fun a b ->
+ match a, b with
+ | Int, Int -> Some Eq
+ | String, String -> Some Eq
+ | Pair(a1,a2), Pair(b1,b2) ->
+ begin match eq_type a1 b1, eq_type a2 b2 with
+ | Some Eq, Some Eq -> Some Eq
+ | _ -> None
+ end
+ | _ -> None
+
+type dyn = Dyn : 'a typ * 'a -> dyn
+
+let get_dyn : type a. a typ -> dyn -> a option =
+ fun a (Dyn(b,x)) ->
+ match eq_type a b with
+ | None -> None
+ | Some Eq -> Some x
+\end{caml_example*}
+
+\section{s:existential-names}{Existential type names in error messages}
+
+The typing of pattern matching in presence of GADT can generate many
+existential types. When necessary, error messages refer to these
+existential types using compiler-generated names. Currently, the
+compiler generates these names according to the following nomenclature:
+\begin{itemize}
+\item First, types whose name starts with a "$" are existentials.
+\item "$Constr_'a" denotes an existential type introduced for the type
+variable "'a" of the GADT constructor "Constr":
+\begin{caml_example}{verbatim}[error]
+type any = Any : 'name -> any
+let escape (Any x) = x
+\end{caml_example}
+\item "$Constr" denotes an existential type introduced for an anonymous %$
+type variable in the GADT constructor "Constr":
+\begin{caml_example}{verbatim}[error]
+type any = Any : _ -> any
+let escape (Any x) = x
+\end{caml_example}
+\item "$'a" if the existential variable was unified with the type %$
+variable "'a" during typing:
+\begin{caml_example}{verbatim}[error]
+type ('arg,'result,'aux) fn =
+ | Fun: ('a ->'b) -> ('a,'b,unit) fn
+ | Mem1: ('a ->'b) * 'a * 'b -> ('a, 'b, 'a * 'b) fn
+ let apply: ('arg,'result, _ ) fn -> 'arg -> 'result = fun f x ->
+ match f with
+ | Fun f -> f x
+ | Mem1 (f,y,fy) -> if x = y then fy else f x
+\end{caml_example}
+\item "$n" (n a number) is an internally generated existential %$
+which could not be named using one of the previous schemes.
+\end{itemize}
+
+As shown by the last item, the current behavior is imperfect
+and may be improved in future versions.
+
+\section{s:explicit-existential-name}{Explicit naming of existentials}
+
+As explained above, pattern-matching on a GADT constructor may introduce
+existential types. Syntax has been introduced which allows them to be named
+explicitly. For instance, the following code names the type of the argument of
+"f" and uses this name.
+
+\begin{caml_example*}{verbatim}
+type _ closure = Closure : ('a -> 'b) * 'a -> 'b closure
+let eval = fun (Closure (type a) (f, x : (a -> _) * _)) -> f (x : a)
+\end{caml_example*}
+All existential type variables of the constructor must by introduced by
+the ("type" ...) construct and bound by a type annotation on the
+outside of the constructor argument.
+
+\section{s:gadt-equation-nonlocal-abstract}{Equations on non-local abstract types}
+
+GADT pattern-matching may also add type equations to non-local
+abstract types. The behaviour is the same as with local abstract
+types. Reusing the above "eq" type, one can write:
+\begin{caml_example*}{verbatim}
+module M : sig type t val x : t val e : (t,int) eq end = struct
+ type t = int
+ let x = 33
+ let e = Eq
+end
+
+let x : int = let Eq = M.e in M.x
+\end{caml_example*}
+
+Of course, not all abstract types can be refined, as this would
+contradict the exhaustiveness check. Namely, builtin types (those
+defined by the compiler itself, such as "int" or "array"), and
+abstract types defined by the local module, are non-instantiable, and
+as such cause a type error rather than introduce an equation.
--- /dev/null
+\chapter{Labeled arguments} \label{c:labl-examples}
+%HEVEA\cutname{lablexamples.html}
+{\it (Chapter written by Jacques Garrigue)}
+
+If you have a look at modules ending in "Labels" in the standard
+library, you will see that function types have annotations you did not
+have in the functions you defined yourself.
+
+\begin{caml_example}{toplevel}
+ListLabels.map;;
+StringLabels.sub;;
+\end{caml_example}
+
+Such annotations of the form "name:" are called {\em labels}. They are
+meant to document the code, allow more checking, and give more
+flexibility to function application.
+You can give such names to arguments in your programs, by prefixing them
+with a tilde "~".
+
+\begin{caml_example}{toplevel}
+let f ~x ~y = x - y;;
+let x = 3 and y = 2 in f ~x ~y;;
+\end{caml_example}
+
+When you want to use distinct names for the variable and the label
+appearing in the type, you can use a naming label of the form
+"~name:". This also applies when the argument is not a variable.
+
+\begin{caml_example}{toplevel}
+let f ~x:x1 ~y:y1 = x1 - y1;;
+f ~x:3 ~y:2;;
+\end{caml_example}
+
+Labels obey the same rules as other identifiers in OCaml, that is you
+cannot use a reserved keyword (like "in" or "to") as label.
+
+Formal parameters and arguments are matched according to their
+respective labels, the absence of label
+being interpreted as the empty label.
+%
+This allows commuting arguments in applications. One can also
+partially apply a function on any argument, creating a new function of
+the remaining parameters.
+
+\begin{caml_example}{toplevel}
+let f ~x ~y = x - y;;
+f ~y:2 ~x:3;;
+ListLabels.fold_left;;
+ListLabels.fold_left [1;2;3] ~init:0 ~f:( + );;
+ListLabels.fold_left ~init:0;;
+\end{caml_example}
+
+If several arguments of a function bear the same label (or no label),
+they will not commute among themselves, and order matters. But they
+can still commute with other arguments.
+
+\begin{caml_example}{toplevel}
+let hline ~x:x1 ~x:x2 ~y = (x1, x2, y);;
+hline ~x:3 ~y:2 ~x:5;;
+\end{caml_example}
+
+\section{s:optional-arguments}{Optional arguments}
+
+An interesting feature of labeled arguments is that they can be made
+optional. For optional parameters, the question mark "?" replaces the
+tilde "~" of non-optional ones, and the label is also prefixed by "?"
+in the function type.
+Default values may be given for such optional parameters.
+
+\begin{caml_example}{toplevel}
+let bump ?(step = 1) x = x + step;;
+bump 2;;
+bump ~step:3 2;;
+\end{caml_example}
+
+A function taking some optional arguments must also take at least one
+non-optional argument. The criterion for deciding whether an optional
+argument has been omitted is the non-labeled application of an
+argument appearing after this optional argument in the function type.
+Note that if that argument is labeled, you will only be able to
+eliminate optional arguments by totally applying the function,
+omitting all optional arguments and omitting all labels for all
+remaining arguments.
+
+\begin{caml_example}{toplevel}
+let test ?(x = 0) ?(y = 0) () ?(z = 0) () = (x, y, z);;
+test ();;
+test ~x:2 () ~z:3 ();;
+\end{caml_example}
+
+Optional parameters may also commute with non-optional or unlabeled
+ones, as long as they are applied simultaneously. By nature, optional
+arguments do not commute with unlabeled arguments applied
+independently.
+\begin{caml_example}{toplevel}
+test ~y:2 ~x:3 () ();;
+test () () ~z:1 ~y:2 ~x:3;;
+(test () ()) ~z:1 [@@expect error];;
+\end{caml_example}
+Here "(test () ())" is already "(0,0,0)" and cannot be further
+applied.
+
+Optional arguments are actually implemented as option types. If
+you do not give a default value, you have access to their internal
+representation, "type 'a option = None | Some of 'a". You can then
+provide different behaviors when an argument is present or not.
+
+\begin{caml_example}{toplevel}
+let bump ?step x =
+ match step with
+ | None -> x * 2
+ | Some y -> x + y
+;;
+\end{caml_example}
+
+It may also be useful to relay an optional argument from a function
+call to another. This can be done by prefixing the applied argument
+with "?". This question mark disables the wrapping of optional
+argument in an option type.
+
+\begin{caml_example}{toplevel}
+let test2 ?x ?y () = test ?x ?y () ();;
+test2 ?x:None;;
+\end{caml_example}
+
+\section{s:label-inference}{Labels and type inference}
+
+While they provide an increased comfort for writing function
+applications, labels and optional arguments have the pitfall that they
+cannot be inferred as completely as the rest of the language.
+
+You can see it in the following two examples.
+\begin{caml_example}{toplevel}
+let h' g = g ~y:2 ~x:3;;
+h' f [@@expect error];;
+let bump_it bump x =
+ bump ~step:2 x;;
+bump_it bump 1 [@@expect error];;
+\end{caml_example}
+The first case is simple: "g" is passed "~y" and then "~x", but "f"
+expects "~x" and then "~y". This is correctly handled if we know the
+type of "g" to be "x:int -> y:int -> int" in advance, but otherwise
+this causes the above type clash. The simplest workaround is to apply
+formal parameters in a standard order.
+
+The second example is more subtle: while we intended the argument
+"bump" to be of type "?step:int -> int -> int", it is inferred as
+"step:int -> int -> 'a".
+%
+These two types being incompatible (internally normal and optional
+arguments are different), a type error occurs when applying "bump_it"
+to the real "bump".
+
+We will not try here to explain in detail how type inference works.
+One must just understand that there is not enough information in the
+above program to deduce the correct type of "g" or "bump". That is,
+there is no way to know whether an argument is optional or not, or
+which is the correct order, by looking only at how a function is
+applied. The strategy used by the compiler is to assume that there are
+no optional arguments, and that applications are done in the right
+order.
+
+The right way to solve this problem for optional parameters is to add
+a type annotation to the argument "bump".
+\begin{caml_example}{toplevel}
+let bump_it (bump : ?step:int -> int -> int) x =
+ bump ~step:2 x;;
+bump_it bump 1;;
+\end{caml_example}
+In practice, such problems appear mostly when using objects whose
+methods have optional arguments, so that writing the type of object
+arguments is often a good idea.
+
+Normally the compiler generates a type error if you attempt to pass to
+a function a parameter whose type is different from the expected one.
+However, in the specific case where the expected type is a non-labeled
+function type, and the argument is a function expecting optional
+parameters, the compiler will attempt to transform the argument to
+have it match the expected type, by passing "None" for all optional
+parameters.
+
+\begin{caml_example}{toplevel}
+let twice f (x : int) = f(f x);;
+twice bump 2;;
+\end{caml_example}
+
+This transformation is coherent with the intended semantics,
+including side-effects. That is, if the application of optional
+parameters shall produce side-effects, these are delayed until the
+received function is really applied to an argument.
+
+\section{s:label-suggestions}{Suggestions for labeling}
+
+Like for names, choosing labels for functions is not an easy task. A
+good labeling is a labeling which
+
+\begin{itemize}
+\item makes programs more readable,
+\item is easy to remember,
+\item when possible, allows useful partial applications.
+\end{itemize}
+
+We explain here the rules we applied when labeling OCaml
+libraries.
+
+To speak in an ``object-oriented'' way, one can consider that each
+function has a main argument, its {\em object}, and other arguments
+related with its action, the {\em parameters}. To permit the
+combination of functions through functionals in commuting label mode, the
+object will not be labeled. Its role is clear from the function
+itself. The parameters are labeled with names reminding of
+their nature or their role. The best labels combine nature and
+role. When this is not possible the role is to be preferred, since the
+nature will
+often be given by the type itself. Obscure abbreviations should be
+avoided.
+\begin{alltt}
+"ListLabels.map : f:('a -> 'b) -> 'a list -> 'b list"
+UnixLabels.write : file_descr -> buf:bytes -> pos:int -> len:int -> unit
+\end{alltt}
+
+When there are several objects of same nature and role, they are all
+left unlabeled.
+\begin{alltt}
+"ListLabels.iter2 : f:('a -> 'b -> unit) -> 'a list -> 'b list -> unit"
+\end{alltt}
+
+When there is no preferable object, all arguments are labeled.
+\begin{alltt}
+BytesLabels.blit :
+ src:bytes -> src_pos:int -> dst:bytes -> dst_pos:int -> len:int -> unit
+\end{alltt}
+
+However, when there is only one argument, it is often left unlabeled.
+\begin{alltt}
+BytesLabels.create : int -> bytes
+\end{alltt}
+This principle also applies to functions of several arguments whose
+return type is a type variable, as long as the role of each argument
+is not ambiguous. Labeling such functions may lead to awkward error
+messages when one attempts to omit labels in an application, as we
+have seen with "ListLabels.fold_left".
+
+Here are some of the label names you will find throughout the
+libraries.
+
+\begin{tableau}{|l|l|}{Label}{Meaning}
+\entree{"f:"}{a function to be applied}
+\entree{"pos:"}{a position in a string, array or byte sequence}
+\entree{"len:"}{a length}
+\entree{"buf:"}{a byte sequence or string used as buffer}
+\entree{"src:"}{the source of an operation}
+\entree{"dst:"}{the destination of an operation}
+\entree{"init:"}{the initial value for an iterator}
+\entree{"cmp:"}{a comparison function, {\it e.g.} "Stdlib.compare"}
+\entree{"mode:"}{an operation mode or a flag list}
+\end{tableau}
+
+All these are only suggestions, but keep in mind that the
+choice of labels is essential for readability. Bizarre choices will
+make the program harder to maintain.
+
+In the ideal, the right function name with right labels should be
+enough to understand the function's meaning. Since one can get this
+information with OCamlBrowser or the "ocaml" toplevel, the documentation
+is only used when a more detailed specification is needed.
+
+\begin{caml_eval}
+#label false;;
+\end{caml_eval}
--- /dev/null
+\chapter{The module system} \label{c:moduleexamples}
+%HEVEA\cutname{moduleexamples.html}
+
+This chapter introduces the module system of OCaml.
+
+\section{s:module:structures}{Structures}
+
+A primary motivation for modules is to package together related
+definitions (such as the definitions of a data type and associated
+operations over that type) and enforce a consistent naming scheme for
+these definitions. This avoids running out of names or accidentally
+confusing names. Such a package is called a {\em structure} and
+is introduced by the "struct"\ldots"end" construct, which contains an
+arbitrary sequence of definitions. The structure is usually given a
+name with the "module" binding. Here is for instance a structure
+packaging together a type of priority queues and their operations:
+\begin{caml_example}{toplevel}
+module PrioQueue =
+ struct
+ type priority = int
+ type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue
+ let empty = Empty
+ let rec insert queue prio elt =
+ match queue with
+ Empty -> Node(prio, elt, Empty, Empty)
+ | Node(p, e, left, right) ->
+ if prio <= p
+ then Node(prio, elt, insert right p e, left)
+ else Node(p, e, insert right prio elt, left)
+ exception Queue_is_empty
+ let rec remove_top = function
+ Empty -> raise Queue_is_empty
+ | Node(prio, elt, left, Empty) -> left
+ | Node(prio, elt, Empty, right) -> right
+ | Node(prio, elt, (Node(lprio, lelt, _, _) as left),
+ (Node(rprio, relt, _, _) as right)) ->
+ if lprio <= rprio
+ then Node(lprio, lelt, remove_top left, right)
+ else Node(rprio, relt, left, remove_top right)
+ let extract = function
+ Empty -> raise Queue_is_empty
+ | Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue)
+ end;;
+\end{caml_example}
+Outside the structure, its components can be referred to using the
+``dot notation'', that is, identifiers qualified by a structure name.
+For instance, "PrioQueue.insert" is the function "insert" defined
+inside the structure "PrioQueue" and "PrioQueue.queue" is the type
+"queue" defined in "PrioQueue".
+\begin{caml_example}{toplevel}
+PrioQueue.insert PrioQueue.empty 1 "hello";;
+\end{caml_example}
+
+Another possibility is to open the module, which brings all
+identifiers defined inside the module in the scope of the current
+structure.
+
+\begin{caml_example}{toplevel}
+open PrioQueue;;
+insert empty 1 "hello";;
+\end{caml_example}
+
+Opening a module enables lighter access to its components, at the
+cost of making it harder to identify in which module a identifier
+has been defined. In particular, opened modules can shadow
+identifiers present in the current scope, potentially leading
+to confusing errors:
+
+\begin{caml_example}{toplevel}
+let empty = []
+open PrioQueue;;
+let x = 1 :: empty [@@expect error];;
+\end{caml_example}
+
+
+A partial solution to this conundrum is to open modules locally,
+making the components of the module available only in the
+concerned expression. This can also make the code both easier to read
+(since the open statement is closer to where it is used) and easier to refactor
+(since the code fragment is more self-contained).
+Two constructions are available for this purpose:
+\begin{caml_example}{toplevel}
+let open PrioQueue in
+insert empty 1 "hello";;
+\end{caml_example}
+and
+\begin{caml_example}{toplevel}
+PrioQueue.(insert empty 1 "hello");;
+\end{caml_example}
+In the second form, when the body of a local open is itself delimited
+by parentheses, braces or bracket, the parentheses of the local open
+can be omitted. For instance,
+\begin{caml_example}{toplevel}
+PrioQueue.[empty] = PrioQueue.([empty]);;
+PrioQueue.[|empty|] = PrioQueue.([|empty|]);;
+PrioQueue.{ contents = empty } = PrioQueue.({ contents = empty });;
+\end{caml_example}
+becomes
+\begin{caml_example}{toplevel}
+PrioQueue.[insert empty 1 "hello"];;
+\end{caml_example}
+This second form also works for patterns:
+\begin{caml_example}{toplevel}
+let at_most_one_element x = match x with
+| PrioQueue.( Empty| Node (_,_, Empty,Empty) ) -> true
+| _ -> false ;;
+\end{caml_example}
+
+It is also possible to copy the components of a module inside
+another module by using an "include" statement. This can be
+particularly useful to extend existing modules. As an illustration,
+we could add functions that returns an optional value rather than
+an exception when the priority queue is empty.
+\begin{caml_example}{toplevel}
+module PrioQueueOpt =
+struct
+ include PrioQueue
+
+ let remove_top_opt x =
+ try Some(remove_top x) with Queue_is_empty -> None
+
+ let extract_opt x =
+ try Some(extract x) with Queue_is_empty -> None
+end;;
+\end{caml_example}
+
+\section{s:signature}{Signatures}
+
+Signatures are interfaces for structures. A signature specifies
+which components of a structure are accessible from the outside, and
+with which type. It can be used to hide some components of a structure
+(e.g. local function definitions) or export some components with a
+restricted type. For instance, the signature below specifies the three
+priority queue operations "empty", "insert" and "extract", but not the
+auxiliary function "remove_top". Similarly, it makes the "queue" type
+abstract (by not providing its actual representation as a concrete type).
+\begin{caml_example}{toplevel}
+module type PRIOQUEUE =
+ sig
+ type priority = int (* still concrete *)
+ type 'a queue (* now abstract *)
+ val empty : 'a queue
+ val insert : 'a queue -> int -> 'a -> 'a queue
+ val extract : 'a queue -> int * 'a * 'a queue
+ exception Queue_is_empty
+ end;;
+\end{caml_example}
+Restricting the "PrioQueue" structure by this signature results in
+another view of the "PrioQueue" structure where the "remove_top"
+function is not accessible and the actual representation of priority
+queues is hidden:
+\begin{caml_example}{toplevel}
+module AbstractPrioQueue = (PrioQueue : PRIOQUEUE);;
+AbstractPrioQueue.remove_top [@@expect error];;
+AbstractPrioQueue.insert AbstractPrioQueue.empty 1 "hello";;
+\end{caml_example}
+The restriction can also be performed during the definition of the
+structure, as in
+\begin{verbatim}
+module PrioQueue = (struct ... end : PRIOQUEUE);;
+\end{verbatim}
+An alternate syntax is provided for the above:
+\begin{verbatim}
+module PrioQueue : PRIOQUEUE = struct ... end;;
+\end{verbatim}
+
+Like for modules, it is possible to include a signature to copy
+its components inside the current signature. For instance, we
+can extend the PRIOQUEUE signature with the "extract_opt"
+function:
+
+\begin{caml_example}{toplevel}
+module type PRIOQUEUE_WITH_OPT =
+ sig
+ include PRIOQUEUE
+ val extract_opt : 'a queue -> (int * 'a * 'a queue) option
+ end;;
+\end{caml_example}
+
+
+\section{s:functors}{Functors}
+
+Functors are ``functions'' from modules to modules. Functors let you create
+parameterized modules and then provide other modules as parameter(s) to get
+a specific implementation. For instance, a "Set" module implementing sets
+as sorted lists could be parameterized to work with any module that provides
+an element type and a comparison function "compare" (such as "OrderedString"):
+
+\begin{caml_example}{toplevel}
+type comparison = Less | Equal | Greater;;
+module type ORDERED_TYPE =
+ sig
+ type t
+ val compare: t -> t -> comparison
+ end;;
+module Set =
+ functor (Elt: ORDERED_TYPE) ->
+ struct
+ type element = Elt.t
+ type set = element list
+ let empty = []
+ let rec add x s =
+ match s with
+ [] -> [x]
+ | hd::tl ->
+ match Elt.compare x hd with
+ Equal -> s (* x is already in s *)
+ | Less -> x :: s (* x is smaller than all elements of s *)
+ | Greater -> hd :: add x tl
+ let rec member x s =
+ match s with
+ [] -> false
+ | hd::tl ->
+ match Elt.compare x hd with
+ Equal -> true (* x belongs to s *)
+ | Less -> false (* x is smaller than all elements of s *)
+ | Greater -> member x tl
+ end;;
+\end{caml_example}
+By applying the "Set" functor to a structure implementing an ordered
+type, we obtain set operations for this type:
+\begin{caml_example}{toplevel}
+module OrderedString =
+ struct
+ type t = string
+ let compare x y = if x = y then Equal else if x < y then Less else Greater
+ end;;
+module StringSet = Set(OrderedString);;
+StringSet.member "bar" (StringSet.add "foo" StringSet.empty);;
+\end{caml_example}
+
+\section{s:functors-and-abstraction}{Functors and type abstraction}
+
+As in the "PrioQueue" example, it would be good style to hide the
+actual implementation of the type "set", so that users of the
+structure will not rely on sets being lists, and we can switch later
+to another, more efficient representation of sets without breaking
+their code. This can be achieved by restricting "Set" by a suitable
+functor signature:
+\begin{caml_example}{toplevel}
+module type SETFUNCTOR =
+ functor (Elt: ORDERED_TYPE) ->
+ sig
+ type element = Elt.t (* concrete *)
+ type set (* abstract *)
+ val empty : set
+ val add : element -> set -> set
+ val member : element -> set -> bool
+ end;;
+module AbstractSet = (Set : SETFUNCTOR);;
+module AbstractStringSet = AbstractSet(OrderedString);;
+AbstractStringSet.add "gee" AbstractStringSet.empty;;
+\end{caml_example}
+
+In an attempt to write the type constraint above more elegantly,
+one may wish to name the signature of the structure
+returned by the functor, then use that signature in the constraint:
+\begin{caml_example}{toplevel}
+module type SET =
+ sig
+ type element
+ type set
+ val empty : set
+ val add : element -> set -> set
+ val member : element -> set -> bool
+ end;;
+module WrongSet = (Set : functor(Elt: ORDERED_TYPE) -> SET);;
+module WrongStringSet = WrongSet(OrderedString);;
+WrongStringSet.add "gee" WrongStringSet.empty [@@expect error];;
+\end{caml_example}
+The problem here is that "SET" specifies the type "element"
+abstractly, so that the type equality between "element" in the result
+of the functor and "t" in its argument is forgotten. Consequently,
+"WrongStringSet.element" is not the same type as "string", and the
+operations of "WrongStringSet" cannot be applied to strings.
+As demonstrated above, it is important that the type "element" in the
+signature "SET" be declared equal to "Elt.t"; unfortunately, this is
+impossible above since "SET" is defined in a context where "Elt" does
+not exist. To overcome this difficulty, OCaml provides a
+"with type" construct over signatures that allows enriching a signature
+with extra type equalities:
+\begin{caml_example}{toplevel}
+module AbstractSet2 =
+ (Set : functor(Elt: ORDERED_TYPE) -> (SET with type element = Elt.t));;
+\end{caml_example}
+
+As in the case of simple structures, an alternate syntax is provided
+for defining functors and restricting their result:
+\begin{verbatim}
+module AbstractSet2(Elt: ORDERED_TYPE) : (SET with type element = Elt.t) =
+ struct ... end;;
+\end{verbatim}
+
+Abstracting a type component in a functor result is a powerful
+technique that provides a high degree of type safety, as we now
+illustrate. Consider an ordering over character strings that is
+different from the standard ordering implemented in the
+"OrderedString" structure. For instance, we compare strings without
+distinguishing upper and lower case.
+\begin{caml_example}{toplevel}
+module NoCaseString =
+ struct
+ type t = string
+ let compare s1 s2 =
+ OrderedString.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
+ end;;
+module NoCaseStringSet = AbstractSet(NoCaseString);;
+NoCaseStringSet.add "FOO" AbstractStringSet.empty [@@expect error];;
+\end{caml_example}
+Note that the two types "AbstractStringSet.set" and
+"NoCaseStringSet.set" are not compatible, and values of these
+two types do not match. This is the correct behavior: even though both
+set types contain elements of the same type (strings), they are built
+upon different orderings of that type, and different invariants need
+to be maintained by the operations (being strictly increasing for the
+standard ordering and for the case-insensitive ordering). Applying
+operations from "AbstractStringSet" to values of type
+"NoCaseStringSet.set" could give incorrect results, or build
+lists that violate the invariants of "NoCaseStringSet".
+
+\section{s:separate-compilation}{Modules and separate compilation}
+
+All examples of modules so far have been given in the context of the
+interactive system. However, modules are most useful for large,
+batch-compiled programs. For these programs, it is a practical
+necessity to split the source into several files, called compilation
+units, that can be compiled separately, thus minimizing recompilation
+after changes.
+
+In OCaml, compilation units are special cases of structures
+and signatures, and the relationship between the units can be
+explained easily in terms of the module system. A compilation unit \var{A}
+comprises two files:
+\begin{itemize}
+\item the implementation file \var{A}".ml", which contains a sequence
+of definitions, analogous to the inside of a "struct"\ldots"end"
+construct;
+\item the interface file \var{A}".mli", which contains a sequence of
+specifications, analogous to the inside of a "sig"\ldots"end"
+construct.
+\end{itemize}
+These two files together define a structure named \var{A} as if
+the following definition was entered at top-level:
+\begin{alltt}
+module \var{A}: sig (* \hbox{contents of file} \var{A}.mli *) end
+ = struct (* \hbox{contents of file} \var{A}.ml *) end;;
+\end{alltt}
+The files that define the compilation units can be compiled separately
+using the "ocamlc -c" command (the "-c" option means ``compile only, do
+not try to link''); this produces compiled interface files (with
+extension ".cmi") and compiled object code files (with extension
+".cmo"). When all units have been compiled, their ".cmo" files are
+linked together using the "ocamlc" command. For instance, the following
+commands compile and link a program composed of two compilation units
+"Aux" and "Main":
+\begin{verbatim}
+$ ocamlc -c Aux.mli # produces aux.cmi
+$ ocamlc -c Aux.ml # produces aux.cmo
+$ ocamlc -c Main.mli # produces main.cmi
+$ ocamlc -c Main.ml # produces main.cmo
+$ ocamlc -o theprogram Aux.cmo Main.cmo
+\end{verbatim}
+The program behaves exactly as if the following phrases were entered
+at top-level:
+\begin{alltt}
+module Aux: sig (* \rminalltt{contents of} Aux.mli *) end
+ = struct (* \rminalltt{contents of} Aux.ml *) end;;
+module Main: sig (* \rminalltt{contents of} Main.mli *) end
+ = struct (* \rminalltt{contents of} Main.ml *) end;;
+\end{alltt}
+In particular, "Main" can refer to "Aux": the definitions and
+declarations contained in "Main.ml" and "Main.mli" can refer to
+definition in "Aux.ml", using the "Aux."\var{ident} notation, provided
+these definitions are exported in "Aux.mli".
+
+The order in which the ".cmo" files are given to "ocamlc" during the
+linking phase determines the order in which the module definitions
+occur. Hence, in the example above, "Aux" appears first and "Main" can
+refer to it, but "Aux" cannot refer to "Main".
+
+Note that only top-level structures can be mapped to
+separately-compiled files, but neither functors nor module types.
+However, all module-class objects can appear as components of a
+structure, so the solution is to put the functor or module type
+inside a structure, which can then be mapped to a file.
--- /dev/null
+\chapter{Objects in OCaml}
+\label{c:objectexamples}
+%HEVEA\cutname{objectexamples.html}
+{\it (Chapter written by Jérôme Vouillon, Didier Rémy and Jacques Garrigue)}
+
+\bigskip
+
+\noindent This chapter gives an overview of the object-oriented features of
+OCaml.
+
+Note that the relationship between object, class and type in OCaml is
+different than in mainstream object-oriented languages such as Java and
+C++, so you shouldn't assume that similar keywords mean the same thing.
+Object-oriented features are used much less frequently in OCaml than
+in those languages. OCaml has alternatives that are often more appropriate,
+such as modules and functors. Indeed, many OCaml programs do not use objects
+at all.
+
+\section{s:classes-and-objects}{Classes and objects}
+
+The class "point" below defines one instance variable "x" and two methods
+"get_x" and "move". The initial value of the instance variable is "0".
+The variable "x" is declared mutable, so the method "move" can change
+its value.
+\begin{caml_example}{toplevel}
+class point =
+ object
+ val mutable x = 0
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+
+We now create a new point "p", instance of the "point" class.
+\begin{caml_example}{toplevel}
+let p = new point;;
+\end{caml_example}
+Note that the type of "p" is "point". This is an abbreviation
+automatically defined by the class definition above. It stands for the
+object type "<get_x : int; move : int -> unit>", listing the methods
+of class "point" along with their types.
+
+We now invoke some methods of "p":
+\begin{caml_example}{toplevel}
+p#get_x;;
+p#move 3;;
+p#get_x;;
+\end{caml_example}
+
+The evaluation of the body of a class only takes place at object
+creation time. Therefore, in the following example, the instance
+variable "x" is initialized to different values for two different
+objects.
+\begin{caml_example}{toplevel}
+let x0 = ref 0;;
+class point =
+ object
+ val mutable x = incr x0; !x0
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+new point#get_x;;
+new point#get_x;;
+\end{caml_example}
+
+The class "point" can also be abstracted over the initial values of
+the "x" coordinate.
+\begin{caml_example}{toplevel}
+class point = fun x_init ->
+ object
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+Like in function definitions, the definition above can be
+abbreviated as:
+\begin{caml_example}{toplevel}
+class point x_init =
+ object
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+An instance of the class "point" is now a function that expects an
+initial parameter to create a point object:
+\begin{caml_example}{toplevel}
+new point;;
+let p = new point 7;;
+\end{caml_example}
+The parameter "x_init" is, of course, visible in the whole body of the
+definition, including methods. For instance, the method "get_offset"
+in the class below returns the position of the object relative to its
+initial position.
+\begin{caml_example}{toplevel}
+class point x_init =
+ object
+ val mutable x = x_init
+ method get_x = x
+ method get_offset = x - x_init
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+%Instance variables can only be used inside methods. For instance it would
+%not be possible to define
+%\begin{caml_example}{toplevel}
+%class point x_init =
+% object
+% val mutable x = x_init
+% val origin = x
+% method get_offset = x - origin
+% method move d = x <- x + d
+% end;;
+%\end{caml_example}
+Expressions can be evaluated and bound before defining the object body
+of the class. This is useful to enforce invariants. For instance,
+points can be automatically adjusted to the nearest point on a grid,
+as follows:
+\begin{caml_example}{toplevel}
+class adjusted_point x_init =
+ let origin = (x_init / 10) * 10 in
+ object
+ val mutable x = origin
+ method get_x = x
+ method get_offset = x - origin
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+(One could also raise an exception if the "x_init" coordinate is not
+on the grid.) In fact, the same effect could here be obtained by
+calling the definition of class "point" with the value of the
+"origin".
+\begin{caml_example}{toplevel}
+class adjusted_point x_init = point ((x_init / 10) * 10);;
+\end{caml_example}
+An alternate solution would have been to define the adjustment in
+a special allocation function:
+\begin{caml_example}{toplevel}
+let new_adjusted_point x_init = new point ((x_init / 10) * 10);;
+\end{caml_example}
+However, the former pattern is generally more appropriate, since
+the code for adjustment is part of the definition of the class and will be
+inherited.
+
+This ability provides class constructors as can be found in other
+languages. Several constructors can be defined this way to build objects of
+the same class but with different initialization patterns; an
+alternative is to use initializers, as described below in
+section~\ref{s:initializers}.
+
+\section{s:immediate-objects}{Immediate objects}
+
+There is another, more direct way to create an object: create it
+without going through a class.
+
+The syntax is exactly the same as for class expressions, but the
+result is a single object rather than a class. All the constructs
+described in the rest of this section also apply to immediate objects.
+\begin{caml_example}{toplevel}
+let p =
+ object
+ val mutable x = 0
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+p#get_x;;
+p#move 3;;
+p#get_x;;
+\end{caml_example}
+
+Unlike classes, which cannot be defined inside an expression,
+immediate objects can appear anywhere, using variables from their
+environment.
+\begin{caml_example}{toplevel}
+let minmax x y =
+ if x < y then object method min = x method max = y end
+ else object method min = y method max = x end;;
+\end{caml_example}
+
+Immediate objects have two weaknesses compared to classes: their types
+are not abbreviated, and you cannot inherit from them. But these two
+weaknesses can be advantages in some situations, as we will see
+in sections~\ref{s:reference-to-self} and~\ref{s:parameterized-classes}.
+
+\section{s:reference-to-self}{Reference to self}
+
+A method or an initializer can invoke methods on self (that is,
+the current object). For that, self must be explicitly bound, here to
+the variable "s" ("s" could be any identifier, even though we will
+often choose the name "self".)
+\begin{caml_example}{toplevel}
+class printable_point x_init =
+ object (s)
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ method print = print_int s#get_x
+ end;;
+let p = new printable_point 7;;
+p#print;;
+\end{caml_example}
+Dynamically, the variable "s" is bound at the invocation of a method. In
+particular, when the class "printable_point" is inherited, the variable
+"s" will be correctly bound to the object of the subclass.
+
+A common problem with self is that, as its type may be extended in
+subclasses, you cannot fix it in advance. Here is a simple example.
+\begin{caml_example}{toplevel}
+let ints = ref [];;
+class my_int =
+ object (self)
+ method n = 1
+ method register = ints := self :: !ints
+ end [@@expect error];;
+\end{caml_example}
+You can ignore the first two lines of the error message. What matters
+is the last one: putting self into an external reference would make it
+impossible to extend it through inheritance.
+We will see in section~\ref{s:using-coercions} a workaround to this
+problem.
+Note however that, since immediate objects are not extensible, the
+problem does not occur with them.
+\begin{caml_example}{toplevel}
+let my_int =
+ object (self)
+ method n = 1
+ method register = ints := self :: !ints
+ end;;
+\end{caml_example}
+
+\section{s:initializers}{Initializers}
+
+Let-bindings within class definitions are evaluated before the object
+is constructed. It is also possible to evaluate an expression
+immediately after the object has been built. Such code is written as
+an anonymous hidden method called an initializer. Therefore, it can
+access self and the instance variables.
+\begin{caml_example}{toplevel}
+class printable_point x_init =
+ let origin = (x_init / 10) * 10 in
+ object (self)
+ val mutable x = origin
+ method get_x = x
+ method move d = x <- x + d
+ method print = print_int self#get_x
+ initializer print_string "new point at "; self#print; print_newline ()
+ end;;
+let p = new printable_point 17;;
+\end{caml_example}
+Initializers cannot be overridden. On the contrary, all initializers are
+evaluated sequentially.
+Initializers are particularly useful to enforce invariants.
+Another example can be seen in section~\ref{s:extended-bank-accounts}.
+
+
+\section{s:virtual-methods}{Virtual methods}
+
+It is possible to declare a method without actually defining it, using
+the keyword "virtual". This method will be provided later in
+subclasses. A class containing virtual methods must be flagged
+"virtual", and cannot be instantiated (that is, no object of this class
+can be created). It still defines type abbreviations (treating virtual methods
+as other methods.)
+\begin{caml_example}{toplevel}
+class virtual abstract_point x_init =
+ object (self)
+ method virtual get_x : int
+ method get_offset = self#get_x - x_init
+ method virtual move : int -> unit
+ end;;
+class point x_init =
+ object
+ inherit abstract_point x_init
+ val mutable x = x_init
+ method get_x = x
+ method move d = x <- x + d
+ end;;
+\end{caml_example}
+
+Instance variables can also be declared as virtual, with the same effect
+as with methods.
+\begin{caml_example}{toplevel}
+class virtual abstract_point2 =
+ object
+ val mutable virtual x : int
+ method move d = x <- x + d
+ end;;
+class point2 x_init =
+ object
+ inherit abstract_point2
+ val mutable x = x_init
+ method get_offset = x - x_init
+ end;;
+\end{caml_example}
+
+\section{s:private-methods}{Private methods}
+
+Private methods are methods that do not appear in object interfaces.
+They can only be invoked from other methods of the same object.
+\begin{caml_example}{toplevel}
+class restricted_point x_init =
+ object (self)
+ val mutable x = x_init
+ method get_x = x
+ method private move d = x <- x + d
+ method bump = self#move 1
+ end;;
+let p = new restricted_point 0;;
+p#move 10 [@@expect error] ;;
+p#bump;;
+\end{caml_example}
+Note that this is not the same thing as private and protected methods
+in Java or C++, which can be called from other objects of the same
+class. This is a direct consequence of the independence between types
+and classes in OCaml: two unrelated classes may produce
+objects of the same type, and there is no way at the type level to
+ensure that an object comes from a specific class. However a possible
+encoding of friend methods is given in section~\ref{s:friends}.
+
+Private methods are inherited (they are by default visible in subclasses),
+unless they are hidden by signature matching, as described below.
+
+Private methods can be made public in a subclass.
+\begin{caml_example}{toplevel}
+class point_again x =
+ object (self)
+ inherit restricted_point x
+ method virtual move : _
+ end;;
+\end{caml_example}
+The annotation "virtual" here is only used to mention a method without
+providing its definition. Since we didn't add the "private"
+annotation, this makes the method public, keeping the original
+definition.
+
+An alternative definition is
+\begin{caml_example}{toplevel}
+class point_again x =
+ object (self : < move : _; ..> )
+ inherit restricted_point x
+ end;;
+\end{caml_example}
+The constraint on self's type is requiring a public "move" method, and
+this is sufficient to override "private".
+
+One could think that a private method should remain private in a subclass.
+However, since the method is visible in a subclass, it is always possible
+to pick its code and define a method of the same name that runs that
+code, so yet another (heavier) solution would be:
+\begin{caml_example}{toplevel}
+class point_again x =
+ object
+ inherit restricted_point x as super
+ method move = super#move
+ end;;
+\end{caml_example}
+
+Of course, private methods can also be virtual. Then, the keywords must
+appear in this order "method private virtual".
+
+\section{s:class-interfaces}{Class interfaces}
+
+
+%XXX Differentiate class type and class interface ?
+
+Class interfaces are inferred from class definitions. They may also
+be defined directly and used to restrict the type of a class. Like class
+declarations, they also define a new type abbreviation.
+\begin{caml_example}{toplevel}
+class type restricted_point_type =
+ object
+ method get_x : int
+ method bump : unit
+end;;
+fun (x : restricted_point_type) -> x;;
+\end{caml_example}
+In addition to program documentation, class interfaces can be used to
+constrain the type of a class. Both concrete instance variables and concrete
+private methods can be hidden by a class type constraint. Public
+methods and virtual members, however, cannot.
+\begin{caml_example}{toplevel}
+class restricted_point' x = (restricted_point x : restricted_point_type);;
+\end{caml_example}
+Or, equivalently:
+\begin{caml_example}{toplevel}
+class restricted_point' = (restricted_point : int -> restricted_point_type);;
+\end{caml_example}
+The interface of a class can also be specified in a module
+signature, and used to restrict the inferred signature of a module.
+\begin{caml_example}{toplevel}
+module type POINT = sig
+ class restricted_point' : int ->
+ object
+ method get_x : int
+ method bump : unit
+ end
+end;;
+module Point : POINT = struct
+ class restricted_point' = restricted_point
+end;;
+\end{caml_example}
+
+\section{s:inheritance}{Inheritance}
+
+We illustrate inheritance by defining a class of colored points that
+inherits from the class of points. This class has all instance
+variables and all methods of class "point", plus a new instance
+variable "c" and a new method "color".
+\begin{caml_example}{toplevel}
+class colored_point x (c : string) =
+ object
+ inherit point x
+ val c = c
+ method color = c
+ end;;
+let p' = new colored_point 5 "red";;
+p'#get_x, p'#color;;
+\end{caml_example}
+A point and a colored point have incompatible types, since a point has
+no method "color". However, the function "get_x" below is a generic
+function applying method "get_x" to any object "p" that has this
+method (and possibly some others, which are represented by an ellipsis
+in the type). Thus, it applies to both points and colored points.
+\begin{caml_example}{toplevel}
+let get_succ_x p = p#get_x + 1;;
+get_succ_x p + get_succ_x p';;
+\end{caml_example}
+Methods need not be declared previously, as shown by the example:
+\begin{caml_example}{toplevel}
+let set_x p = p#set_x;;
+let incr p = set_x p (get_succ_x p);;
+\end{caml_example}
+
+\section{s:multiple-inheritance}{Multiple inheritance}
+
+Multiple inheritance is allowed. Only the last definition of a method
+is kept: the redefinition in a subclass of a method that was visible in
+the parent class overrides the definition in the parent class.
+Previous definitions of a method can be reused by binding the related
+ancestor. Below, "super" is bound to the ancestor "printable_point".
+The name "super" is a pseudo value identifier that can only be used to
+invoke a super-class method, as in "super#print".
+\begin{caml_example}{toplevel}
+class printable_colored_point y c =
+ object (self)
+ val c = c
+ method color = c
+ inherit printable_point y as super
+ method! print =
+ print_string "(";
+ super#print;
+ print_string ", ";
+ print_string (self#color);
+ print_string ")"
+ end;;
+let p' = new printable_colored_point 17 "red";;
+p'#print;;
+\end{caml_example}
+A private method that has been hidden in the parent class is no longer
+visible, and is thus not overridden. Since initializers are treated as
+private methods, all initializers along the class hierarchy are evaluated,
+in the order they are introduced.
+
+Note that for clarity's sake, the method "print" is explicitly marked as
+overriding another definition by annotating the "method" keyword with
+an exclamation mark "!". If the method "print" were not overriding the
+"print" method of "printable_point", the compiler would raise an error:
+\begin{caml_example}{toplevel}[error]
+ object
+ method! m = ()
+ end;;
+\end{caml_example}
+
+This explicit overriding annotation also works
+for "val" and "inherit":
+\begin{caml_example}{toplevel}
+class another_printable_colored_point y c c' =
+ object (self)
+ inherit printable_point y
+ inherit! printable_colored_point y c
+ val! c = c'
+ end;;
+\end{caml_example}
+
+\section{s:parameterized-classes}{Parameterized classes}
+
+Reference cells can be implemented as objects.
+The naive definition fails to typecheck:
+\begin{caml_example}{toplevel}[error]
+class oref x_init =
+ object
+ val mutable x = x_init
+ method get = x
+ method set y = x <- y
+ end;;
+\end{caml_example}
+The reason is that at least one of the methods has a polymorphic type
+(here, the type of the value stored in the reference cell), thus
+either the class should be parametric, or the method type should be
+constrained to a monomorphic type. A monomorphic instance of the class could
+be defined by:
+\begin{caml_example}{toplevel}
+class oref (x_init:int) =
+ object
+ val mutable x = x_init
+ method get = x
+ method set y = x <- y
+ end;;
+\end{caml_example}
+Note that since immediate objects do not define a class type, they have
+no such restriction.
+\begin{caml_example}{toplevel}
+let new_oref x_init =
+ object
+ val mutable x = x_init
+ method get = x
+ method set y = x <- y
+ end;;
+\end{caml_example}
+On the other hand, a class for polymorphic references must explicitly
+list the type parameters in its declaration. Class type parameters are
+listed between "[" and "]". The type parameters must also be
+bound somewhere in the class body by a type constraint.
+\begin{caml_example}{toplevel}
+class ['a] oref x_init =
+ object
+ val mutable x = (x_init : 'a)
+ method get = x
+ method set y = x <- y
+ end;;
+let r = new oref 1 in r#set 2; (r#get);;
+\end{caml_example}
+The type parameter in the declaration may actually be constrained in the
+body of the class definition. In the class type, the actual value of
+the type parameter is displayed in the "constraint" clause.
+\begin{caml_example}{toplevel}
+class ['a] oref_succ (x_init:'a) =
+ object
+ val mutable x = x_init + 1
+ method get = x
+ method set y = x <- y
+ end;;
+\end{caml_example}
+Let us consider a more complex example: define a circle, whose center
+may be any kind of point. We put an additional type
+constraint in method "move", since no free variables must remain
+unaccounted for by the class type parameters.
+\begin{caml_example}{toplevel}
+class ['a] circle (c : 'a) =
+ object
+ val mutable center = c
+ method center = center
+ method set_center c = center <- c
+ method move = (center#move : int -> unit)
+ end;;
+\end{caml_example}
+An alternate definition of "circle", using a "constraint" clause in
+the class definition, is shown below. The type "#point" used below in
+the "constraint" clause is an abbreviation produced by the definition
+of class "point". This abbreviation unifies with the type of any
+object belonging to a subclass of class "point". It actually expands to
+"< get_x : int; move : int -> unit; .. >". This leads to the following
+alternate definition of "circle", which has slightly stronger
+constraints on its argument, as we now expect "center" to have a
+method "get_x".
+\begin{caml_example}{toplevel}
+class ['a] circle (c : 'a) =
+ object
+ constraint 'a = #point
+ val mutable center = c
+ method center = center
+ method set_center c = center <- c
+ method move = center#move
+ end;;
+\end{caml_example}
+The class "colored_circle" is a specialized version of class
+"circle" that requires the type of the center to unify with
+"#colored_point", and adds a method "color". Note that when specializing a
+parameterized class, the instance of type parameter must always be
+explicitly given. It is again written between "[" and "]".
+\begin{caml_example}{toplevel}
+class ['a] colored_circle c =
+ object
+ constraint 'a = #colored_point
+ inherit ['a] circle c
+ method color = center#color
+ end;;
+\end{caml_example}
+
+\section{s:polymorphic-methods}{Polymorphic methods}
+
+While parameterized classes may be polymorphic in their contents, they
+are not enough to allow polymorphism of method use.
+
+A classical example is defining an iterator.
+\begin{caml_example}{toplevel}
+List.fold_left;;
+class ['a] intlist (l : int list) =
+ object
+ method empty = (l = [])
+ method fold f (accu : 'a) = List.fold_left f accu l
+ end;;
+\end{caml_example}
+At first look, we seem to have a polymorphic iterator, however this
+does not work in practice.
+\begin{caml_example}{toplevel}
+let l = new intlist [1; 2; 3];;
+l#fold (fun x y -> x+y) 0;;
+l;;
+l#fold (fun s x -> s ^ Int.to_string x ^ " ") "" [@@expect error];;
+\end{caml_example}
+Our iterator works, as shows its first use for summation. However,
+since objects themselves are not polymorphic (only their constructors
+are), using the "fold" method fixes its type for this individual object.
+Our next attempt to use it as a string iterator fails.
+
+The problem here is that quantification was wrongly located: it is
+not the class we want to be polymorphic, but the "fold" method.
+This can be achieved by giving an explicitly polymorphic type in the
+method definition.
+\begin{caml_example}{toplevel}
+class intlist (l : int list) =
+ object
+ method empty = (l = [])
+ method fold : 'a. ('a -> int -> 'a) -> 'a -> 'a =
+ fun f accu -> List.fold_left f accu l
+ end;;
+let l = new intlist [1; 2; 3];;
+l#fold (fun x y -> x+y) 0;;
+l#fold (fun s x -> s ^ Int.to_string x ^ " ") "";;
+\end{caml_example}
+As you can see in the class type shown by the compiler, while
+polymorphic method types must be fully explicit in class definitions
+(appearing immediately after the method name), quantified type
+variables can be left implicit in class descriptions. Why require types
+to be explicit? The problem is that "(int -> int -> int) -> int ->
+int" would also be a valid type for "fold", and it happens to be
+incompatible with the polymorphic type we gave (automatic
+instantiation only works for toplevel types variables, not for inner
+quantifiers, where it becomes an undecidable problem.) So the compiler
+cannot choose between those two types, and must be helped.
+
+However, the type can be completely omitted in the class definition if
+it is already known, through inheritance or type constraints on self.
+Here is an example of method overriding.
+\begin{caml_example*}{toplevel}
+class intlist_rev l =
+ object
+ inherit intlist l
+ method! fold f accu = List.fold_left f accu (List.rev l)
+ end;;
+\end{caml_example*}
+The following idiom separates description and definition.
+\begin{caml_example*}{toplevel}
+class type ['a] iterator =
+ object method fold : ('b -> 'a -> 'b) -> 'b -> 'b end;;
+class intlist' l =
+ object (self : int #iterator)
+ method empty = (l = [])
+ method fold f accu = List.fold_left f accu l
+ end;;
+\end{caml_example*}
+Note here the "(self : int #iterator)" idiom, which ensures that this
+object implements the interface "iterator".
+
+Polymorphic methods are called in exactly the same way as normal
+methods, but you should be aware of some limitations of type
+inference. Namely, a polymorphic method can only be called if its
+type is known at the call site. Otherwise, the method will be assumed
+to be monomorphic, and given an incompatible type.
+\begin{caml_example}{toplevel}
+let sum lst = lst#fold (fun x y -> x+y) 0;;
+sum l [@@expect error];;
+\end{caml_example}
+The workaround is easy: you should put a type constraint on the
+parameter.
+\begin{caml_example}{toplevel}
+let sum (lst : _ #iterator) = lst#fold (fun x y -> x+y) 0;;
+\end{caml_example}
+Of course the constraint may also be an explicit method type.
+Only occurrences of quantified variables are required.
+\begin{caml_example}{toplevel}
+let sum lst =
+ (lst : < fold : 'a. ('a -> _ -> 'a) -> 'a -> 'a; .. >)#fold (+) 0;;
+\end{caml_example}
+
+Another use of polymorphic methods is to allow some form of implicit
+subtyping in method arguments. We have already seen in
+section~\ref{s:inheritance} how some functions may be polymorphic in the
+class of their argument. This can be extended to methods.
+\begin{caml_example}{toplevel}
+class type point0 = object method get_x : int end;;
+class distance_point x =
+ object
+ inherit point x
+ method distance : 'a. (#point0 as 'a) -> int =
+ fun other -> abs (other#get_x - x)
+ end;;
+let p = new distance_point 3 in
+(p#distance (new point 8), p#distance (new colored_point 1 "blue"));;
+\end{caml_example}
+Note here the special syntax "(#point0 as 'a)" we have to use to
+quantify the extensible part of "#point0". As for the variable binder,
+it can be omitted in class specifications. If you want polymorphism
+inside object field it must be quantified independently.
+\begin{caml_example}{toplevel}
+class multi_poly =
+ object
+ method m1 : 'a. (< n1 : 'b. 'b -> 'b; .. > as 'a) -> _ =
+ fun o -> o#n1 true, o#n1 "hello"
+ method m2 : 'a 'b. (< n2 : 'b -> bool; .. > as 'a) -> 'b -> _ =
+ fun o x -> o#n2 x
+ end;;
+\end{caml_example}
+In method "m1", "o" must be an object with at least a method "n1",
+itself polymorphic. In method "m2", the argument of "n2" and "x" must
+have the same type, which is quantified at the same level as "'a".
+
+\section{s:using-coercions}{Using coercions}
+
+Subtyping is never implicit. There are, however, two ways to perform
+subtyping. The most general construction is fully explicit: both the
+domain and the codomain of the type coercion must be given.
+
+We have seen that points and colored points have incompatible types.
+For instance, they cannot be mixed in the same list. However, a
+colored point can be coerced to a point, hiding its "color" method:
+\begin{caml_example}{toplevel}
+let colored_point_to_point cp = (cp : colored_point :> point);;
+let p = new point 3 and q = new colored_point 4 "blue";;
+let l = [p; (colored_point_to_point q)];;
+\end{caml_example}
+An object of type "t" can be seen as an object of type "t'"
+only if "t" is a subtype of "t'". For instance, a point cannot be
+seen as a colored point.
+\begin{caml_example}{toplevel}[error]
+(p : point :> colored_point);;
+\end{caml_example}
+Indeed, narrowing coercions without runtime checks would be unsafe.
+Runtime type checks might raise exceptions, and they would require
+the presence of type information at runtime, which is not the case in
+the OCaml system.
+For these reasons, there is no such operation available in the language.
+
+Be aware that subtyping and inheritance are not related. Inheritance is a
+syntactic relation between classes while subtyping is a semantic relation
+between types. For instance, the class of colored points could have been
+defined directly, without inheriting from the class of points; the type of
+colored points would remain unchanged and thus still be a subtype of
+points.
+% Conversely, the class "int_comparable" inherits from class
+%"comparable", but type "int_comparable" is not a subtype of "comparable".
+%\begin{caml_example}{toplevel}
+%function x -> (x : int_comparable :> comparable);;
+%\end{caml_example}
+
+The domain of a coercion can often be omitted. For instance, one can
+define:
+\begin{caml_example}{toplevel}
+let to_point cp = (cp :> point);;
+\end{caml_example}
+In this case, the function "colored_point_to_point" is an instance of the
+function "to_point". This is not always true, however. The fully
+explicit coercion is more precise and is sometimes unavoidable.
+Consider, for example, the following class:
+\begin{caml_example}{toplevel}
+class c0 = object method m = {< >} method n = 0 end;;
+\end{caml_example}
+The object type "c0" is an abbreviation for "<m : 'a; n : int> as 'a".
+Consider now the type declaration:
+\begin{caml_example}{toplevel}
+class type c1 = object method m : c1 end;;
+\end{caml_example}
+The object type "c1" is an abbreviation for the type "<m : 'a> as 'a".
+The coercion from an object of type "c0" to an object of type "c1" is
+correct:
+\begin{caml_example}{toplevel}
+fun (x:c0) -> (x : c0 :> c1);;
+\end{caml_example}
+%%% FIXME come up with a better example.
+% However, the domain of the coercion cannot be omitted here:
+% \begin{caml_example}{toplevel}
+% fun (x:c0) -> (x :> c1);;
+% \end{caml_example}
+However, the domain of the coercion cannot always be omitted.
+In that case, the solution is to use the explicit form.
+%
+Sometimes, a change in the class-type definition can also solve the problem
+\begin{caml_example}{toplevel}
+class type c2 = object ('a) method m : 'a end;;
+fun (x:c0) -> (x :> c2);;
+\end{caml_example}
+While class types "c1" and "c2" are different, both object types
+"c1" and "c2" expand to the same object type (same method names and types).
+Yet, when the domain of a coercion is left implicit and its co-domain
+is an abbreviation of a known class type, then the class type, rather
+than the object type, is used to derive the coercion function. This
+allows leaving the domain implicit in most cases when coercing form a
+subclass to its superclass.
+%
+The type of a coercion can always be seen as below:
+\begin{caml_example}{toplevel}
+let to_c1 x = (x :> c1);;
+let to_c2 x = (x :> c2);;
+\end{caml_example}
+Note the difference between these two coercions: in the case of "to_c2",
+the type
+"#c2 = < m : 'a; .. > as 'a" is polymorphically recursive (according
+to the explicit recursion in the class type of "c2"); hence the
+success of applying this coercion to an object of class "c0".
+On the other hand, in the first case, "c1" was only expanded and
+unrolled twice to obtain "< m : < m : c1; .. >; .. >" (remember "#c1 =
+< m : c1; .. >"), without introducing recursion.
+You may also note that the type of "to_c2" is "#c2 -> c2" while
+the type of "to_c1" is more general than "#c1 -> c1". This is not always true,
+since there are class types for which some instances of "#c" are not subtypes
+of "c", as explained in section~\ref{s:binary-methods}. Yet, for
+parameterless classes the coercion "(_ :> c)" is always more general than
+"(_ : #c :> c)".
+%If a class type exposes the type of self through one of its parameters, this
+%is no longer true. Here is a counter-example.
+%\begin{caml_example}{toplevel}
+%class type ['a] c = object ('a) method m : 'a end;;
+%let to_c x = (x :> _ c);;
+%\end{caml_example}
+
+
+A common problem may occur when one tries to define a coercion to a
+class "c" while defining class "c". The problem is due to the type
+abbreviation not being completely defined yet, and so its subtypes are not
+clearly known. Then, a coercion "(_ :> c)" or "(_ : #c :> c)" is taken to be
+the identity function, as in
+\begin{caml_example}{toplevel}
+function x -> (x :> 'a);;
+\end{caml_example}
+As a consequence, if the coercion is applied to "self", as in the
+following example, the type of "self" is unified with the closed type
+"c" (a closed object type is an object type without ellipsis). This
+would constrain the type of self be closed and is thus rejected.
+Indeed, the type of self cannot be closed: this would prevent any
+further extension of the class. Therefore, a type error is generated
+when the unification of this type with another type would result in a
+closed object type.
+\begin{caml_example}{toplevel}[error]
+class c = object method m = 1 end
+and d = object (self)
+ inherit c
+ method n = 2
+ method as_c = (self :> c)
+end;;
+\end{caml_example}
+However, the most common instance of this problem, coercing self to
+its current class, is detected as a special case by the type checker,
+and properly typed.
+\begin{caml_example}{toplevel}
+class c = object (self) method m = (self :> c) end;;
+\end{caml_example}
+This allows the following idiom, keeping a list of all objects
+belonging to a class or its subclasses:
+\begin{caml_example}{toplevel}
+let all_c = ref [];;
+class c (m : int) =
+ object (self)
+ method m = m
+ initializer all_c := (self :> c) :: !all_c
+ end;;
+\end{caml_example}
+This idiom can in turn be used to retrieve an object whose type has
+been weakened:
+\begin{caml_example}{toplevel}
+let rec lookup_obj obj = function [] -> raise Not_found
+ | obj' :: l ->
+ if (obj :> < >) = (obj' :> < >) then obj' else lookup_obj obj l ;;
+let lookup_c obj = lookup_obj obj !all_c;;
+\end{caml_example}
+The type "< m : int >" we see here is just the expansion of "c", due
+to the use of a reference; we have succeeded in getting back an object
+of type "c".
+
+\medskip
+The previous coercion problem can often be avoided by first
+defining the abbreviation, using a class type:
+\begin{caml_example}{toplevel}
+class type c' = object method m : int end;;
+class c : c' = object method m = 1 end
+and d = object (self)
+ inherit c
+ method n = 2
+ method as_c = (self :> c')
+end;;
+\end{caml_example}
+It is also possible to use a virtual class. Inheriting from this class
+simultaneously forces all methods of "c" to have the same
+type as the methods of "c'".
+\begin{caml_example}{toplevel}
+class virtual c' = object method virtual m : int end;;
+class c = object (self) inherit c' method m = 1 end;;
+\end{caml_example}
+One could think of defining the type abbreviation directly:
+\begin{caml_example*}{toplevel}
+type c' = <m : int>;;
+\end{caml_example*}
+However, the abbreviation "#c'" cannot be defined directly in a similar way.
+It can only be defined by a class or a class-type definition.
+This is because a "#"-abbreviation carries an implicit anonymous
+variable ".." that cannot be explicitly named.
+The closer you get to it is:
+\begin{caml_example*}{toplevel}
+type 'a c'_class = 'a constraint 'a = < m : int; .. >;;
+\end{caml_example*}
+with an extra type variable capturing the open object type.
+
+\section{s:functional-objects}{Functional objects}
+
+It is possible to write a version of class "point" without assignments
+on the instance variables. The override construct "{< ... >}" returns a copy of
+``self'' (that is, the current object), possibly changing the value of
+some instance variables.
+\begin{caml_example}{toplevel}
+class functional_point y =
+ object
+ val x = y
+ method get_x = x
+ method move d = {< x = x + d >}
+ method move_to x = {< x >}
+ end;;
+let p = new functional_point 7;;
+p#get_x;;
+(p#move 3)#get_x;;
+(p#move_to 15)#get_x;;
+p#get_x;;
+\end{caml_example}
+As with records, the form "{< x >}" is an elided version of
+"{< x = x >}" which avoids the repetition of the instance variable name.
+Note that the type abbreviation "functional_point" is recursive, which can
+be seen in the class type of "functional_point": the type of self is "'a"
+and "'a" appears inside the type of the method "move".
+
+The above definition of "functional_point" is not equivalent
+to the following:
+\begin{caml_example}{toplevel}
+class bad_functional_point y =
+ object
+ val x = y
+ method get_x = x
+ method move d = new bad_functional_point (x+d)
+ method move_to x = new bad_functional_point x
+ end;;
+\end{caml_example}
+While objects of either class will behave the same, objects of their
+subclasses will be different. In a subclass of "bad_functional_point",
+the method "move" will
+keep returning an object of the parent class. On the contrary, in a
+subclass of "functional_point", the method "move" will return an
+object of the subclass.
+
+Functional update is often used in conjunction with binary methods
+as illustrated in section~\ref{ss:string-as-class}.
+
+\section{s:cloning-objects}{Cloning objects}
+
+Objects can also be cloned, whether they are functional or imperative.
+The library function "Oo.copy" makes a shallow copy of an object. That is,
+it returns a new object that has the same methods and instance
+variables as its argument. The
+instance variables are copied but their contents are shared.
+Assigning a new value to an instance variable of the copy (using a method
+call) will not affect instance variables of the original, and conversely.
+A deeper assignment (for example if the instance variable is a reference cell)
+will of course affect both the original and the copy.
+
+The type of "Oo.copy" is the following:
+\begin{caml_example}{toplevel}
+Oo.copy;;
+\end{caml_example}
+The keyword "as" in that type binds the type variable "'a" to
+the object type "< .. >". Therefore, "Oo.copy" takes an object with
+any methods (represented by the ellipsis), and returns an object of
+the same type. The type of "Oo.copy" is different from type "< .. > ->
+< .. >" as each ellipsis represents a different set of methods.
+Ellipsis actually behaves as a type variable.
+\begin{caml_example}{toplevel}
+let p = new point 5;;
+let q = Oo.copy p;;
+q#move 7; (p#get_x, q#get_x);;
+\end{caml_example}
+In fact, "Oo.copy p" will behave as "p#copy" assuming that a public
+method "copy" with body "{< >}" has been defined in the class of "p".
+
+Objects can be compared using the generic comparison functions "=" and "<>".
+Two objects are equal if and only if they are physically equal. In
+particular, an object and its copy are not equal.
+\begin{caml_example}{toplevel}
+let q = Oo.copy p;;
+p = q, p = p;;
+\end{caml_example}
+Other generic comparisons such as ("<", "<=", ...) can also be used on
+objects. The
+relation "<" defines an unspecified but strict ordering on objects. The
+ordering relationship between two objects is fixed once for all after the
+two objects have been created and it is not affected by mutation of fields.
+
+Cloning and override have a non empty intersection.
+They are interchangeable when used within an object and without
+overriding any field:
+\begin{caml_example}{toplevel}
+class copy =
+ object
+ method copy = {< >}
+ end;;
+class copy =
+ object (self)
+ method copy = Oo.copy self
+ end;;
+\end{caml_example}
+Only the override can be used to actually override fields, and
+only the "Oo.copy" primitive can be used externally.
+
+Cloning can also be used to provide facilities for saving and
+restoring the state of objects.
+\begin{caml_example}{toplevel}
+class backup =
+ object (self : 'mytype)
+ val mutable copy = None
+ method save = copy <- Some {< copy = None >}
+ method restore = match copy with Some x -> x | None -> self
+ end;;
+\end{caml_example}
+The above definition will only backup one level.
+The backup facility can be added to any class by using multiple inheritance.
+\begin{caml_example}{toplevel}
+class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
+let rec get p n = if n = 0 then p # get else get (p # restore) (n-1);;
+let p = new backup_ref 0 in
+p # save; p # set 1; p # save; p # set 2;
+[get p 0; get p 1; get p 2; get p 3; get p 4];;
+\end{caml_example}
+We can define a variant of backup that retains all copies. (We also
+add a method "clear" to manually erase all copies.)
+\begin{caml_example}{toplevel}
+class backup =
+ object (self : 'mytype)
+ val mutable copy = None
+ method save = copy <- Some {< >}
+ method restore = match copy with Some x -> x | None -> self
+ method clear = copy <- None
+ end;;
+\end{caml_example}
+\begin{caml_example}{toplevel}
+class ['a] backup_ref x = object inherit ['a] oref x inherit backup end;;
+let p = new backup_ref 0 in
+p # save; p # set 1; p # save; p # set 2;
+[get p 0; get p 1; get p 2; get p 3; get p 4];;
+\end{caml_example}
+
+
+
+\section{s:recursive-classes}{Recursive classes}
+
+Recursive classes can be used to define objects whose types are
+mutually recursive.
+\begin{caml_example}{toplevel}
+class window =
+ object
+ val mutable top_widget = (None : widget option)
+ method top_widget = top_widget
+ end
+and widget (w : window) =
+ object
+ val window = w
+ method window = window
+ end;;
+\end{caml_example}
+Although their types are mutually recursive, the classes "widget" and
+"window" are themselves independent.
+
+
+\section{s:binary-methods}{Binary methods}
+
+A binary method is a method which takes an argument of the same type
+as self. The class "comparable" below is a template for classes with a
+binary method "leq" of type "'a -> bool" where the type variable "'a"
+is bound to the type of self. Therefore, "#comparable" expands to "<
+leq : 'a -> bool; .. > as 'a". We see here that the binder "as" also
+allows writing recursive types.
+\begin{caml_example}{toplevel}
+class virtual comparable =
+ object (_ : 'a)
+ method virtual leq : 'a -> bool
+ end;;
+\end{caml_example}
+We then define a subclass "money" of "comparable". The class "money"
+simply wraps floats as comparable objects. We will extend it below with
+more operations. We have to use a type constraint on the class parameter "x"
+because the primitive "<=" is a polymorphic function in
+OCaml. The "inherit" clause ensures that the type of objects
+of this class is an instance of "#comparable".
+\begin{caml_example}{toplevel}
+class money (x : float) =
+ object
+ inherit comparable
+ val repr = x
+ method value = repr
+ method leq p = repr <= p#value
+ end;;
+\end{caml_example}
+% not explained: mutability can be hidden
+Note that the type "money" is not a subtype of type
+"comparable", as the self type appears in contravariant position
+in the type of method "leq".
+Indeed, an object "m" of class "money" has a method "leq"
+that expects an argument of type "money" since it accesses
+its "value" method. Considering "m" of type "comparable" would allow a
+call to method "leq" on "m" with an argument that does not have a method
+"value", which would be an error.
+
+Similarly, the type "money2" below is not a subtype of type "money".
+\begin{caml_example}{toplevel}
+class money2 x =
+ object
+ inherit money x
+ method times k = {< repr = k *. repr >}
+ end;;
+\end{caml_example}
+It is however possible to define functions that manipulate objects of
+type either "money" or "money2": the function "min"
+will return the minimum of any two objects whose type unifies with
+"#comparable". The type of "min" is not the same as "#comparable ->
+#comparable -> #comparable", as the abbreviation "#comparable" hides a
+type variable (an ellipsis). Each occurrence of this abbreviation
+generates a new variable.
+\begin{caml_example}{toplevel}
+let min (x : #comparable) y =
+ if x#leq y then x else y;;
+\end{caml_example}
+This function can be applied to objects of type "money"
+or "money2".
+\begin{caml_example}{toplevel}
+(min (new money 1.3) (new money 3.1))#value;;
+(min (new money2 5.0) (new money2 3.14))#value;;
+\end{caml_example}
+
+More examples of binary methods can be found in
+sections~\ref{ss:string-as-class} and~\ref{ss:set-as-class}.
+
+Note the use of override for method "times".
+Writing "new money2 (k *. repr)" instead of "{< repr = k *. repr >}"
+would not behave well with inheritance: in a subclass "money3" of "money2"
+the "times" method would return an object of class "money2" but not of class
+"money3" as would be expected.
+
+The class "money" could naturally carry another binary method. Here is a
+direct definition:
+\begin{caml_example}{toplevel}
+class money x =
+ object (self : 'a)
+ val repr = x
+ method value = repr
+ method print = print_float repr
+ method times k = {< repr = k *. x >}
+ method leq (p : 'a) = repr <= p#value
+ method plus (p : 'a) = {< repr = x +. p#value >}
+ end;;
+\end{caml_example}
+
+\section{s:friends}{Friends}
+
+The above class "money" reveals a problem that often occurs with binary
+methods. In order to interact with other objects of the same class, the
+representation of "money" objects must be revealed, using a method such as
+"value". If we remove all binary methods (here "plus" and "leq"),
+the representation can easily be hidden inside objects by removing the method
+"value" as well. However, this is not possible as soon as some binary
+method requires access to the representation of objects of the same
+class (other than self).
+\begin{caml_example}{toplevel}
+class safe_money x =
+ object (self : 'a)
+ val repr = x
+ method print = print_float repr
+ method times k = {< repr = k *. x >}
+ end;;
+\end{caml_example}
+Here, the representation of the object is known only to a particular object.
+To make it available to other objects of the same class, we are forced to
+make it available to the whole world. However we can easily restrict the
+visibility of the representation using the module system.
+\begin{caml_example*}{toplevel}
+module type MONEY =
+ sig
+ type t
+ class c : float ->
+ object ('a)
+ val repr : t
+ method value : t
+ method print : unit
+ method times : float -> 'a
+ method leq : 'a -> bool
+ method plus : 'a -> 'a
+ end
+ end;;
+module Euro : MONEY =
+ struct
+ type t = float
+ class c x =
+ object (self : 'a)
+ val repr = x
+ method value = repr
+ method print = print_float repr
+ method times k = {< repr = k *. x >}
+ method leq (p : 'a) = repr <= p#value
+ method plus (p : 'a) = {< repr = x +. p#value >}
+ end
+ end;;
+\end{caml_example*}
+Another example of friend functions may be found in section~\ref{ss:set-as-class}.
+These examples occur when a group of objects (here
+objects of the same class) and functions should see each others internal
+representation, while their representation should be hidden from the
+outside. The solution is always to define all friends in the same module,
+give access to the representation and use a signature constraint to make the
+representation abstract outside the module.
+
+
+
+% LocalWords: typecheck monomorphic uncaptured Subtyping subtyping leq repr Oo
+% LocalWords: val sig bool Euro struct OCaml Vouillon Didier int ref incr init
+% LocalWords: succ mytype rec
+
--- /dev/null
+
+\chapter{Polymorphism and its limitations}%
+\label{c:polymorphism}
+%HEVEA\cutname{polymorphism.html}
+
+\bigskip
+
+\noindent This chapter covers more advanced questions related to the
+limitations of polymorphic functions and types. There are some situations
+in OCaml where the type inferred by the type checker may be less generic
+than expected. Such non-genericity can stem either from interactions
+between side-effect and typing or the difficulties of implicit polymorphic
+recursion and higher-rank polymorphism.
+
+This chapter details each of these situations and, if it is possible,
+how to recover genericity.
+
+\section{s:weak-polymorphism}{Weak polymorphism and mutation}
+\subsection{ss:weak-types}{Weakly polymorphic types}
+Maybe the most frequent examples of non-genericity derive from the
+interactions between polymorphic types and mutation. A simple example
+appears when typing the following expression
+\begin{caml_example}{toplevel}
+let store = ref None ;;
+\end{caml_example}
+Since the type of "None" is "'a option" and the function "ref" has type
+"'b -> 'b ref", a natural deduction for the type of "store" would be
+"'a option ref". However, the inferred type, "'_weak1 option ref", is
+different. Type variables whose name starts with a "_weak" prefix like
+"'_weak1" are weakly polymorphic type variables, sometimes shortened as
+weak type variables.
+A weak type variable is a placeholder for a single type that is currently
+unknown. Once the specific type "t" behind the placeholder type "'_weak1"
+is known, all occurrences of "'_weak1" will be replaced by "t". For instance,
+we can define another option reference and store an "int" inside:
+\begin{caml_example}{toplevel}
+let another_store = ref None ;;
+another_store := Some 0;
+another_store ;;
+\end{caml_example}
+After storing an "int" inside "another_store", the type of "another_store" has
+been updated from "'_weak2 option ref" to "int option ref".
+This distinction between weakly and generic polymorphic type variable protects
+OCaml programs from unsoundness and runtime errors. To understand from where
+unsoundness might come, consider this simple function which swaps a value "x"
+with the value stored inside a "store" reference, if there is such value:
+\begin{caml_example}{toplevel}
+let swap store x = match !store with
+ | None -> store := Some x; x
+ | Some y -> store := Some x; y;;
+\end{caml_example}
+We can apply this function to our store
+\begin{caml_example}{toplevel}
+let one = swap store 1
+let one_again = swap store 2
+let two = swap store 3;;
+\end{caml_example}
+After these three swaps the stored value is "3". Everything is fine up to
+now. We can then try to swap "3" with a more interesting value, for
+instance a function:
+\begin{caml_example}{toplevel}[error]
+let error = swap store (fun x -> x);;
+\end{caml_example}
+At this point, the type checker rightfully complains that it is not
+possible to swap an integer and a function, and that an "int" should always
+be traded for another "int". Furthermore, the type checker prevents us to
+change manually the type of the value stored by "store":
+\begin{caml_example}{toplevel}[error]
+store := Some (fun x -> x);;
+\end{caml_example}
+Indeed, looking at the type of store, we see that the weak type "'_weak1" has
+been replaced by the type "int"
+\begin{caml_example}{toplevel}
+store;;
+\end{caml_example}
+Therefore, after placing an "int" in "store", we cannot use it to store any
+value other than an "int". More generally, weak types protect the program from
+undue mutation of values with a polymorphic type.
+
+%todo: fix indentation in manual.pdf
+Moreover, weak types cannot appear in the signature of toplevel modules:
+types must be known at compilation time. Otherwise, different compilation
+units could replace the weak type with different and incompatible types.
+For this reason, compiling the following small piece of code
+\begin{verbatim}
+let option_ref = ref None
+\end{verbatim}
+yields a compilation error
+\begin{verbatim}
+Error: The type of this expression, '_weak1 option ref,
+ contains type variables that cannot be generalized
+\end{verbatim}
+To solve this error, it is enough to add an explicit type annotation to
+specify the type at declaration time:
+\begin{verbatim}
+let option_ref: int option ref = ref None
+\end{verbatim}
+This is in any case a good practice for such global mutable variables.
+Otherwise, they will pick out the type of first use. If there is a mistake
+at this point, this can result in confusing type errors when later, correct
+uses are flagged as errors.
+
+\subsection{ss:valuerestriction}{The value restriction}
+
+Identifying the exact context in which polymorphic types should be
+replaced by weak types in a modular way is a difficult question. Indeed
+the type system must handle the possibility that functions may hide persistent
+mutable states. For instance, the following function uses an internal reference
+to implement a delayed identity function
+\begin{caml_example}{toplevel}
+let make_fake_id () =
+ let store = ref None in
+ fun x -> swap store x ;;
+let fake_id = make_fake_id();;
+\end{caml_example}
+It would be unsound to apply this "fake_id" function to values with different
+types. The function "fake_id" is therefore rightfully assigned the type
+"'_weak3 -> '_weak3" rather than "'a -> 'a". At the same time, it ought to
+be possible to use a local mutable state without impacting the type of a
+function.
+%todo: add an example?
+
+To circumvent these dual difficulties, the type checker considers that any value
+returned by a function might rely on persistent mutable states behind the scene
+and should be given a weak type. This restriction on the type of mutable
+values and the results of function application is called the value restriction.
+Note that this value restriction is conservative: there are situations where the
+value restriction is too cautious and gives a weak type to a value that could be
+safely generalized to a polymorphic type:
+\begin{caml_example}{toplevel}
+let not_id = (fun x -> x) (fun x -> x);;
+\end{caml_example}
+Quite often, this happens when defining function using higher order function.
+To avoid this problem, a solution is to add an explicit argument to the
+function:
+\begin{caml_example}{toplevel}
+let id_again = fun x -> (fun x -> x) (fun x -> x) x;;
+\end{caml_example}
+With this argument, "id_again" is seen as a function definition by the type
+checker and can therefore be generalized. This kind of manipulation is called
+eta-expansion in lambda calculus and is sometimes referred under this name.
+
+\subsection{ss:relaxed-value-restriction}{The relaxed value restriction}
+
+There is another partial solution to the problem of unnecessary weak type,
+which is implemented directly within the type checker. Briefly, it is possible
+to prove that weak types that only appear as type parameters in covariant
+positions --also called positive positions-- can be safely generalized to
+polymorphic types. For instance, the type "'a list" is covariant in "'a":
+\begin{caml_example}{toplevel}
+ let f () = [];;
+ let empty = f ();;
+\end{caml_example}
+Remark that the type inferred for "empty" is "'a list" and not "'_weak5 list"
+that should have occurred with the value restriction since "f ()" is a
+function application.
+
+The value restriction combined with this generalization for covariant type
+parameters is called the relaxed value restriction.
+
+%question: is here the best place for describing variance?
+\subsection{ss:variance-and-value-restriction}{Variance and value restriction}
+Variance describes how type constructors behave with respect to subtyping.
+Consider for instance a pair of type "x" and "xy" with "x" a subtype of "xy",
+denoted "x :> xy":
+\begin{caml_example}{toplevel}
+ type x = [ `X ];;
+ type xy = [ `X | `Y ];;
+\end{caml_example}
+As "x" is a subtype of "xy", we can convert a value of type "x"
+to a value of type "xy":
+\begin{caml_example}{toplevel}
+ let x:x = `X;;
+ let x' = ( x :> xy);;
+\end{caml_example}
+Similarly, if we have a value of type "x list", we can convert it to a value
+of type "xy list", since we could convert each element one by one:
+\begin{caml_example}{toplevel}
+ let l:x list = [`X; `X];;
+ let l' = ( l :> xy list);;
+\end{caml_example}
+In other words, "x :> xy" implies that "x list :> xy list", therefore
+the type constructor "'a list" is covariant (it preserves subtyping)
+in its parameter "'a".
+
+Contrarily, if we have a function that can handle values of type "xy"
+\begin{caml_example}{toplevel}
+ let f: xy -> unit = function
+ | `X -> ()
+ | `Y -> ();;
+\end{caml_example}
+it can also handle values of type "x":
+\begin{caml_example}{toplevel}
+ let f' = (f :> x -> unit);;
+\end{caml_example}
+Note that we can rewrite the type of "f" and "f'" as
+\begin{caml_example}{toplevel}
+ type 'a proc = 'a -> unit
+ let f' = (f: xy proc :> x proc);;
+\end{caml_example}
+In this case, we have "x :> xy" implies "xy proc :> x proc". Notice
+that the second subtyping relation reverse the order of "x" and "xy":
+the type constructor "'a proc" is contravariant in its parameter "'a".
+More generally, the function type constructor "'a -> 'b" is covariant in
+its return type "'b" and contravariant in its argument type "'a".
+
+A type constructor can also be invariant in some of its type parameters,
+neither covariant nor contravariant. A typical example is a reference:
+\begin{caml_example}{toplevel}
+ let x: x ref = ref `X;;
+\end{caml_example}
+If we were able to coerce "x" to the type "xy ref" as a variable "xy",
+we could use "xy" to store the value "`Y" inside the reference and then use
+the "x" value to read this content as a value of type "x",
+which would break the type system.
+
+More generally, as soon as a type variable appears in a position describing
+mutable state it becomes invariant. As a corollary, covariant variables will
+never denote mutable locations and can be safely generalized.
+For a better description, interested readers can consult the original
+article by Jacques Garrigue on
+\url{http://www.math.nagoya-u.ac.jp/~garrigue/papers/morepoly-long.pdf}
+
+Together, the relaxed value restriction and type parameter covariance
+help to avoid eta-expansion in many situations.
+
+\subsection{ss:variance:abstract-data-types}{Abstract data types}
+Moreover, when the type definitions are exposed, the type checker
+is able to infer variance information on its own and one can benefit from
+the relaxed value restriction even unknowingly. However, this is not the case
+anymore when defining new abstract types. As an illustration, we can define a
+module type collection as:
+\begin{caml_example}{toplevel}
+module type COLLECTION = sig
+ type 'a t
+ val empty: unit -> 'a t
+end
+
+module Implementation = struct
+ type 'a t = 'a list
+ let empty ()= []
+end;;
+
+module List2: COLLECTION = Implementation;;
+\end{caml_example}
+
+In this situation, when coercing the module "List2" to the module type
+"COLLECTION", the type checker forgets that "'a List2.t" was covariant
+in "'a". Consequently, the relaxed value restriction does not apply anymore:
+
+\begin{caml_example}{toplevel}
+ List2.empty ();;
+\end{caml_example}
+
+To keep the relaxed value restriction, we need to declare the abstract type
+"'a COLLECTION.t" as covariant in "'a":
+\begin{caml_example}{toplevel}
+module type COLLECTION = sig
+ type +'a t
+ val empty: unit -> 'a t
+end
+
+module List2: COLLECTION = Implementation;;
+\end{caml_example}
+
+We then recover polymorphism:
+
+\begin{caml_example}{toplevel}
+ List2.empty ();;
+\end{caml_example}
+
+\section{s:polymorphic-recursion}{Polymorphic recursion}
+
+The second major class of non-genericity is directly related to the problem
+of type inference for polymorphic functions. In some circumstances, the type
+inferred by OCaml might be not general enough to allow the definition of
+some recursive functions, in particular for recursive function acting on
+non-regular algebraic data type.
+
+With a regular polymorphic algebraic data type, the type parameters of
+the type constructor are constant within the definition of the type. For
+instance, we can look at arbitrarily nested list defined as:
+\begin{caml_example}{toplevel}
+ type 'a regular_nested = List of 'a list | Nested of 'a regular_nested list
+ let l = Nested[ List [1]; Nested [List[2;3]]; Nested[Nested[]] ];;
+\end{caml_example}
+Note that the type constructor "regular_nested" always appears as
+"'a regular_nested" in the definition above, with the same parameter
+"'a". Equipped with this type, one can compute a maximal depth with
+a classic recursive function
+\begin{caml_example}{toplevel}
+ let rec maximal_depth = function
+ | List _ -> 1
+ | Nested [] -> 0
+ | Nested (a::q) -> 1 + max (maximal_depth a) (maximal_depth (Nested q));;
+\end{caml_example}
+
+Non-regular recursive algebraic data types correspond to polymorphic algebraic
+data types whose parameter types vary between the left and right side of
+the type definition. For instance, it might be interesting to define a datatype
+that ensures that all lists are nested at the same depth:
+\begin{caml_example}{toplevel}
+ type 'a nested = List of 'a list | Nested of 'a list nested;;
+\end{caml_example}
+Intuitively, a value of type "'a nested" is a list of list \dots of list of
+elements "a" with "k" nested list. We can then adapt the "maximal_depth"
+function defined on "regular_depth" into a "depth" function that computes this
+"k". As a first try, we may define
+\begin{caml_example}{toplevel}[error]
+let rec depth = function
+ | List _ -> 1
+ | Nested n -> 1 + depth n;;
+\end{caml_example}
+The type error here comes from the fact that during the definition of "depth",
+the type checker first assigns to "depth" the type "'a -> 'b ".
+When typing the pattern matching, "'a -> 'b" becomes "'a nested -> 'b", then
+"'a nested -> int" once the "List" branch is typed.
+However, when typing the application "depth n" in the "Nested" branch,
+the type checker encounters a problem: "depth n" is applied to
+"'a list nested", it must therefore have the type
+"'a list nested -> 'b". Unifying this constraint with the previous one
+leads to the impossible constraint "'a list nested = 'a nested".
+In other words, within its definition, the recursive function "depth" is
+applied to values of type "'a t" with different types "'a" due to the
+non-regularity of the type constructor "nested". This creates a problem because
+the type checker had introduced a new type variable "'a" only at the
+\emph{definition} of the function "depth" whereas, here, we need a
+different type variable for every \emph{application} of the function "depth".
+
+\subsection{ss:explicit-polymorphism}{Explicitly polymorphic annotations}
+The solution of this conundrum is to use an explicitly polymorphic type
+annotation for the type "'a":
+\begin{caml_example}{toplevel}
+let rec depth: 'a. 'a nested -> int = function
+ | List _ -> 1
+ | Nested n -> 1 + depth n;;
+depth ( Nested(List [ [7]; [8] ]) );;
+\end{caml_example}
+In the type of "depth", "'a.'a nested -> int", the type variable "'a"
+is universally quantified. In other words, "'a.'a nested -> int" reads as
+``for all type "'a", "depth" maps "'a nested" values to integers''.
+Whereas the standard type "'a nested -> int" can be interpreted
+as ``let be a type variable "'a", then "depth" maps "'a nested" values
+to integers''. There are two major differences with these two type
+expressions. First, the explicit polymorphic annotation indicates to the
+type checker that it needs to introduce a new type variable every times
+the function "depth" is applied. This solves our problem with the definition
+of the function "depth".
+
+Second, it also notifies the type checker that the type of the function should
+be polymorphic. Indeed, without explicit polymorphic type annotation, the
+following type annotation is perfectly valid
+\begin{caml_example}{toplevel}
+ let sum: 'a -> 'b -> 'c = fun x y -> x + y;;
+\end{caml_example}
+since "'a","'b" and "'c" denote type variables that may or may not be
+polymorphic. Whereas, it is an error to unify an explicitly polymorphic type
+with a non-polymorphic type:
+\begin{caml_example}{toplevel}[error]
+ let sum: 'a 'b 'c. 'a -> 'b -> 'c = fun x y -> x + y;;
+\end{caml_example}
+
+An important remark here is that it is not needed to explicit fully
+the type of "depth": it is sufficient to add annotations only for the
+universally quantified type variables:
+\begin{caml_example}{toplevel}
+let rec depth: 'a. 'a nested -> _ = function
+ | List _ -> 1
+ | Nested n -> 1 + depth n;;
+depth ( Nested(List [ [7]; [8] ]) );;
+\end{caml_example}
+
+%todo: add a paragraph on the interaction with locally abstract type
+
+\subsection{ss:recursive-poly-examples}{More examples}
+With explicit polymorphic annotations, it becomes possible to implement
+any recursive function that depends only on the structure of the nested
+lists and not on the type of the elements. For instance, a more complex
+example would be to compute the total number of elements of the nested
+lists:
+\begin{caml_example}{toplevel}
+ let len nested =
+ let map_and_sum f = List.fold_left (fun acc x -> acc + f x) 0 in
+ let rec len: 'a. ('a list -> int ) -> 'a nested -> int =
+ fun nested_len n ->
+ match n with
+ | List l -> nested_len l
+ | Nested n -> len (map_and_sum nested_len) n
+ in
+ len List.length nested;;
+len (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
+\end{caml_example}
+
+Similarly, it may be necessary to use more than one explicitly
+polymorphic type variables, like for computing the nested list of
+list lengths of the nested list:
+\begin{caml_example}{toplevel}
+let shape n =
+ let rec shape: 'a 'b. ('a nested -> int nested) ->
+ ('b list list -> 'a list) -> 'b nested -> int nested
+ = fun nest nested_shape ->
+ function
+ | List l -> raise
+ (Invalid_argument "shape requires nested_list of depth greater than 1")
+ | Nested (List l) -> nest @@ List (nested_shape l)
+ | Nested n ->
+ let nested_shape = List.map nested_shape in
+ let nest x = nest (Nested x) in
+ shape nest nested_shape n in
+ shape (fun n -> n ) (fun l -> List.map List.length l ) n;;
+
+shape (Nested(Nested(List [ [ [1;2]; [3] ]; [ []; [4]; [5;6;7]]; [[]] ])));;
+\end{caml_example}
+
+\section{s:higher-rank-poly}{Higher-rank polymorphic functions}
+
+Explicit polymorphic annotations are however not sufficient to cover all
+the cases where the inferred type of a function is less general than
+expected. A similar problem arises when using polymorphic functions as arguments
+of higher-order functions. For instance, we may want to compute the average
+depth or length of two nested lists:
+\begin{caml_example}{toplevel}
+ let average_depth x y = (depth x + depth y) / 2;;
+ let average_len x y = (len x + len y) / 2;;
+ let one = average_len (List [2]) (List [[]]);;
+\end{caml_example}
+It would be natural to factorize these two definitions as:
+\begin{caml_example}{toplevel}
+ let average f x y = (f x + f y) / 2;;
+\end{caml_example}
+However, the type of "average len" is less generic than the type of
+"average_len", since it requires the type of the first and second argument to
+be the same:
+\begin{caml_example}{toplevel}
+ average_len (List [2]) (List [[]]);;
+ average len (List [2]) (List [[]])[@@expect error];;
+\end{caml_example}
+
+As previously with polymorphic recursion, the problem stems from the fact that
+type variables are introduced only at the start of the "let" definitions. When
+we compute both "f x" and "f y", the type of "x" and "y" are unified together.
+To avoid this unification, we need to indicate to the type checker
+that f is polymorphic in its first argument. In some sense, we would want
+"average" to have type
+\begin{verbatim}
+val average: ('a. 'a nested -> int) -> 'a nested -> 'b nested -> int
+\end{verbatim}
+Note that this syntax is not valid within OCaml: "average" has an universally
+quantified type "'a" inside the type of one of its argument whereas for
+polymorphic recursion the universally quantified type was introduced before
+the rest of the type. This position of the universally quantified type means
+that "average" is a second-rank polymorphic function. This kind of higher-rank
+functions is not directly supported by OCaml: type inference for second-rank
+polymorphic function and beyond is undecidable; therefore using this kind of
+higher-rank functions requires to handle manually these universally quantified
+types.
+
+In OCaml, there are two ways to introduce this kind of explicit universally
+quantified types: universally quantified record fields,
+\begin{caml_example}{toplevel}
+ type 'a nested_reduction = { f:'elt. 'elt nested -> 'a };;
+ let boxed_len = { f = len };;
+\end{caml_example}
+and universally quantified object methods:
+\begin{caml_example}{toplevel}
+ let obj_len = object method f:'a. 'a nested -> 'b = len end;;
+\end{caml_example}
+To solve our problem, we can therefore use either the record solution:
+\begin{caml_example}{toplevel}
+ let average nsm x y = (nsm.f x + nsm.f y) / 2 ;;
+\end{caml_example}
+or the object one:
+\begin{caml_example}{toplevel}
+ let average (obj:<f:'a. 'a nested -> _ > ) x y = (obj#f x + obj#f y) / 2 ;;
+\end{caml_example}
--- /dev/null
+\chapter{Polymorphic variants} \label{c:poly-variant}
+%HEVEA\cutname{polyvariant.html}
+{\it (Chapter written by Jacques Garrigue)}
+
+Variants as presented in section~\ref{s:tut-recvariants} are a
+powerful tool to build data structures and algorithms. However they
+sometimes lack flexibility when used in modular programming. This is
+due to the fact that every constructor is assigned to a unique type
+when defined and used. Even if the same name appears in the definition
+of multiple types, the constructor itself belongs to only one type.
+Therefore, one cannot decide that a given constructor belongs to
+multiple types, or consider a value of some type to belong to some
+other type with more constructors.
+
+With polymorphic variants, this original assumption is removed. That
+is, a variant tag does not belong to any type in particular, the type
+system will just check that it is an admissible value according to its
+use. You need not define a type before using a variant tag. A variant
+type will be inferred independently for each of its uses.
+
+\section{s:polyvariant:basic-use}{Basic use}
+
+In programs, polymorphic variants work like usual ones. You just have
+to prefix their names with a backquote character "`".
+\begin{caml_example}{toplevel}
+[`On; `Off];;
+`Number 1;;
+let f = function `On -> 1 | `Off -> 0 | `Number n -> n;;
+List.map f [`On; `Off];;
+\end{caml_example}
+"[>`Off|`On] list" means that to match this list, you should at
+least be able to match "`Off" and "`On", without argument.
+"[<`On|`Off|`Number of int]" means that "f" may be applied to "`Off",
+"`On" (both without argument), or "`Number" $n$ where
+$n$ is an integer.
+The ">" and "<" inside the variant types show that they may still be
+refined, either by defining more tags or by allowing less. As such, they
+contain an implicit type variable. Because each of the variant types
+appears only once in the whole type, their implicit type variables are
+not shown.
+
+The above variant types were polymorphic, allowing further refinement.
+When writing type annotations, one will most often describe fixed
+variant types, that is types that cannot be refined. This is
+also the case for type abbreviations. Such types do not contain "<" or
+">", but just an enumeration of the tags and their associated types,
+just like in a normal datatype definition.
+\begin{caml_example}{toplevel}
+type 'a vlist = [`Nil | `Cons of 'a * 'a vlist];;
+let rec map f : 'a vlist -> 'b vlist = function
+ | `Nil -> `Nil
+ | `Cons(a, l) -> `Cons(f a, map f l)
+;;
+\end{caml_example}
+
+\section{s:polyvariant-advanced}{Advanced use}
+
+Type-checking polymorphic variants is a subtle thing, and some
+expressions may result in more complex type information.
+
+\begin{caml_example}{toplevel}
+let f = function `A -> `C | `B -> `D | x -> x;;
+f `E;;
+\end{caml_example}
+Here we are seeing two phenomena. First, since this matching is open
+(the last case catches any tag), we obtain the type "[> `A | `B]"
+rather than "[< `A | `B]" in a closed matching. Then, since "x" is
+returned as is, input and return types are identical. The notation "as
+'a" denotes such type sharing. If we apply "f" to yet another tag
+"`E", it gets added to the list.
+
+\begin{caml_example}{toplevel}
+let f1 = function `A x -> x = 1 | `B -> true | `C -> false
+let f2 = function `A x -> x = "a" | `B -> true ;;
+let f x = f1 x && f2 x;;
+\end{caml_example}
+Here "f1" and "f2" both accept the variant tags "`A" and "`B", but the
+argument of "`A" is "int" for "f1" and "string" for "f2". In "f"'s
+type "`C", only accepted by "f1", disappears, but both argument types
+appear for "`A" as "int & string". This means that if we
+pass the variant tag "`A" to "f", its argument should be {\em both}
+"int" and "string". Since there is no such value, "f" cannot be
+applied to "`A", and "`B" is the only accepted input.
+
+Even if a value has a fixed variant type, one can still give it a
+larger type through coercions. Coercions are normally written with
+both the source type and the destination type, but in simple cases the
+source type may be omitted.
+\begin{caml_example}{toplevel}
+type 'a wlist = [`Nil | `Cons of 'a * 'a wlist | `Snoc of 'a wlist * 'a];;
+let wlist_of_vlist l = (l : 'a vlist :> 'a wlist);;
+let open_vlist l = (l : 'a vlist :> [> 'a vlist]);;
+fun x -> (x :> [`A|`B|`C]);;
+\end{caml_example}
+
+You may also selectively coerce values through pattern matching.
+\begin{caml_example}{toplevel}
+let split_cases = function
+ | `Nil | `Cons _ as x -> `A x
+ | `Snoc _ as x -> `B x
+;;
+\end{caml_example}
+When an or-pattern composed of variant tags is wrapped inside an
+alias-pattern, the alias is given a type containing only the tags
+enumerated in the or-pattern. This allows for many useful idioms, like
+incremental definition of functions.
+
+\begin{caml_example}{toplevel}
+let num x = `Num x
+let eval1 eval (`Num x) = x
+let rec eval x = eval1 eval x ;;
+let plus x y = `Plus(x,y)
+let eval2 eval = function
+ | `Plus(x,y) -> eval x + eval y
+ | `Num _ as x -> eval1 eval x
+let rec eval x = eval2 eval x ;;
+\end{caml_example}
+
+To make this even more comfortable, you may use type definitions as
+abbreviations for or-patterns. That is, if you have defined "type
+myvariant = [`Tag1 of int | `Tag2 of bool]", then the pattern "#myvariant" is
+equivalent to writing "(`Tag1(_ : int) | `Tag2(_ : bool))".
+\begin{caml_eval}
+type myvariant = [`Tag1 of int | `Tag2 of bool];;
+\end{caml_eval}
+
+Such abbreviations may be used alone,
+\begin{caml_example}{toplevel}
+let f = function
+ | #myvariant -> "myvariant"
+ | `Tag3 -> "Tag3";;
+\end{caml_example}
+or combined with with aliases.
+\begin{caml_example}{toplevel}
+let g1 = function `Tag1 _ -> "Tag1" | `Tag2 _ -> "Tag2";;
+let g = function
+ | #myvariant as x -> g1 x
+ | `Tag3 -> "Tag3";;
+\end{caml_example}
+
+\section{s:polyvariant-weaknesses}{Weaknesses of polymorphic variants}
+
+After seeing the power of polymorphic variants, one may wonder why
+they were added to core language variants, rather than replacing them.
+
+The answer is twofold. One first aspect is that while being pretty
+efficient, the lack of static type information allows for less
+optimizations, and makes polymorphic variants slightly heavier than
+core language ones. However noticeable differences would only
+appear on huge data structures.
+
+More important is the fact that polymorphic variants, while being
+type-safe, result in a weaker type discipline. That is, core language
+variants do actually much more than ensuring type-safety, they also
+check that you use only declared constructors, that all constructors
+present in a data-structure are compatible, and they enforce typing
+constraints to their parameters.
+
+For this reason, you must be more careful about making types explicit
+when you use polymorphic variants. When you write a library, this is
+easy since you can describe exact types in interfaces, but for simple
+programs you are probably better off with core language variants.
+
+Beware also that some idioms make trivial errors very hard to find.
+For instance, the following code is probably wrong but the compiler
+has no way to see it.
+\begin{caml_example}{toplevel}
+type abc = [`A | `B | `C] ;;
+let f = function
+ | `As -> "A"
+ | #abc -> "other" ;;
+let f : abc -> string = f ;;
+\end{caml_example}
+You can avoid such risks by annotating the definition itself.
+\begin{caml_example}{toplevel}[error]
+let f : abc -> string = function
+ | `As -> "A"
+ | #abc -> "other" ;;
+\end{caml_example}
\newif\ifspace
\def\addspace{\ifspace\;\spacefalse\fi}
\ifhtml
-\newcommand{\token}[1]{\texttt{\blue#1}}
+\newcommand{\token}[1]{\textnormal{\@span{class=syntax-token}#1}}
+\newstyle{.syntax-token}{color:blue;font-family:monospace}
\else
\newcommand{\token}[1]{\texttt{#1}}
\fi
\def\@anchor{}
\fi
%%%Format non-terminal
-\def\nt#1{\textit{\maroon#1}}
+\def\nt#1{\textnormal{\@span{class=nonterminal}#1}}
+\newstyle{.nonterminal}{color:maroon;font-style:oblique}
%%%Link for non-terminal and format
\def\nonterm#1{\addspace\nt{\@anchor{#1}}\spacetrue}
\def\brepet{\addspace\{}
-TOPDIR=$(abspath ../..)
-SRC=$(TOPDIR)
-include $(TOPDIR)/Makefile.tools
-include $(TOPDIR)/ocamldoc/Makefile.docfiles
-MANUAL=$(TOPDIR)/manual/manual
+ROOTDIR = ../..
+include $(ROOTDIR)/api_docgen/Makefile.docfiles
+include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/stdlib/StdlibModules
+include $(ROOTDIR)/Makefile.best_binaries
+STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC ?= $(BEST_OCAMLC) $(STDLIBFLAGS)
+
+MANUAL=$(ROOTDIR)/manual/src
.PHONY: all
all: check-cross-references check-stdlib check-case-collision
tools: cross-reference-checker
cross-reference-checker: cross_reference_checker.ml
- $(OCAMLC) $(TOPDIR)/compilerlibs/ocamlcommon.cma \
- -I $(TOPDIR)/parsing -I $(TOPDIR)/driver \
+ $(OCAMLC) $(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+ -I $(ROOTDIR)/parsing -I $(ROOTDIR)/driver \
$< -o $@
# check cross-references between the manual and error messages
$(SET_LD_PATH) \
$(OCAMLRUN) ./cross-reference-checker \
-auxfile $(MANUAL)/texstuff/manual.aux \
- $(TOPDIR)/utils/warnings.ml \
- $(TOPDIR)/driver/main_args.ml \
- $(TOPDIR)/lambda/translmod.ml
+ $(ROOTDIR)/utils/warnings.ml \
+ $(ROOTDIR)/driver/main_args.ml \
+ $(ROOTDIR)/lambda/translmod.ml
# check that all standard library modules are referenced by the
# standard library chapter of the manual
.PHONY: check-stdlib
check-stdlib:
- ./check-stdlib-modules $(TOPDIR)
+ ./check-stdlib-modules $(ROOTDIR)
# check name collision between latex source file and module documentation
# on case-insensitive file systems
normalize = $(shell echo $(basename $(notdir $(1) )) | tr A-Z a-z)
-LOWER_MLIS= $(call normalize,$(DOC_ALL_MLIS))
+LOWER_MLIS= $(call normalize,$(ALL_DOC:%=%.mli))
LOWER_ETEX= $(call normalize,$(wildcard $(MANUAL)/*/*.etex) $(wildcard *.etex))
INTER = $(filter $(LOWER_ETEX), $(LOWER_MLIS))
.PHONY: check-case-collision
check-case-collision:
ifeq ($(INTER),)
+ @echo "No collisions detected between OCaml modules and LaTeX sources."
else
@echo "The following names"
@echo " $(INTER)"
- `check-stdlib-modules` checks that all stdlib modules are linked from the
main entry of the stdlib in the manual:
- `manual/manual/library/stdlib-blurb.etex`
+ `manual/src/library/stdlib-blurb.etex`
case $i in
Stdlib | Camlinternal* | *Labels | Obj | Pervasives) continue;;
esac
- grep -q -e '"'$i'" & p\.~\\pageref{'$i'} &' $1/manual/manual/library/stdlib-blurb.etex || {
- echo "Module $i is missing from library/stdlib-blurb.etex." >&2
+ grep -q -e '"'$i'" & p\.~\\stdpageref{'$i'} &' $1/manual/src/library/stdlib-blurb.etex || {
+ echo "Module $i is missing from the module description in library/stdlib-blurb.etex." >&2
+ exitcode=2
+ } &&
+ grep -q -e '\\stddocitem{'$i'}' $1/manual/src/library/stdlib-blurb.etex || {
+ echo "Module $i is missing from the linklist in library/stdlib-blurb.etex." >&2
exitcode=2
}
done
rm -f $TMPDIR/stdlib-$$-*
+if [ $exitcode -eq 0 ]; then
+ echo "All Standard Library modules are referenced"
+fi
+
exit $exitcode
-TOPDIR=../..
-COMPFLAGS=-I $(OTOPDIR)/otherlibs/str -I $(OTOPDIR)/otherlibs/unix
-include $(TOPDIR)/Makefile.tools
+ROOTDIR = ../..
+COMPFLAGS = -I $(ROOTDIR)/otherlibs/str -I $(ROOTDIR)/otherlibs/unix
+include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC ?= $(BEST_OCAMLC) $(STDLIBFLAGS)
all: texquote2 transf
transf: transf.cmo htmltransf.cmo transfmain.cmo
- $(OCAMLC) -o $@ -g $^
+ $(OCAMLC) $(COMPFLAGS) -o $@ -g $^
transfmain.cmo: transf.cmo htmltransf.cmo
texquote2: texquote2.ml
- $(OCAMLC) -o $@ $<
+ $(OCAMLC) $(COMPFLAGS) -o $@ $<
%.cmo: %.ml
- $(OCAMLC) -c $<
+ $(OCAMLC) $(COMPFLAGS) -c $<
%.cmi: %.mli
- $(OCAMLC) -c $<
-
-%.ml: %.mll
- $(OCAMLLEX) $<
-
-
+ $(OCAMLC) $(COMPFLAGS) -c $<
.PHONY: clean
clean:
rm -f *.o *.cm? *.cmx?
let module B = (val backend : Backend_intf.S) in
match lam with
| Lvar id ->
- close_approx_var env id
+ close_approx_var env id
+ | Lmutvar id -> (Uvar id, Value_unknown)
| Lconst cst ->
let str ?(shared = true) cst =
let name =
Value_unknown)
| Llet(str, kind, id, lam, body) ->
let (ulam, alam) = close_named env id lam in
- begin match (str, alam) with
- (Variable, _) ->
- let env = {env with mutable_vars = V.Set.add id env.mutable_vars} in
- let (ubody, abody) = close env body in
- (Ulet(Mutable, kind, VP.create id, ulam, ubody), abody)
- | (_, Value_const _)
- when str = Alias || is_pure ulam ->
- close { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
- body
- | (_, _) ->
- let (ubody, abody) =
- close
- { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
- body
- in
- (Ulet(Immutable, kind, VP.create id, ulam, ubody), abody)
+ begin match alam with
+ Value_const _
+ when str = Alias || is_pure ulam ->
+ close { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+ body
+ | _ ->
+ let (ubody, abody) =
+ close
+ { backend; fenv = (V.Map.add id alam fenv); cenv; mutable_vars }
+ body
+ in
+ (Ulet(Immutable, kind, VP.create id, ulam, ubody), abody)
end
+ | Lmutlet(kind, id, lam, body) ->
+ let (ulam, _) = close_named env id lam in
+ let env = {env with mutable_vars = V.Set.add id env.mutable_vars} in
+ let (ubody, abody) = close env body in
+ (Ulet(Mutable, kind, VP.create id, ulam, ubody), abody)
| Lletrec(defs, body) ->
if List.for_all
(function (_id, Lfunction _) -> true | _ -> false)
| Lprim(Pignore, [arg], _loc) ->
let expr, approx = make_const_int 0 in
Usequence(fst (close env arg), expr), approx
- | Lprim((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _loc) ->
+ | Lprim((Pbytes_to_string | Pbytes_of_string), [arg], _loc) ->
close env arg
- | Lprim(Pdirapply,[funct;arg], loc)
- | Lprim(Prevapply,[arg;funct], loc) ->
- close env
- (Lapply{
- ap_loc=loc;
- ap_func=funct;
- ap_args=[arg];
- ap_tailcall=Default_tailcall;
- ap_inlined=Default_inline;
- ap_specialised=Default_specialise;
- })
| Lprim(Pgetglobal id, [], loc) ->
let dbg = Debuginfo.from_location loc in
check_constant_result (getglobal dbg id)
end;
if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@."
-let lambda_to_clambda ~backend ~filename:_ ~prefixname:_ ~ppf_dump
+let lambda_to_clambda ~backend ~prefixname:_ ~ppf_dump
(lambda : Lambda.program) =
let clambda =
Closure.intro ~backend ~size:lambda.main_module_block_size lambda.code
val lambda_to_clambda
: backend:(module Backend_intf.S)
- -> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
| Pbytes_of_string
| Pctconst _
| Pignore
- | Prevapply
- | Pdirapply
- | Pidentity
| Pgetglobal _
| Psetglobal _
->
type t = {
current_unit_id : Ident.t;
symbol_for_global' : (Ident.t -> Symbol.t);
- filename : string;
backend : (module Backend_intf.S);
mutable imported_symbols : Symbol.Set.t;
mutable declared_symbols : (Symbol.t * Flambda.constant_defining_value) list;
let rec close t env (lam : Lambda.lambda) : Flambda.t =
match lam with
| Lvar id ->
- begin match Env.find_var_exn env id with
- | var -> Var var
- | exception Not_found ->
- match Env.find_mutable_var_exn env id with
- | mut_var ->
- name_expr (Read_mutable mut_var) ~name:Names.read_mutable
- | exception Not_found ->
+ begin match Env.find_var_exn env id with
+ | var -> Var var
+ | exception Not_found ->
Misc.fatal_errorf "Closure_conversion.close: unbound identifier %a"
Ident.print id
+ end
+ | Lmutvar id ->
+ begin match Env.find_mutable_var_exn env id with
+ | mut_var ->
+ name_expr (Read_mutable mut_var) ~name:Names.read_mutable
+ | exception Not_found ->
+ Misc.fatal_errorf
+ "Closure_conversion.close: unbound mutable identifier %a"
+ Ident.print id
end
| Lconst cst ->
let cst, name = close_const t cst in
in
let body = close t (Env.add_var env id var) body in
Flambda.create_let var defining_expr body
- | Llet (Variable, block_kind, id, defining_expr, body) ->
+ | Lmutlet (block_kind, id, defining_expr, body) ->
let mut_var = Mutable_variable.create_with_same_name_as_ident id in
let var = Variable.create_with_same_name_as_ident id in
let defining_expr =
(If_then_else (cond, arg2, Var const_false)))
| Lprim ((Psequand | Psequor), _, _) ->
Misc.fatal_error "Psequand / Psequor must have exactly two arguments"
- | Lprim ((Pidentity | Pbytes_to_string | Pbytes_of_string), [arg], _) ->
+ | Lprim ((Pbytes_to_string | Pbytes_of_string), [arg], _) ->
close t env arg
| Lprim (Pignore, [arg], _) ->
let var = Variable.create Names.ignore in
in
Flambda.create_let var defining_expr
(name_expr (Const (Int 0)) ~name:Names.unit)
- | Lprim (Pdirapply, [funct; arg], loc)
- | Lprim (Prevapply, [arg; funct], loc) ->
- let apply : Lambda.lambda_apply =
- { ap_func = funct;
- ap_args = [arg];
- ap_loc = loc;
- (* CR-someday lwhite: it would be nice to be able to give
- application attributes to functions applied with the application
- operators. *)
- ap_tailcall = Default_tailcall;
- ap_inlined = Default_inline;
- ap_specialised = Default_specialise;
- }
- in
- close t env (Lambda.Lapply apply)
| Lprim (Praise kind, [arg], loc) ->
let arg_var = Variable.create Names.raise_arg in
let dbg = Debuginfo.from_location loc in
~var:let_bound_var))
| lam -> Expr (close t env lam)
-let lambda_to_flambda ~backend ~module_ident ~size ~filename lam
+let lambda_to_flambda ~backend ~module_ident ~size lam
: Flambda.program =
let lam = add_default_argument_wrappers lam in
let module Backend = (val backend : Backend_intf.S) in
let t =
{ current_unit_id = Compilation_unit.get_persistent_ident compilation_unit;
symbol_for_global' = Backend.symbol_for_global';
- filename;
backend;
imported_symbols = Symbol.Set.empty;
declared_symbols = [];
: backend:(module Backend_intf.S)
-> module_ident:Ident.t
-> size:int
- -> filename:string
-> Lambda.lambda
-> Flambda.program
and import_function_declarations_for_pack_aux units pack
(function_decls : Flambda.function_declarations) =
- let funs =
- Variable.Map.map
- (fun (function_decl : Flambda.function_declaration) ->
- Flambda.create_function_declaration ~params:function_decl.params
- ~body:(import_code_for_pack units pack function_decl.body)
- ~stub:function_decl.stub ~dbg:function_decl.dbg
- ~inline:function_decl.inline
- ~specialise:function_decl.specialise
- ~is_a_functor:function_decl.is_a_functor
- ~closure_origin:function_decl.closure_origin)
- function_decls.funs
- in
Flambda.import_function_declarations_for_pack
- (Flambda.update_function_declarations function_decls ~funs)
+ function_decls
(import_set_of_closures_id_for_pack units pack)
(import_set_of_closures_origin_for_pack units pack)
| None -> assert false)
set_of_closures.function_decls.funs)
-let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size ~filename
+let lambda_to_flambda ~ppf_dump ~prefixname ~backend ~size
~module_ident ~module_initializer =
Profile.record_call "flambda" (fun () ->
let previous_warning_reporter = !Location.warning_reporter in
(fun () ->
module_initializer
|> Closure_conversion.lambda_to_flambda ~backend
- ~module_ident ~size ~filename)
+ ~module_ident ~size)
in
if !Clflags.dump_rawflambda
then
if !Clflags.dump_cmm then Format.fprintf ppf "@.cmm:@.";
input
-let lambda_to_clambda ~backend ~filename ~prefixname ~ppf_dump
+let lambda_to_clambda ~backend ~prefixname ~ppf_dump
(program : Lambda.program) =
let program =
lambda_to_flambda ~ppf_dump ~prefixname ~backend
~size:program.main_module_block_size
- ~filename
~module_ident:program.module_ident
~module_initializer:program.code
in
val lambda_to_clambda
: backend:(module Backend_intf.S)
- -> filename:string
-> prefixname:string
-> ppf_dump:Format.formatter
-> Lambda.program
{ subst : Clambda.ulambda Variable.Map.t;
var : V.t Variable.Map.t;
mutable_var : V.t Mutable_variable.Map.t;
- toplevel : bool;
allocated_constant_for_symbol : Allocated_const.t Symbol.Map.t;
}
{ subst = Variable.Map.empty;
var = Variable.Map.empty;
mutable_var = Mutable_variable.Map.empty;
- toplevel = false;
allocated_constant_for_symbol = Symbol.Map.empty;
}
List.iter
(fun (key, lam) ->
index.(key) <- store.act_store () lam;
- smallest_key := min key !smallest_key
+ smallest_key := Int.min key !smallest_key
)
cases;
if !smallest_key < num_keys then begin
mark_curr curr;
mark_loop ~toplevel [] f1;
mark_loop ~toplevel:false [] body
- | If_then_else (f1,f2,f3) ->
+ | If_then_else (cond,f2,f3) ->
mark_curr curr;
- mark_curr [Var f1];
+ mark_var cond curr;
mark_loop ~toplevel [] f2;
mark_loop ~toplevel [] f3
| Static_raise (_,l) ->
try
Closure_origin.Map.find id t.inlining_counts
with Not_found ->
- max 1 (Clflags.Int_arg_helper.get
+ Int.max 1 (Clflags.Int_arg_helper.get
~key:t.round !Clflags.inline_max_unroll)
in
inlining_count > 0
try
Closure_origin.Map.find id t.inlining_counts
with Not_found ->
- max 1 (Clflags.Int_arg_helper.get
+ Int.max 1 (Clflags.Int_arg_helper.get
~key:t.round !Clflags.inline_max_unroll)
in
let inlining_counts =
| Never_inline, _ -> Never_inline
| _, Never_inline -> Never_inline
| Can_inline_if_no_larger_than i1, Can_inline_if_no_larger_than i2 ->
- Can_inline_if_no_larger_than (min i1 i2)
+ Can_inline_if_no_larger_than (Int.min i1 i2)
let equal t1 t2 =
match t1, t2 with
let inline_call_cost = cost !Clflags.inline_call_cost ~round in
direct_call_size + (inline_call_cost * benefit_factor)
in
- max_cost := max !max_cost max_size
+ max_cost := Int.max !max_cost max_size
done;
!max_cost
end
let inline_prim_cost = cost !Clflags.inline_prim_cost ~round in
inline_prim_cost * benefit_factor
in
- max_cost := max !max_cost max_size
+ max_cost := Int.max !max_cost max_size
done;
!max_cost
end
linear_let_bound_vars : V.Set.t;
assigned : V.Set.t;
closure_environment : V.Set.t;
- let_bound_vars_that_can_be_moved : V.Set.t;
}
let ignore_uconstant (_ : Clambda.uconstant) = ()
in
{ used_let_bound_vars; linear_let_bound_vars; assigned;
closure_environment = !environment_vars;
- let_bound_vars_that_can_be_moved = V.Set.empty;
}
(* When sequences of [let]-bindings match the evaluation order in a subsequent
let pccall = "Pccall"
let pctconst = "Pctconst"
let pcvtbint = "Pcvtbint"
-let pdirapply = "Pdirapply"
let pdivbint = "Pdivbint"
let pdivfloat = "Pdivfloat"
let pdivint = "Pdivint"
let pfloatfield = "Pfloatfield"
let pfloatofint = "Pfloatofint"
let pgetglobal = "Pgetglobal"
-let pidentity = "Pidentity"
let pignore = "Pignore"
let pint_as_pointer = "Pint_as_pointer"
let pintcomp = "Pintcomp"
let porint = "Porint"
let praise = "Praise"
let predef_exn = "predef_exn"
-let prevapply = "Prevapply"
let project_closure = "project_closure"
let psequand = "Psequand"
let psequor = "Psequor"
let pccall_arg = "Pccall_arg"
let pctconst_arg = "Pctconst_arg"
let pcvtbint_arg = "Pcvtbint_arg"
-let pdirapply_arg = "Pdirapply_arg"
let pdivbint_arg = "Pdivbint_arg"
let pdivfloat_arg = "Pdivfloat_arg"
let pdivint_arg = "Pdivint_arg"
let pfloatfield_arg = "Pfloatfield_arg"
let pfloatofint_arg = "Pfloatofint_arg"
let pgetglobal_arg = "Pgetglobal_arg"
-let pidentity_arg = "Pidentity_arg"
let pignore_arg = "Pignore_arg"
let pint_as_pointer_arg = "Pint_as_pointer_arg"
let pintcomp_arg = "Pintcomp_arg"
let porbint_arg = "Porbint_arg"
let porint_arg = "Porint_arg"
let praise_arg = "Praise_arg"
-let prevapply_arg = "Prevapply_arg"
let psequand_arg = "Psequand_arg"
let psequor_arg = "Psequor_arg"
let psetfield_arg = "Psetfield_arg"
(Filename.basename file) line pp_chars
let of_primitive : Lambda.primitive -> string = function
- | Pidentity -> pidentity
| Pbytes_of_string -> pbytes_of_string
| Pbytes_to_string -> pbytes_to_string
| Pignore -> pignore
- | Prevapply -> prevapply
- | Pdirapply -> pdirapply
| Pgetglobal _ -> pgetglobal
| Psetglobal _ -> psetglobal
| Pmakeblock _ -> pmakeblock
| Popaque -> popaque
let of_primitive_arg : Lambda.primitive -> string = function
- | Pidentity -> pidentity_arg
| Pbytes_of_string -> pbytes_of_string_arg
| Pbytes_to_string -> pbytes_to_string_arg
| Pignore -> pignore_arg
- | Prevapply -> prevapply_arg
- | Pdirapply -> pdirapply_arg
| Pgetglobal _ -> pgetglobal_arg
| Psetglobal _ -> psetglobal_arg
| Pmakeblock _ -> pmakeblock_arg
opam-version: "2.0"
-version: "4.12.1"
-synopsis: "OCaml 4.12.1"
+version: "4.13.0"
+synopsis: "OCaml 4.13.0"
depends: [
- "ocaml" {= "4.12.1" & post}
+ "ocaml" {= "4.13.0" & post}
"base-unix" {post}
"base-bigarray" {post}
"base-threads" {post}
include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-OCAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
-OCAMLYACC ?= $(ROOTDIR)/yacc/ocamlyacc$(EXE)
+OCAMLYACCFLAGS = --strict -v
STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
OCAMLC = $(BEST_OCAMLC) $(STDLIBFLAGS)
OCAMLOPT = $(BEST_OCAMLOPT) $(STDLIBFLAGS)
OCAMLDEP = $(BEST_OCAMLDEP)
DEPFLAGS = -slash
-OCAMLLEX = $(BEST_OCAMLLEX)
# For installation
##############
CP=cp
-OCAMLDOC=ocamldoc$(EXE)
-OCAMLDOC_OPT=ocamldoc.opt$(EXE)
-
programs := ocamldoc ocamldoc.opt
-
-# TODO: clarify whether the following really needs to be that complicated
-ifeq "$(UNIX_OR_WIN32)" "unix"
- ifeq "$(TARGET)" "$(HOST)"
- ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
- OCAMLDOC_RUN_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
- else
-# if shared-libraries are not supported, unix.cma and str.cma
-# are compiled with -custom, so ocamldoc also uses -custom,
-# and (ocamlrun ocamldoc) does not work.
- OCAMLDOC_RUN_BYTE=./$(OCAMLDOC)
- endif
- else
- OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(OCAMLDOC)
- endif
-else # Windows
- OCAMLDOC_RUN_BYTE = \
- CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC)
-endif
-
-OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT)
-
-OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE)
-
-ifeq "$(wildcard $(OCAMLDOC_OPT))" ""
- OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE)
-else
- OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT)
-endif
+include Makefile.best_ocamldoc
OCAMLDOC_LIBCMA=odoc_info.cma
OCAMLDOC_LIBCMI=odoc_info.cmi
DEPINCLUDES=$(INCLUDES_DEP)
INCLUDES=$(INCLUDES_DEP) $(INCLUDES_NODEP)
-COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48 -warn-error A \
+COMPFLAGS=$(INCLUDES) -absname -w +a-4-9-41-42-44-45-48-70 -warn-error +A \
-safe-string -strict-sequence -strict-formats -bin-annot -principal
LINKFLAGS=$(INCLUDES) -nostdlib
$(OCAMLDOC_LIBCMXA): $(LIBCMXFILES)
$(OCAMLOPT) -a -o $@ $(LINKFLAGS) $^
-.PHONY: manpages
-manpages: stdlib_man/Stdlib.3o
-
-.PHONY: html_doc
-html_doc: stdlib_html/Stdlib.html
-
-.PHONY: pdf_doc
-pdf_doc: stdlib_latex/stdlib.pdf
-
-.PHONY: texi_doc
-texi_doc: stdlib_texi/stdlib.texi
-
.PHONY: dot
dot: ocamldoc.dot
ocamldoc.dot: $(EXECMOFILES)
$(OCAMLDOC_RUN) -dot -dot-reduce -o $@ $(INCLUDES) odoc*.ml
-# Parsers and lexers dependencies :
-###################################
-odoc_text_parser.ml: odoc_text_parser.mly
-odoc_text_parser.mli: odoc_text_parser.mly
-
-odoc_parser.ml: odoc_parser.mly
-odoc_parser.mli:odoc_parser.mly
+# Lexers and parsers
-odoc_text_lexer.ml: odoc_text_lexer.mll
+LEXERS = $(addsuffix .mll,\
+ odoc_text_lexer odoc_lexer odoc_ocamlhtml odoc_see_lexer)
-odoc_lexer.ml:odoc_lexer.mll
-
-odoc_ocamlhtml.ml: odoc_ocamlhtml.mll
-
-odoc_see_lexer.ml: odoc_see_lexer.mll
+PARSERS = $(addsuffix .mly,odoc_parser odoc_text_parser)
+DEPEND_PREREQS = $(LEXERS:.mll=.ml) \
+ $(PARSERS:.mly=.mli) $(PARSERS:.mly=.ml)
# generic rules :
#################
-.SUFFIXES: .mll .mly .ml .mli .cmo .cmi .cmx .cmxs
-
-.ml.cmo:
+%.cmo: %.ml
$(OCAMLC) $(COMPFLAGS) -c $<
-.mli.cmi:
+%.cmi: %.mli
$(OCAMLC) $(COMPFLAGS) -c $<
-.ml.cmx:
+%.cmx: %.ml
$(OCAMLOPT) $(COMPFLAGS) -c $<
-.ml.cmxs:
+%.cmxs: %.ml
$(OCAMLOPT_CMD) -shared -o $@ $(COMPFLAGS) $<
-.mll.ml:
- $(OCAMLLEX) $(OCAMLLEX_FLAGS) $<
-
-.mly.ml:
- $(OCAMLYACC) --strict -v $<
-
-.mly.mli:
- $(OCAMLYACC) --strict -v $<
-
# Installation targets
######################
# TODO: it may be good to split the following rule in several ones, e.g.
# install-programs, install-doc, install-libs
-INSTALL_MANODIR=$(INSTALL_MANDIR)/man3
-
.PHONY: install
install:
$(MKDIR) "$(INSTALL_BINDIR)"
$(MKDIR) "$(INSTALL_LIBDIR)/ocamldoc"
- $(MKDIR) "$(INSTALL_MANODIR)"
$(INSTALL_PROG) $(OCAMLDOC) "$(INSTALL_BINDIR)"
$(INSTALL_DATA) \
ocamldoc.hva *.cmi $(OCAMLDOC_LIBCMA) \
$(OCAMLDOC_LIBMLIS) $(OCAMLDOC_LIBCMTS) \
"$(INSTALL_LIBDIR)/ocamldoc"
endif
- if test -d stdlib_man; then \
- $(INSTALL_DATA) stdlib_man/* "$(INSTALL_MANODIR)"; \
- else : ; fi
# Note: at the moment, $(INSTALL_MANODIR) is created even if the doc has
# not been built. This is not clean and should be changed.
#######################
SRC=$(ROOTDIR)
-# Documented modules: stdlib + otherlib + utils(?) + parsing(for compiler-libs)
-
-include Makefile.docfiles
-
-stdlib_man/Stdlib.3o: $(OCAMLDOC) $(DOC_ALL)
- $(MKDIR) stdlib_man
- $(OCAMLDOC_RUN) -man -d stdlib_man -nostdlib \
- -hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
- -t "OCaml library" -man-mini \
- $(DOC_ALL_TEXT:%=-text %) \
- $(DOC_ALL_MLIS)
-
-stdlib_html/Stdlib.html: $(OCAMLDOC) $(DOC_ALL)
- $(MKDIR) stdlib_html
- $(OCAMLDOC_RUN) -html -d stdlib_html -nostdlib \
- -hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
- -t "OCaml library" \
- $(DOC_ALL_TEXT:%=-text %) \
- $(DOC_ALL_MLIS)
-
-stdlib_texi/stdlib.texi: $(OCAMLDOC) $(DOC_ALL)
- $(MKDIR) stdlib_texi
- $(OCAMLDOC_RUN) -texi -o stdlib_texi/stdlib.texi -nostdlib \
- -hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
- -t "OCaml library" \
- $(DOC_ALL_TEXT:%=-text %) \
- $(DOC_ALL_MLIS)
-
-
-stdlib_latex/stdlib.tex: $(OCAMLDOC) $(DOC_ALL)
- $(MKDIR) stdlib_latex
- $(OCAMLDOC_RUN) -latex -o stdlib_latex/stdlib.tex -nostdlib \
- -hide Stdlib -lib Stdlib $(DOC_ALL_INCLUDES) \
- -pp "$(AWK) -v ocamldoc=true -f $(SRC)/stdlib/expand_module_aliases.awk" \
- -t "OCaml library" \
- $(DOC_ALL_TEXT:%=-text %) \
- $(DOC_ALL_MLIS)
-
-stdlib_latex/stdlib.pdf: stdlib_latex/stdlib.tex
- cd stdlib_latex && pdflatex stdlib && pdflatex stdlib
-
.PHONY: autotest_stdlib
autotest_stdlib:
$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.mli \
$(ROOTDIR)/otherlibs/str/str.mli
-
-# odoc rules :
-##############
-
-.PHONY: odoc
-odoc:
- rm -rf odoc
- $(MKDIR) odoc
- # .cmti --> .odoc
- for fn in $(ROOTDIR)/stdlib/stdlib*.cmti; do \
- odoc compile $(INCLUDES) --package stdlib $(ROOTDIR)/stdlib/$$fn; \
- done
- for lib in str bigarray; do \
- odoc compile $(INCLUDES) --package $$lib $(ROOTDIR)/otherlibs/$$lib/$$lib.cmti; \
- done
- odoc compile $(INCLUDES) --package unix $(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cmti
- for fn in $(ROOTDIR)/parsing/*.cmti; do \
- odoc compile $(INCLUDES) --package parsing $(ROOTDIR)/parsing/$$fn; \
- done
- # .odoc --> .html
- odoc html $(INCLUDES) --output-dir odoc $(ROOTDIR)/stdlib/stdlib.odoc
- for lib in str bigarray $(UNIXLIB); do \
- odoc html $(INCLUDES) --output-dir odoc $(ROOTDIR)/otherlibs/$$lib/$$lib.odoc; \
- done
- for fn in $(ROOTDIR)/parsing/*.odoc; do \
- odoc html $(INCLUDES) --output-dir odoc $$fn; \
- done
- for d in odoc/*; do \
- lib=`basename $$d`; \
- cd $$d; \
- echo -e The $$lib 'library.\n\nModules\n:{!modules:' * '}' > ../../index.mld; \
- cd ../..; \
- odoc html $(INCLUDES) --output-dir odoc --index-for=$$lib index.mld; \
- rm -f index.mld; \
- done
- cp odoc_index.html odoc/index.html
- odoc css -o odoc
-
# backup, clean and depend :
############################
rm -f odoc_parser.output odoc_text_parser.output
rm -f odoc_lexer.ml odoc_text_lexer.ml odoc_see_lexer.ml odoc_ocamlhtml.ml
rm -f odoc_parser.ml odoc_parser.mli odoc_text_parser.ml odoc_text_parser.mli
- rm -rf stdlib_man stdlib_html stdlib_texi stdlib_latex
rm -f generators/*.cm[taiox] generators/*.a generators/*.lib generators/*.o generators/*.obj \
generators/*.cmx[as]
.PHONY: depend
-depend:
- $(OCAMLYACC) odoc_text_parser.mly
- $(OCAMLYACC) odoc_parser.mly
- $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_text_lexer.mll
- $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_lexer.mll
- $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_ocamlhtml.mll
- $(OCAMLLEX) $(OCAMLLEX_FLAGS) odoc_see_lexer.mll
+depend: $(DEPEND_PREREQS)
$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) *.mll *.mly *.ml *.mli > .depend
$(OCAMLDEP) $(DEPFLAGS) $(DEPINCLUDES) -shared generators/*.ml >> .depend
--- /dev/null
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* Florian Angeletti, projet Cambium, Inria Paris *
+#* *
+#* Copyright 2020 Institut National de Recherche en Informatique et *
+#* en Automatique. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+OCAMLDOC=$(ROOTDIR)/ocamldoc/ocamldoc$(EXE)
+OCAMLDOC_OPT=$(ROOTDIR)/ocamldoc/ocamldoc.opt$(EXE)
+
+# TODO: clarify whether the following really needs to be that complicated
+ifeq "$(UNIX_OR_WIN32)" "unix"
+ ifeq "$(TARGET)" "$(HOST)"
+ ifeq "$(SUPPORTS_SHARED_LIBRARIES)" "true"
+ OCAMLDOC_RUN_BYTE=$(OCAMLRUN) -I $(ROOTDIR)/otherlibs/$(UNIXLIB) -I $(ROOTDIR)/otherlibs/str ./$(OCAMLDOC)
+ else
+# if shared-libraries are not supported, unix.cma and str.cma
+# are compiled with -custom, so ocamldoc also uses -custom,
+# and (ocamlrun ocamldoc) does not work.
+ OCAMLDOC_RUN_BYTE=./$(OCAMLDOC)
+ endif
+ else
+ OCAMLDOC_RUN_BYTE=$(OCAMLRUN) ./$(OCAMLDOC)
+ endif
+else # Windows
+ OCAMLDOC_RUN_BYTE = \
+ CAML_LD_LIBRARY_PATH="$(ROOTDIR)/otherlibs/win32unix;$(ROOTDIR)/otherlibs/str" $(OCAMLRUN) ./$(OCAMLDOC)
+endif
+
+OCAMLDOC_RUN_OPT=./$(OCAMLDOC_OPT)
+
+OCAMLDOC_RUN_PLUGINS=$(OCAMLDOC_RUN_BYTE)
+
+ifeq "$(wildcard $(OCAMLDOC_OPT))" ""
+ OCAMLDOC_RUN=$(OCAMLDOC_RUN_BYTE)
+else
+ OCAMLDOC_RUN=$(OCAMLDOC_RUN_OPT)
+endif
+++ /dev/null
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Florian Angeletti *
-#* *
-#* Copyright 2018 *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# Define the lists of mli file used by ocamldoc to generate the stdlib
-# + otherlibs + compilerlibs documentation
-
--include $(SRC)/Makefile.config
--include $(SRC)/stdlib/StdlibModules
-PARSING_MLIS := $(wildcard $(SRC)/parsing/*.mli)
-UTILS_MLIS := $(wildcard $(SRC)/utils/*.mli)
-STR_MLIS = $(addprefix $(SRC)/otherlibs/str/, str.mli)
-UNIX_MLIS = $(addprefix $(SRC)/otherlibs/unix/, unix.mli unixLabels.mli)
-DYNLINK_MLIS = $(addprefix $(SRC)/otherlibs/dynlink/, dynlink.mli)
-THREAD_MLIS = $(addprefix $(SRC)/otherlibs/systhreads/, \
- thread.mli condition.mli mutex.mli event.mli semaphore.mli threadUnix.mli)
-DRIVER_MLIS = $(SRC)/driver/pparse.mli
-
-
-DOC_STDLIB_DIRS = stdlib \
- otherlibs/str \
- otherlibs/$(UNIXLIB) otherlibs/dynlink \
- otherlibs/systhreads
-
-DOC_COMPILERLIBS_DIRS= parsing utils typing bytecomp driver file_formats lambda
-
-DOC_ALL_DIRS = $(DOC_COMPILERLIBS) $(DOC_STDLIB_DIRS)
-
-DOC_STDLIB_INCLUDES = $(addprefix -I $(SRC)/, $(DOC_STDLIB_DIRS))
-DOC_COMPILERLIBS_INCLUDES = $(addprefix -I $(SRC)/, $(DOC_COMPILERLIBS_DIRS))
-
-DOC_ALL_INCLUDES = $(DOC_STDLIB_INCLUDES) $(DOC_COMPILERLIBS_INCLUDES)
-
-STDLIB_MOD_WP = $(filter-out stdlib__pervasives, $(STDLIB_MODULES))
-STDLIB_MLI0 = $(STDLIB_MOD_WP:%=$(SRC)/stdlib/%.mli)
-STDLIB_MLIS=\
- $(STDLIB_MLI0:$(SRC)/stdlib/stdlib__%=$(SRC)/stdlib/%) \
- $(STR_MLIS) \
- $(UNIX_MLIS) \
- $(THREAD_MLIS) \
- $(DYNLINK_MLIS)
-
-COMPILERLIBS_MLIS=\
- $(PARSING_MLIS) \
- $(UTILS_MLIS) \
- $(DRIVER_MLIS)
-
-DOC_STDLIB_TEXT = $(SRC)/stdlib/ocaml_operators.mld
-DOC_COMPILERLIBS_TEXT = $(SRC)/manual/manual/library/compiler_libs.mld
-DOC_ALL_TEXT = $(DOC_STDLIB_TEXT) $(DOC_COMPILERLIBS_TEXT)
-
-
-DOC_ALL_MLIS= $(STDLIB_MLIS) $(COMPILERLIBS_MLIS)
-DOC_ALL = $(DOC_ALL_MLIS) $(DOC_ALL_TEXT)
match parsetree_typedtree_opt with
None ->
None
- | Some (parsetree, typedtree) ->
+ | Some (parsetree, Typedtree.{structure; coercion; _}) ->
+ let typedtree = (structure, coercion) in
let file_module = Ast_analyser.analyse_typed_tree file
input_file parsetree typedtree
in
"-index-only", Arg.Set Odoc_html.index_only, M.index_only ;
"-colorize-code", Arg.Set Odoc_html.colorize_code, M.colorize_code ;
"-short-functors", Arg.Set Odoc_html.html_short_functors, M.html_short_functors ;
- "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset)^
+ "-charset", Arg.Set_string Odoc_html.charset, (M.charset !Odoc_html.charset) ;
+ "-nonavbar", Arg.Clear Odoc_html.show_navbar, M.no_navbar ^
"\n\n *** LaTeX options ***\n";
(* latex only options *)
(List.map iter_pattern patlist,
Odoc_env.subst_type env pat.pat_type)
- | Typedtree.Tpat_construct (_, cons_desc, _) when
- (* we give a name to the parameter only if it unit *)
+ | Typedtree.Tpat_construct (_, cons_desc, _, _) when
+ (* we give a name to the parameter only if it is unit *)
(match cons_desc.cstr_res.desc with
Tconstr (p, _, _) ->
Path.same p Predef.path_unit
external int_of_idag : idag -> int = "%identity";;
external idag_of_int : int -> idag = "%identity";;
-type 'a table = { mutable table : 'a data array array }
+type 'a table = { table : 'a data array array }
and 'a data = { mutable elem : 'a elem; mutable span : span_id }
and 'a elem = Elem of 'a | Ghost of ghost_id | Nothing
and span_id
next_l next_j;
flush stderr
end;
- let next_l = min next_l next_j in
+ let next_l = Int.min next_l next_j in
let colspan = 3 * (next_l - l) - 2 in
let les =
match t.table.(i).(l).elem, t.table.(i + 1).(l).elem with
match get_block t i (j + 1) with
Some ((x1, c1) :: list, mpc, span) ->
let (list, mpc) =
- if x1 = x.elem then (x1, c1 + 1) :: list, max mpc (c1 + 1)
- else (x.elem, 1) :: (x1, c1) :: list, max mpc c1
+ if x1 = x.elem then (x1, c1 + 1) :: list, Int.max mpc (c1 + 1)
+ else (x.elem, 1) :: (x1, c1) :: list, Int.max mpc c1
in
Some (list, mpc, span)
| _ -> assert false
in
if nii <> ii || njj1 <> jj1 || njj2 <> jj2 || njj3 <> jj3 ||
njj4 <> jj4 then
- let nii = min ii nii in
+ let nii = Int.min ii nii in
let (jj1, jj2, jj3, jj4) =
find_linked_children t nii njj1 njj2 njj3 njj4
in
| Types.Tconstr (p, l, a) ->
let new_p =
Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
- t.Types.desc <- Types.Tconstr (new_p, l, a)
- | Types.Tpackage (p, n, l) ->
+ Btype.set_type_desc t (Types.Tconstr (new_p, l, a))
+ | Types.Tpackage (p, fl) ->
let new_p =
Odoc_name.to_path (full_module_type_name env (Odoc_name.from_path p)) in
- t.Types.desc <- Types.Tpackage (new_p, n, l)
+ Btype.set_type_desc t (Types.Tpackage (new_p, fl))
| Types.Tobject (_, ({contents=Some(p,tyl)} as r)) ->
let new_p =
Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
| Types.Tvariant ({Types.row_name=Some(p, tyl)} as row) ->
let new_p =
Odoc_name.to_path (full_type_name env (Odoc_name.from_path p)) in
- t.Types.desc <-
- Types.Tvariant {row with Types.row_name=Some(new_p, tyl)}
+ Btype.set_type_desc t
+ (Types.Tvariant {row with Types.row_name=Some(new_p, tyl)})
| _ ->
()
end
let colorize_code = ref false
let html_short_functors = ref false
let charset = ref "iso-8859-1"
+let show_navbar = ref true
(** The functions used for naming files and html marks.*)
| Some d ->
bs b "<div class=\"info-deprecated\">\n";
bs b "<span class=\"warning\">";
- bs b Odoc_messages.deprecated ;
+ bs b (Odoc_messages.deprecated^". ");
bs b "</span>" ;
self#html_of_text b d;
bs b "</div>\n"
in
iter
-let newline_to_indented_br s =
+
+(** Escape "\n", "<", ">", and "&" *)
+let text_to_html s =
let len = String.length s in
let b = Buffer.create len in
for i = 0 to len - 1 do
match s.[i] with
- '\n' -> Buffer.add_string b "<br> "
+ | '\n' -> Buffer.add_string b "<br> "
+ | '<' -> Buffer.add_string b "<"
+ | '>' -> Buffer.add_string b ">"
+ | '&' -> Buffer.add_string b "&"
| c -> Buffer.add_char b c
done;
Buffer.contents b
@param post optional name for optional next module/class
@param name name of current module/class *)
method print_navbar b pre post name =
- bs b "<div class=\"navbar\">";
- (
- match pre with
- None -> ()
- | Some name ->
- bp b "<a class=\"pre\" href=\"%s\" title=\"%s\">%s</a>\n"
- (fst (Naming.html_files name))
- name
- Odoc_messages.previous
- );
- bs b " ";
- let father = Name.father name in
- let href = if father = "" then self#index else fst (Naming.html_files father) in
- let father_name = if father = "" then "Index" else father in
- bp b "<a class=\"up\" href=\"%s\" title=\"%s\">%s</a>\n" href father_name Odoc_messages.up;
- bs b " ";
- (
- match post with
- None -> ()
- | Some name ->
- bp b "<a class=\"post\" href=\"%s\" title=\"%s\">%s</a>\n"
- (fst (Naming.html_files name))
- name
- Odoc_messages.next
- );
- bs b "</div>\n"
+ if !show_navbar then begin
+ bs b "<div class=\"navbar\">";
+ (
+ match pre with
+ None -> ()
+ | Some name ->
+ bp b "<a class=\"pre\" href=\"%s\" title=\"%s\">%s</a>\n"
+ (fst (Naming.html_files name))
+ name
+ Odoc_messages.previous
+ );
+ bs b " ";
+ let father = Name.father name in
+ let href = if father = "" then self#index else fst (Naming.html_files father) in
+ let father_name = if father = "" then "Index" else father in
+ bp b "<a class=\"up\" href=\"%s\" title=\"%s\">%s</a>\n" href father_name Odoc_messages.up;
+ bs b " ";
+ (
+ match post with
+ None -> ()
+ | Some name ->
+ bp b "<a class=\"post\" href=\"%s\" title=\"%s\">%s</a>\n"
+ (fst (Naming.html_files name))
+ name
+ Odoc_messages.next
+ );
+ bs b "</div>\n"
+ end
(** Return html code with the given string in the keyword style.*)
method keyword s =
(** Print html code to display a [Types.type_expr]. *)
method html_of_type_expr b m_name t =
let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_type_expr t) in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
match l with
| Cstr_tuple l ->
let s = Odoc_info.string_of_type_list ?par sep l in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
of a class of class type. *)
method html_of_class_type_param_expr_list b m_name l =
let s = Odoc_info.string_of_class_type_param_list l in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">[";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "]</code>"
method html_of_class_parameter_list b father c =
let s = Odoc_info.string_of_class_params c in
let s = Odoc_info.remove_ending_newline s in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links father s2);
bs b "</code>"
(** Print html code to display a list of type parameters for the given type.*)
method html_of_type_expr_param_list b m_name t =
let s = Odoc_info.string_of_type_param_list t in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>"
bs b "<pre><code>";
bs b ((self#keyword "type")^" ");
let s = Odoc_info.string_of_type_extension_param_list te in
- let s2 = newline_to_indented_br s in
+ let s2 = text_to_html s in
bs b "<code class=\"type\">";
bs b (self#create_fully_qualified_idents_links m_name s2);
bs b "</code>";
| Some d ->
let b = Buffer.create 256 in
bs b ".B \"";
- bs b Odoc_messages.deprecated;
+ bs b (Odoc_messages.deprecated^".");
bs b "\"\n";
self#man_of_text b d;
bs b "\n";
let charset c = Printf.sprintf
"<s> Add information about character encoding being s\n\t\t(default is %s)"
c
+let no_navbar = " Do not include the navigation bar "^html_only
let generate_html = " Generate HTML documentation"
let generate_latex = " Generate LaTeX documentation"
let generate_texinfo = " Generate TeXinfo documentation"
let version = "Version"
let since = "Since"
let before = "Before"
-let deprecated = "Deprecated."
+let deprecated = "Deprecated"
let raises = "Raises"
let returns = "Returns"
let inherits = "Inherits"
let module M = Odoc_types in
(match i.M.i_deprecated with
None -> ""
- | Some d -> Odoc_messages.deprecated^"! "^(string_of_text d)^"\n")^
+ | Some d -> Odoc_messages.deprecated^". "^(string_of_text d)^"\n")^
(match i.M.i_desc with
None -> ""
| Some d when d = [Odoc_types.Raw ""] -> ""
| Types.Tnil
| Types.Tvariant _
| Types.Tpackage _ -> t
- | Types.Tlink t2
- | Types.Tsubst t2 -> iter t2.Types.desc
+ | Types.Tlink t2 -> iter t2.Types.desc
+ | Types.Tsubst _ -> assert false
in
- { typ with Types.desc = iter typ.Types.desc }
+ Types.Private_type_expr.create (iter typ.Types.desc)
+ ~level:typ.Types.level ~scope:typ.Types.scope ~id:typ.Types.id
| Types.Cty_signature cs ->
(* we delete vals and methods in order to not print them when
displaying the type *)
- let tnil =
- { Types.desc = Types.Tnil ; Types.level = 0
- ; Types.scope = Btype.lowest_level ; Types.id = 0 }
+ let tself =
+ let t = cs.Types.csig_self in
+ let t' = Types.Private_type_expr.create Types.Tnil
+ ~level:0 ~scope:Btype.lowest_level ~id:0 in
+ let desc = Types.Tobject (t', ref None) in
+ Types.Private_type_expr.create desc
+ ~level:t.Types.level ~scope:t.Types.scope ~id:t.Types.id
in
- Types.Cty_signature { Types.csig_self = { cs.Types.csig_self with
- Types.desc = Types.Tobject (tnil, ref None) };
+ Types.Cty_signature { Types.csig_self = tself;
csig_vars = Types.Vars.empty ;
csig_concr = Types.Concr.empty ;
csig_inher = []
match type_kind with
Types.Type_abstract ->
Odoc_type.Type_abstract
- | Types.Type_variant l ->
+ | Types.Type_variant (l,_) ->
let f {Types.cd_id=constructor_name;cd_args;cd_res=ret_type} =
let constructor_name = Ident.name constructor_name in
let comment_opt =
let erased_names_of_constraints constraints acc =
List.fold_right (fun constraint_ acc ->
match constraint_ with
- | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ -> acc
+ | Parsetree.Pwith_type _ | Parsetree.Pwith_module _ | Parsetree.Pwith_modtype _ -> acc
| Parsetree.Pwith_typesubst (s, typedecl) ->
constraint_for_subitem acc s (fun s -> Parsetree.Pwith_typesubst (s, typedecl))
| Parsetree.Pwith_modsubst (s, modpath) ->
- constraint_for_subitem acc s (fun s -> Parsetree.Pwith_modsubst (s, modpath)))
+ constraint_for_subitem acc s (fun s -> Parsetree.Pwith_modsubst (s, modpath))
+ | Parsetree.Pwith_modtypesubst (s, modpath) ->
+ constraint_for_subitem acc s
+ (fun s -> Parsetree.Pwith_modtypesubst (s, modpath)))
constraints acc
let is_erased ident map =
end
| Parsetree.Psig_modtype {Parsetree.pmtd_name=name} as m ->
if is_erased name.txt erased then acc else take_item m
+ | Parsetree.Psig_modtypesubst _ -> acc
| Parsetree.Psig_recmodule mods ->
(match List.filter
(fun pmd ->
let (maybe_more, mods) = f ~first: true 0 pos_start_ele decls in
(maybe_more, new_env, mods)
- | Parsetree.Psig_modtype {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl} ->
+ | Parsetree.Psig_modtype {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl}
+ | Parsetree.Psig_modtypesubst {Parsetree.pmtd_name=name; pmtd_type=pmodtype_decl} ->
let complete_name = Name.concat current_module_name name.txt in
let sig_mtype =
try Signature_search.search_module_type table name.txt
by associating the comment found in the parsetree of each constructor/field, if any.*)
val get_type_kind :
Odoc_env.env -> (string * Odoc_types.info option) list ->
- Types.type_kind -> Odoc_type.type_kind
+ Types.type_decl_kind -> Odoc_type.type_kind
(** This function converts a [Types.constructor_arguments] into a
[Odoc_type.constructor_args], by associating the comment found
let rec is_arrow_type t =
match t.Types.desc with
Types.Tarrow _ -> true
- | Types.Tlink t2 | Types.Tsubst t2 -> is_arrow_type t2
+ | Types.Tlink t2 -> is_arrow_type t2
| Types.Ttuple _
| Types.Tconstr _
| Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
| Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
+ | Types.Tsubst _ -> assert false
let raw_string_of_type_list sep type_list =
let buf = Buffer.create 256 in
let rec need_parent t =
match t.Types.desc with
Types.Tarrow _ | Types.Ttuple _ -> true
- | Types.Tlink t2 | Types.Tsubst t2 -> need_parent t2
- | Types.Tconstr _ ->
- false
+ | Types.Tlink t2 -> need_parent t2
+ | Types.Tconstr _
| Types.Tvar _ | Types.Tunivar _ | Types.Tobject _ | Types.Tpoly _
| Types.Tfield _ | Types.Tnil | Types.Tvariant _ | Types.Tpackage _ -> false
+ | Types.Tsubst _ -> assert false
in
let print_one_type variance t =
Printtyp.mark_loops t;
[ ( match info.i_deprecated with
| None -> []
| Some t ->
- (Raw (Odoc_messages.deprecated ^ " ")) ::
+ (Raw (Odoc_messages.deprecated ^ ". ")) ::
(self#fix_linebreaks t)
@ [ Newline ; Newline ] ) ;
self#text_of_desc info.i_desc ;
let t =
(match info.i_deprecated with
None -> []
- | Some t -> ( Italic [Raw (Odoc_messages.deprecated^" ")] ) :: t
+ | Some t -> ( Italic [Raw (Odoc_messages.deprecated^". ")] ) :: t
) @
(match info.i_desc with
None -> []
Types.Tarrow (l, t1, t2, _) ->
(l, t1) :: (iter t2)
| Types.Tlink texp
- | Types.Tsubst texp ->
- iter texp
| Types.Tpoly (texp, _) -> iter texp
| Types.Tvar _
| Types.Ttuple _
| Types.Tpackage _
| Types.Tvariant _ ->
[]
+ | Types.Tsubst _ ->
+ assert false
in
iter typ
{ Odoc_parameter.sn_name = normal_name label ;
Odoc_parameter.sn_type = t ;
Odoc_parameter.sn_text = None }
- | Types.Tlink t2
- | Types.Tsubst t2 ->
+ | Types.Tlink t2 ->
(iter (label, t2))
-
+ | Types.Tsubst _ ->
+ assert false
| _ ->
Odoc_parameter.Simple_name
{ Odoc_parameter.sn_name = normal_name label ;
ifeq "$(UNIX_OR_WIN32)" "win32"
ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)" | cygpath -w -f -)
+ CSC := csc
+ ifeq "$(HOST:i686-%=i686)" "i686"
+ CSCFLAGS := /platform:x86
+ else
+ CSCFLAGS :=
+ endif
+ CSCFLAGS += /nologo /nowarn:1668
else
ocamlsrcdir := $(abspath $(shell pwd)/..)
+ CSC :=
+ CSCFLAGS :=
endif
mkexe := $(MKEXE)
ifeq "$(TOOLCHAIN)" "msvc"
CPP := $(CPP) 2> nul
-CSC := csc
-ifeq "$(HOST)" "i686-pc-windows"
-CSCFLAGS := /platform:x86
-else
-CSCFLAGS :=
-endif
-CSCFLAGS += /nologo /nowarn:1668
-else
-CSC :=
-CSCFLAGS :=
endif
ifeq "$(WITH_OCAMLDOC)" "ocamldoc"
cmx_files := $(ml_files:.ml=.cmx)
-ocaml_objects := $(ml_files:.ml=.$(O))
-
# List of .mli files for ocamldep
mli_files := \
$(filter %.mli,$(subst .mly,.mli,$(sources)))
flags := -g -nostdlib $(include_directories) \
-strict-sequence -safe-string -strict-formats \
- -w +a-4-9-41-42-44-45-48 -warn-error A
+ -w +a-4-9-41-42-44-45-48 -warn-error +A
ocamlc = $(BEST_OCAMLC) $(flags)
depflags := -slash
depincludes :=
-ocamllex := $(BEST_OCAMLLEX)
-
-ocamlyacc := $(ROOTDIR)/yacc/ocamlyacc$(EXE)
-
-ocamlcdefaultflags :=
-
-ocamloptdefaultflags := $(shell ./getocamloptdefaultflags $(TARGET))
-
.SECONDARY: $(lexers:.mll=.ml) $(parsers:.mly=.mli) $(parsers:.mly=.ml)
.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
%.cmi: %.mli $(deps_byte)
$(ocamlc) -c $<
-%.ml %.mli: %.mly
- $(ocamlyacc) $<
-
-%.ml: %.mll
- $(ocamllex) $(OCAMLLEX_FLAGS) $<
-
ocamltest_unix.ml: ocamltest_unix_$(ocamltest_unix).ml
echo '# 1 "$^"' > $@
cat $^ >> $@
ocamltest_config.ml: ocamltest_config.ml.in Makefile ../Makefile.config
sed $(call SUBST,AFL_INSTRUMENT) \
- $(call SUBST,RUNTIMEI) \
+ $(call SUBST,INSTRUMENTED_RUNTIME) \
$(call SUBST,ARCH) \
$(call SUBST,SUPPORTS_SHARED_LIBRARIES) \
$(call SUBST,unix) \
$(call SUBST,str) \
$(call SUBST,SYSTEM) \
$(call SUBST_STRING,CPP) \
- $(call SUBST_STRING,ocamlcdefaultflags) \
- $(call SUBST_STRING,ocamloptdefaultflags) \
$(call SUBST_STRING,ocamlsrcdir) \
$(call SUBST,FLAMBDA) \
$(call SUBST,FORCE_SAFE_STRING) \
$(call SUBST,WITH_OCAMLDOC) \
$(call SUBST,WITH_OCAMLDEBUG) \
$(call SUBST,O) \
+ $(call SUBST,A) \
$(call SUBST,S) \
$(call SUBST,NATIVE_COMPILER) \
$(call SUBST,NATDYNLINK) \
(Environments.safe_lookup variable env)
with _ -> 0
-let files env = words_of_variable env Builtin_variables.files
+let readonly_files env = words_of_variable env Builtin_variables.readonly_files
+
+let subdirectories env = words_of_variable env Builtin_variables.subdirectories
let setup_symlinks test_source_directory build_directory files =
let symlink filename =
Sys.make_directory build_directory;
List.iter f files
+let setup_subdirectories source_directory build_directory subdirs =
+ let full_src_path name = Filename.concat source_directory name in
+ let full_dst_path name = Filename.concat build_directory name in
+ let cp_dir name =
+ Sys.copy_directory (full_src_path name) (full_dst_path name)
+ in
+ List.iter cp_dir subdirs
+
let setup_build_env add_testfile additional_files (_log : out_channel) env =
+ let source_dir = (test_source_directory env) in
let build_dir = (test_build_directory env) in
- let some_files = additional_files @ (files env) in
+ let some_files = additional_files @ (readonly_files env) in
let files =
if add_testfile
then (testfile env) :: some_files
else some_files in
- setup_symlinks (test_source_directory env) build_dir files;
+ setup_symlinks source_dir build_dir files;
+ let subdirs = subdirectories env in
+ setup_subdirectories source_dir build_dir subdirs;
Sys.chdir build_dir;
(Result.pass, env)
?(stdout_variable=Builtin_variables.stdout)
?(stderr_variable=Builtin_variables.stderr)
?(append=false)
- ?(timeout=0)
+ ?timeout
log env original_cmd
=
let log_redirection std filename =
environment
(Environments.to_system_env env)
in
+ let timeout =
+ match timeout with
+ | Some timeout -> timeout
+ | None ->
+ Option.value ~default:0
+ (Environments.lookup_as_int Builtin_variables.timeout env)
+ in
let n =
Run_command.run {
Run_command.progname = progname;
Builtin_variables.ocamltest_response response_file input_env in
let systemenv =
Environments.to_system_env hookenv in
+ let timeout =
+ Option.value ~default:0
+ (Environments.lookup_as_int Builtin_variables.timeout input_env) in
let open Run_command in
let settings = {
progname = "sh";
stdout_filename = "";
stderr_filename = "";
append = false;
- timeout = 0;
+ timeout = timeout;
log = log;
} in let exit_status = run settings in
let final_value = match exit_status with
val exit_status_of_variable : Environments.t -> Variables.t -> int
-val files : Environments.t -> string list
+val readonly_files : Environments.t -> string list
val setup_symlinks : string -> string -> string list -> unit
(fun log env ->
Environments.dump log env; (Result.pass, env))
-let hasinstrumentedruntime = make
- "hasinstrumentedruntime"
- (Actions_helpers.pass_or_skip (Ocamltest_config.has_instrumented_runtime)
- "instrumented runtime available"
- "instrumented runtime not available")
-
let hasunix = make
"hasunix"
(Actions_helpers.pass_or_skip (Ocamltest_config.libunix <> None)
Builtin_variables.output
Builtin_variables.reference)
+let file_exists_action _log env =
+ match Environments.lookup Builtin_variables.file env with
+ | None ->
+ let reason = reason_with_fallback env "the file variable is undefined" in
+ let result = Result.fail_with_reason reason in
+ (result, env)
+ | Some filename ->
+ if Sys.file_exists filename
+ then begin
+ let default_reason = Printf.sprintf "File %s exists" filename in
+ let reason = reason_with_fallback env default_reason in
+ let result = Result.pass_with_reason reason in
+ (result, env)
+ end else begin
+ let default_reason =
+ Printf.sprintf "File %s does not exist" filename
+ in
+ let reason = reason_with_fallback env default_reason in
+ let result = Result.fail_with_reason reason in
+ (result, env)
+ end
+let file_exists = make "file-exists" file_exists_action
+
+let copy_action log env =
+ let do_copy src dst =
+ let (entry_type, f) =
+ if Sys.is_directory src
+ then ("directory", Sys.copy_directory)
+ else ("file", Sys.copy_file)
+ in
+ Printf.fprintf log "Copying %s %s to %s\n%!" entry_type src dst;
+ f src dst
+ in
+ let src = Environments.lookup Builtin_variables.src env in
+ let dst = Environments.lookup Builtin_variables.dst env in
+ match (src, dst) with
+ | (None, _) | (_, None) ->
+ let reason = reason_with_fallback env "src or dst are undefined" in
+ let result = Result.fail_with_reason reason in
+ (result, env)
+ | (Some src, Some dst) ->
+ let f =
+ if String.ends_with ~suffix:"/" dst
+ then fun src -> do_copy src (dst ^ (Filename.basename src))
+ else fun src -> do_copy src dst
+ in
+ List.iter f (String.words src);
+ (Result.pass, env)
+
+let copy = make "copy" copy_action
+
let initialize_test_exit_status_variables _log env =
Environments.add_bindings
[
fail;
cd;
dumpenv;
- hasinstrumentedruntime;
hasunix;
hassysthreads;
hasstr;
arch64;
has_symlink;
setup_build_env;
+ setup_simple_build_env;
run;
script;
check_program_output;
arch_i386;
arch_power;
function_sections;
- naked_pointers
+ naked_pointers;
+ file_exists;
+ copy;
]
val script : Actions.t
val check_program_output : Actions.t
+
+val file_exists : Actions.t
+
+val copy : Actions.t
let commandline = Variables.make ("commandline",
"Specify the commandline of a tool")
+let dst = Variables.make ("dst", "Location where to copy files and directories")
+
let exit_status = Variables.make ("exit_status",
"Expected program exit status")
-let files = Variables.make ("files",
- "Files used by the tests")
+let file = Variables.make ("file",
+ "File whose existence should be tested")
+
+let readonly_files = Variables.make ("readonly_files",
+ "Files which are only read by the tests")
let make = Variables.make ("MAKE",
"Command used to invoke make")
let script = Variables.make ("script",
"External script to run")
+let src = Variables.make ("src", "Files and directories to copy")
+
let stdin = Variables.make ("stdin", "Default standard input")
let stdout = Variables.make ("stdout", "Default standard output")
let stderr = Variables.make ("stderr", "Default standard error")
+let subdirectories = Variables.make ("subdirectories",
+ "Subdirectories to copy recursively from test source to test build directory")
+
let test_build_directory = Variables.make ("test_build_directory",
"Directory for files produced during a test")
let test_fail = Variables.make ("TEST_FAIL",
"Exit code to let a script report failure")
-
+let timeout = Variables.make ("timeout",
+ "Maximal execution time for every command (in seconds)")
let _ = List.iter Variables.register_variable
[
arguments;
cwd;
commandline;
+ dst;
exit_status;
- files;
+ file;
+ readonly_files;
make;
ocamltest_response;
ocamltest_log;
program; program2;
reason;
reference;
+ src;
skip_header_lines;
skip_header_bytes;
script;
stdin;
stdout;
stderr;
+ subdirectories;
test_build_directory;
test_file;
test_source_directory;
test_pass;
test_skip;
test_fail;
+ timeout;
]
val commandline : Variables.t
+val dst : Variables.t
+
val exit_status : Variables.t
-val files : Variables.t
+val file : Variables.t
+
+val readonly_files : Variables.t
val make : Variables.t
val script : Variables.t
+val src : Variables.t
+
val stdin : Variables.t
val stdout : Variables.t
val stderr : Variables.t
+val subdirectories : Variables.t
+
val test_build_directory : Variables.t
val test_build_directory_prefix : Variables.t
val test_skip : Variables.t
val test_fail : Variables.t
+
+val timeout : Variables.t
../Makefile.common
../Makefile.best_binaries
Makefile
- ./ocamltest_config.ml.in
- ./getocamloptdefaultflags)
+ ./ocamltest_config.ml.in)
(action (run make %{targets} COMPUTE_DEPS=false)))
;; FIXME: handle UNIX_OR_WIN32 or something similar
| Some "true" -> Some true
| Some _ -> Some false
+let lookup_as_int variable env =
+ match lookup variable env with
+ | None -> None
+ | Some value ->
+ int_of_string_opt value
+
let safe_lookup variable env = match lookup variable env with
| None -> ""
| Some value -> value
[Some false] if it is set to another string, and
[None] if not set. *)
+val lookup_as_int : Variables.t -> t -> int option
+(** returns [Some n] if the variable is set to a string
+ representation of the integer [n],
+ and [None] if it is not an integer or not set. *)
+
val add : Variables.t -> string -> t -> t
val add_if_undefined : Variables.t -> string -> t -> t
val add_bindings : (Variables.t * string) list -> t -> t
+++ /dev/null
-#!/bin/sh
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Sebastien Hinderer, projet Gallium, INRIA Paris *
-#* *
-#* Copyright 2016 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-# This script provides command-line options to use by default
-# when invoking ocamlopt
-
-# It is used to add that disable annoying linker warnings on some versions
-# of OpenBSD
-
-case "$1" in
- i386-*-openbsd5.[5-9]*|i386-*-openbsd[6-9].*)
- echo "-ccopt -nopie";;
-esac
let summary = Sys.with_chdir test_build_directory_prefix
(fun () ->
let promote = string_of_bool Options.promote in
+ let default_timeout = string_of_int Options.default_timeout in
let install_hook name =
let hook_name = Filename.make_filename hookname_prefix name in
if Sys.file_exists hook_name then begin
Builtin_variables.test_build_directory_prefix,
test_build_directory_prefix;
Builtin_variables.promote, promote;
+ Builtin_variables.timeout, default_timeout;
] in
let rootenv =
Environments.initialize Environments.Pre log initial_environment in
flags env;
"-S " ^ testfile
] in
- let expected_exit_status = 0 in
+ let expected_exit_status =
+ Actions_helpers.exit_status_of_variable env
+ Ocaml_variables.codegen_exit_status
+ in
let exit_status =
Actions_helpers.run_cmd
~environment:default_ocaml_env
log env commandline in
if exit_status=expected_exit_status
then begin
- let finalise =
- if Ocamltest_config.ccomptype="msvc"
- then finalise_codegen_msvc
- else finalise_codegen_cc
- in
- finalise testfile_basename log env
+ if exit_status=0
+ then begin
+ let finalise =
+ if Ocamltest_config.ccomptype="msvc"
+ then finalise_codegen_msvc
+ else finalise_codegen_cc
+ in
+ finalise testfile_basename log env
+ end else (Result.pass, env)
end else begin
let reason =
(Actions_helpers.mkreason
Ocaml_variables.nativecc_libs, Ocamltest_config.nativecc_libs;
Ocaml_variables.mkdll,
Sys.getenv_with_default_value "MKDLL" Ocamltest_config.mkdll;
- Ocaml_variables.mkexe, Ocamltest_config.mkexe;
+ Ocaml_variables.mkexe,
+ Sys.getenv_with_default_value "MKEXE" Ocamltest_config.mkexe;
Ocaml_variables.c_preprocessor, Ocamltest_config.c_preprocessor;
Ocaml_variables.cc, Ocamltest_config.cc;
Ocaml_variables.csc, Ocamltest_config.csc;
Ocaml_variables.shared_library_cflags,
Ocamltest_config.shared_library_cflags;
Ocaml_variables.objext, Ocamltest_config.objext;
+ Ocaml_variables.libext, Ocamltest_config.libext;
Ocaml_variables.asmext, Ocamltest_config.asmext;
Ocaml_variables.sharedobjext, Ocamltest_config.sharedobjext;
Ocaml_variables.ocamlc_default_flags,
"debugger available"
"debugger not available")
+let instrumented_runtime = make
+ "instrumented-runtime"
+ (Actions_helpers.pass_or_skip (Ocamltest_config.instrumented_runtime)
+ "instrumented runtime available"
+ "instrumented runtime not available")
+
let csharp_compiler = Actions.make
"csharp-compiler"
(Actions_helpers.pass_or_skip (Ocamltest_config.csc<>"")
native_compiler;
native_dynlink;
debugger;
+ instrumented_runtime;
csharp_compiler;
windows_unicode;
afl_instrument;
check_ocamlc_byte_output;
run;
check_program_output;
- ] @ (if Ocamltest_config.arch<>"none" then opt_actions else [])
+ ] @ (if Ocamltest_config.native_compiler then opt_actions else [])
}
let native =
("ld_library_path",
"List of paths to lookup for loading dynamic libraries")
+let codegen_exit_status = make ("codegen_exit_status",
+ "Expected exit status of codegen")
+
let compare_programs = make ("compare_programs",
"Set to \"false\" to disable program comparison")
let objext = make ("objext",
"Extension of object files")
+let libext = make ("libext",
+ "Extension of library files")
+
let asmext = make ("asmext",
"Extension of assembly files")
bytecc_libs;
c_preprocessor;
caml_ld_library_path;
+ codegen_exit_status;
compare_programs;
compiler_directory_suffix;
compiler_reference;
modules;
nativecc_libs;
objext;
+ libext;
asmext;
ocamlc_byte;
ocamlopt_byte;
val caml_ld_library_path : Variables.t
+val codegen_exit_status : Variables.t
+
val compare_programs : Variables.t
val compiler_directory_suffix : Variables.t
(** Libraries to link with for native code *)
val objext : Variables.t
+val libext : Variables.t
val asmext : Variables.t
val ocamlc_byte : Variables.t
let objext = "%%O%%"
+let libext = "%%A%%"
+
let asmext = "%%S%%"
let system = "%%SYSTEM%%"
let flambda = %%FLAMBDA%%
-let ocamlc_default_flags = "%%ocamlcdefaultflags%%"
-let ocamlopt_default_flags = "%%ocamloptdefaultflags%%"
+let ocamlc_default_flags = ""
+let ocamlopt_default_flags = ""
let safe_string = %%FORCE_SAFE_STRING%%
let function_sections = %%FUNCTION_SECTIONS%%
-let has_instrumented_runtime = %%RUNTIMEI%%
+let instrumented_runtime = %%INSTRUMENTED_RUNTIME%%
let naked_pointers = %%NAKED_POINTERS%%
val objext : string
(** Extension of object files *)
+val libext : string
+(** Extension of library files *)
+
val asmext : string
(** Extension of assembly files *)
(** Whether the compiler was configured to generate
each function in a separate section *)
-val has_instrumented_runtime : bool
+val instrumented_runtime : bool
(** Whether the instrumented runtime is available *)
val naked_pointers : bool
end else begin
let j = i+1 in
match s.[i] with
- | '\'' -> f (not quote) w ws j
+ | '\''
+ | '"' as c ->
+ begin
+ match quote with
+ | None ->
+ (* Begin quoted word *)
+ f (Some c) w ws j
+ | Some quote_char when quote_char = c ->
+ (* End quoted word *)
+ f None w ws j
+ | _ ->
+ (* Continue string *)
+ f quote (w ^ (string_of_char c)) ws j
+ end
| ' ' ->
begin
- if quote
- then f true (w ^ (string_of_char ' ')) ws j
+ if quote <> None
+ then f quote (w ^ (string_of_char ' ')) ws j
else begin
if w=""
- then f false w ws j
- else f false "" (w::ws) j
+ then f None w ws j
+ else f None "" (w::ws) j
end
end
| _ as c -> f quote (w ^ (string_of_char c)) ws j
end in
- if l=0 then [] else f false "" [] 0
+ if l=0 then [] else f None "" [] 0
end
module Sys = struct
let rm_rf path =
let rec erase path =
- if Sys.is_directory path then begin
- Array.iter (fun entry -> erase (Filename.concat path entry))
- (Sys.readdir path);
- Sys.rmdir path
- end else erase_file path
+ (* Sys.file_exists will return false for dangling symlinks *)
+ if Sys.file_exists path then
+ if Sys.is_directory path then begin
+ (* path might be a symlink to a directory *)
+ try Sys.remove path
+ with Sys_error _ ->
+ (* path is definitely a directory, not a symlink to a directory *)
+ Array.iter (fun entry -> erase (Filename.concat path entry))
+ (Sys.readdir path);
+ Sys.rmdir path
+ end else erase_file path
+ else erase_file path
in
- try if Sys.file_exists path then erase path
- with Sys_error err ->
- raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err))
+ if Sys.file_exists path then
+ try erase path
+ with Sys_error err ->
+ raise (Sys_error (Printf.sprintf "Failed to remove %S (%s)" path err))
+ else
+ (* path could be a dangling symlink *)
+ try Sys.remove path
+ with Sys_error _ -> ()
let rec make_directory dir =
if Sys.file_exists dir then ()
let copy_chan ic oc =
let m = in_channel_length ic in
let m = (m lsr 12) lsl 12 in
- let m = max 16384 (min Sys.max_string_length m) in
+ let m = Int.max 16384 (Int.min Sys.max_string_length m) in
let buf = Bytes.create m in
let rec loop () =
let len = input ic buf 0 m in
with_output_file ~bin:true dest @@ fun oc ->
copy_chan ic oc
+ let rec copy_directory src dst =
+ let full_src_path name = Filename.concat src name in
+ let full_dst_path name = Filename.concat dst name in
+ make_directory dst;
+ let content = Array.to_list (readdir src) in
+ let is_directory d = is_directory (full_src_path d) in
+ let (subdirs, files) = List.partition is_directory content in
+ let cp_file name = copy_file (full_src_path name) (full_dst_path name) in
+ List.iter cp_file files;
+ let cp_dir name =
+ copy_directory (full_src_path name) (full_dst_path name)
+ in
+ List.iter cp_dir subdirs
+
let force_remove file =
if file_exists file then remove file
val dump_file : out_channel -> ?prefix:string -> string -> unit
val copy_chan : in_channel -> out_channel -> unit
val copy_file : string -> string -> unit
+ val copy_directory : string -> string -> unit
val force_remove : string -> unit
val with_chdir : string -> (unit -> 'a) -> 'a
val getenv_with_default_value : string -> string -> string
let promote = ref false
+let default_timeout = ref 0
+
let keep_test_dir_on_success = ref false
let find_test_dirs = ref []
("-show-actions", Arg.Unit show_actions, " Show available actions.");
("-show-tests", Arg.Unit show_tests, " Show available tests.");
("-show-variables", Arg.Unit show_variables, " Show available variables.");
+ ("-timeout",
+ Arg.Int (fun t -> if t >= 0
+ then default_timeout := t
+ else raise (Arg.Bad "negative timeout")),
+ "<seconds> Set maximal execution time for every command (in seconds)");
("-find-test-dirs", Arg.String (add_to_list find_test_dirs),
" Find directories that contain tests (recursive).");
("-list-tests", Arg.String (add_to_list list_tests),
let log_to_stderr = !log_to_stderr
let files_to_test = !files_to_test
let promote = !promote
+let default_timeout = !default_timeout
let find_test_dirs = !find_test_dirs
let list_tests = !list_tests
let keep_test_dir_on_success = !keep_test_dir_on_success
val promote : bool
+val default_timeout : int
+
val usage : string
val find_test_dirs : string list
if ((settings->timeout > 0) && (timeout_expired))
{
timeout_expired = 0;
- fprintf(stderr, "Timeout expired, killing all child processes");
+ fprintf(stderr, "Timeout expired, killing all child processes\n");
if (kill(-child_pid, SIGKILL) == -1) myperror("kill");
};
break;
/* */
/**************************************************************************/
-/* Run programs with rediretions and timeouts under Windows */
+/* Run programs with redirections and timeouts under Windows */
+
+/* GetTickCount64() requires Windows Vista or Server 2008 */
+#define _WIN32_WINNT 0x0600
#include <stdio.h>
#include <stdlib.h>
STARTUPINFO startup_info;
PROCESS_INFORMATION process_info;
BOOL wait_result;
- DWORD status, stamp, cur;
+ DWORD status;
+ ULONGLONG stamp, cur;
DWORD timeout = (settings->timeout > 0) ? settings->timeout * 1000 : INFINITE;
JOBOBJECT_ASSOCIATE_COMPLETION_PORT port = {NULL, NULL};
ResumeThread(process_info.hThread);
CloseHandle(process_info.hThread);
- stamp = GetTickCount();
+ stamp = GetTickCount64();
while ((wait_result = GetQueuedCompletionStatus(port.CompletionPort,
&completion_code,
&completion_key,
{
if (timeout != INFINITE)
{
- cur = GetTickCount();
- stamp = (cur > stamp ? cur - stamp : MAXDWORD - stamp + cur);
- timeout = (timeout > stamp ? timeout - stamp : 0);
- stamp = cur;
+ cur = GetTickCount64();
+ if (cur > stamp) {
+ ULONGLONG elapsed = cur - stamp;
+ timeout = (timeout > elapsed ? timeout - elapsed : 0);
+ stamp = cur;
+ }
}
}
if (wait_result)
| blank * { token lexbuf }
| newline { Lexing.new_line lexbuf; token lexbuf }
| "/*" blank* "TEST" { TSL_BEGIN_C_STYLE }
+ | "/*" blank* "TEST_BELOW" _ * "/*" blank* "TEST" { TSL_BEGIN_C_STYLE }
| "*/" { TSL_END_C_STYLE }
| "(*" blank* "TEST" { TSL_BEGIN_OCAML_STYLE }
+ | "(*" blank* "TEST_BELOW" _ * "(*" blank* "TEST" { TSL_BEGIN_OCAML_STYLE }
| "*)" { TSL_END_OCAML_STYLE }
| "," { COMMA }
| '*'+ { TEST_DEPTH (String.length (Lexing.lexeme lexbuf)) }
include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-
CAMLC := $(BEST_OCAMLC) -nostdlib -I $(ROOTDIR)/stdlib
CAMLOPT := $(BEST_OCAMLOPT) -nostdlib -I $(ROOTDIR)/stdlib
OC_CPPFLAGS += -I$(ROOTDIR)/runtime $(EXTRACPPFLAGS)
# Compilation options
-COMPFLAGS=-absname -w +a-4-9-41-42-44-45-48 -warn-error A -bin-annot -g \
+COMPFLAGS=-absname -w +a-4-9-41-42-44-45-48 -warn-error +A -bin-annot -g \
-safe-string -strict-sequence -strict-formats $(EXTRACAMLFLAGS)
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
endif
-MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib
+MKLIB=$(OCAMLRUN) $(ROOTDIR)/tools/ocamlmklib
# Variables that must be defined by individual libraries:
# LIBNAME
rm -f *.dll *.so *.a *.lib *.o *.obj
rm -rf $(DEPDIR)
-.SUFFIXES: .ml .mli .cmi .cmo .cmx
-
-.mli.cmi:
+%.cmi: %.mli
$(CAMLC) -c $(COMPFLAGS) $<
-.ml.cmo:
+%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) $<
-.ml.cmx:
+%.cmx: %.ml
$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
ifeq "$(COMPUTE_DEPS)" "true"
.PHONY: depend
depend:
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
include $(ROOTDIR)/Makefile.common
include $(ROOTDIR)/Makefile.best_binaries
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun$(EXE)
-
OCAMLC=$(BEST_OCAMLC) -g -nostdlib -I $(ROOTDIR)/stdlib
OCAMLOPT=$(BEST_OCAMLOPT) -g -nostdlib -I $(ROOTDIR)/stdlib
# COMPFLAGS should be in sync with the toplevel Makefile's COMPFLAGS.
-COMPFLAGS=-strict-sequence -principal -absname -w +a-4-9-40-41-42-44-45-48-66 \
- -warn-error A \
+COMPFLAGS=-strict-sequence -principal -absname \
+ -w +a-4-9-40-41-42-44-45-48-66-70 \
+ -warn-error +A \
-bin-annot -safe-string -strict-formats
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
utils/local_store.ml \
utils/load_path.ml \
utils/int_replace_polymorphic_compare.ml \
+ utils/lazy_backtrack.ml \
parsing/location.ml \
parsing/longident.ml \
parsing/docstrings.ml \
depend: beforedepend
touch $(DEPEND_DUMMY_FILES)
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
-I byte -bytecode *.mli *.ml byte/dynlink.ml > .depend
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash \
-I native -native *.ml native/dynlink.ml >> .depend
rm -f $(DEPEND_DUMMY_FILES)
include .depend
-.SUFFIXES: .ml .mli .cmi .cmo .cmx
-
-.mli.cmi:
+%.cmi: %.mli
$(OCAMLC) -c $(COMPFLAGS) $<
-.ml.cmo:
+%.cmo: %.ml
$(OCAMLC) -c $(COMPFLAGS) $<
-.ml.cmx:
+%.cmx: %.ml
$(OCAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
were privately loaded. *)
}
- let invariant t =
- let ifaces = String.Map.keys t.ifaces in
- let implems = String.Map.keys t.implems in
- assert (String.Set.subset implems ifaces);
- assert (String.Set.subset t.main_program_units ifaces);
- assert (String.Set.subset t.main_program_units implems);
- assert (String.Set.subset t.public_dynamically_loaded_units ifaces);
- assert (String.Set.subset t.public_dynamically_loaded_units implems)
-
let empty = {
ifaces = String.Map.empty;
implems = String.Map.empty;
public_dynamically_loaded_units;
}
in
- State.invariant state;
state
end
.PHONY: depend
depend:
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
numregisters: int; (* number of nullable Star or Plus *)
startchars: int (* index of set of starting chars, or -1 if none *)
}
+[@@warning "-unused-field"]
(** Opcodes for bytecode instructions; see strstubs.c for description *)
emit_instr op_BEGGROUP n;
emit_code r;
emit_instr op_ENDGROUP n;
- numgroups := max !numgroups (n+1)
+ numgroups := Int.max !numgroups (n+1)
| Refgroup n ->
emit_instr op_REFGROUP n;
- numgroups := max !numgroups (n+1)
+ numgroups := Int.max !numgroups (n+1)
| Bol ->
emit_instr op_BOL 0
| Eol ->
(** [matched_group n s] returns the substring of [s] that was matched
by the [n]th group [\(...\)] of the regular expression that was
matched by the last call to a matching or searching function (see
- {!Str.matched_string} for details).
+ {!Str.matched_string} for details). When [n] is [0], it returns the
+ substring matched by the whole regular expression.
The user must make sure that the parameter [s] is the same string
that was passed to the matching or searching function.
@raise Not_found if the [n]th group
OC_CFLAGS += -g
endif
-OC_CFLAGS += $(SHAREDLIB_CFLAGS) $(PTHREAD_CFLAGS)
+OC_CFLAGS += $(SHAREDLIB_CFLAGS)
OC_CPPFLAGS += -I$(ROOTDIR)/runtime
NATIVE_CPPFLAGS = \
-DNATIVE_CODE -DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM)
-CAMLRUN ?= $(ROOTDIR)/boot/ocamlrun
-
LIBS = -nostdlib -I $(ROOTDIR)/stdlib -I $(ROOTDIR)/otherlibs/$(UNIXLIB)
CAMLC=$(BEST_OCAMLC) $(LIBS)
CAMLOPT=$(BEST_OCAMLOPT) $(LIBS)
-MKLIB=$(CAMLRUN) $(ROOTDIR)/tools/ocamlmklib$(EXE)
-COMPFLAGS=-w +33..39 -warn-error A -g -bin-annot -safe-string
+MKLIB=$(OCAMLRUN) $(ROOTDIR)/tools/ocamlmklib$(EXE)
+COMPFLAGS=-w +33..39 -warn-error +A -g -bin-annot -safe-string
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
endif
allopt: lib$(LIBNAME)nat.$(A) $(LIBNAME).cmxa $(CMIFILES)
lib$(LIBNAME).$(A): $(BYTECODE_C_OBJS)
- $(MKLIB_CMD) -o $(LIBNAME) $(BYTECODE_C_OBJS) $(PTHREAD_LINK)
+ $(MKLIB_CMD) -o $(LIBNAME) $(BYTECODE_C_OBJS) $(PTHREAD_LIBS)
lib$(LIBNAME)nat.$(A): $(NATIVECODE_C_OBJS)
$(MKLIB_CMD) -o $(LIBNAME)nat $^
$(LIBNAME).cma: $(THREADS_BCOBJS)
ifeq "$(UNIX_OR_WIN32)" "unix"
$(MKLIB) -o $(LIBNAME) -ocamlc '$(CAMLC)' -cclib -lunix -linkall \
- $(PTHREAD_CAML_LINK) $^
+ $(PTHREAD_CAML_LIBS) $^
# TODO: Figure out why -cclib -lunix is used here.
# It may be because of the threadsUnix module which is deprecated.
# It may hence be good to figure out whether this module shouldn't be
# removed, and then -cclib -lunix arguments.
else # Windows
$(MKLIB) -o $(LIBNAME) -ocamlc "$(CAMLC)" -linkall \
- $(PTHREAD_CAML_LINK) $^
+ $(PTHREAD_CAML_LIBS) $^
endif
# See remark above: force static linking of libthreadsnat.a
$(LIBNAME).cmxa: $(THREADS_NCOBJS)
- $(CAMLOPT) -linkall -a -cclib -lthreadsnat $(PTHREAD_CAML_LINK) -o $@ $^
+ $(CAMLOPT) -linkall -a -cclib -lthreadsnat $(PTHREAD_CAML_LIBS) -o $@ $^
# Note: I removed "-cclib -lunix" from the line above.
# Indeed, if we link threads.cmxa, then we must also link unix.cmxa,
"$(INSTALL_THREADSLIBDIR)"
cd "$(INSTALL_THREADSLIBDIR)" && $(RANLIB) threads.$(A)
-.SUFFIXES: .ml .mli .cmo .cmi .cmx
-
-.mli.cmi:
+%.cmi: %.mli
$(CAMLC) -c $(COMPFLAGS) $<
-.ml.cmo:
+%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) $<
-.ml.cmx:
+%.cmx: %.ml
$(CAMLOPT) -c $(COMPFLAGS) $(OPTCOMPFLAGS) $<
DEP_FILES := st_stubs.b.$(D)
.PHONY: depend
depend:
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
static void caml_thread_leave_blocking_section(void)
{
+#ifdef _WIN32
+ /* TlsGetValue calls SetLastError which will mask any error which occurred
+ prior to the caml_thread_leave_blocking_section call. EnterCriticalSection
+ does not do this. */
+ DWORD error = GetLastError();
+#endif
/* Wait until the runtime is free */
st_masterlock_acquire(&caml_master_lock);
/* Update curr_thread to point to the thread descriptor corresponding
curr_thread = st_tls_get(thread_descriptor_key);
/* Restore the runtime state from the curr_thread descriptor */
caml_thread_restore_runtime_state();
+#ifdef _WIN32
+ SetLastError(error);
+#endif
}
/* Hooks for I/O locking */
gettimeofday.o getserv.o getsockname.o getuid.o gmtime.o \
initgroups.o isatty.o itimer.o kill.o link.o listen.o lockf.o lseek.o \
mkdir.o mkfifo.o mmap.o mmap_ba.o \
- nice.o open.o opendir.o pipe.o putenv.o read.o \
+ nice.o open.o opendir.o pipe.o putenv.o read.o realpath.o \
readdir.o readlink.o rename.o rewinddir.o rmdir.o select.o sendrecv.o \
setgid.o setgroups.o setsid.o setuid.o shutdown.o signals.o \
sleep.o socket.o socketaddr.o \
.PHONY: depend
depend:
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash *.mli *.ml > .depend
include .depend
if (Int_val(fd2) == Int_val(fd1)) {
/* In this case, dup3 fails and dup2 does nothing. */
/* Just apply the cloexec flag to fd2, if it is given. */
- if (Is_block(cloexec)) {
- if (Bool_val(Field(cloexec, 0)))
+ if (Is_some(cloexec)) {
+ if (Bool_val(Some_val(cloexec)))
unix_set_cloexec(Int_val(fd2), "dup2", Nothing);
else
unix_clear_cloexec(Int_val(fd2), "dup2", Nothing);
#include <errno.h>
#include <string.h>
-#include <caml/mlvalues.h>
#include <caml/alloc.h>
-
-extern int error_table[];
+#include "unixsupport.h"
CAMLprim value unix_error_message(value err)
{
- int errnum;
- errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)];
+ int errnum = code_of_unix_error(err);
return caml_copy_string(strerror(errnum));
}
p1 = caml_stat_strdup(String_val(path1));
p2 = caml_stat_strdup(String_val(path2));
caml_enter_blocking_section();
- if (follow == Val_int(0) /* None */)
+ if (Is_none(follow))
ret = link(p1, p2);
- else { /* Some bool */
+ else {
# ifdef AT_SYMLINK_FOLLOW
int flags =
- Is_block(follow) && Bool_val(Field(follow, 0)) /* Some true */
+ Is_some(follow) && Bool_val(Some_val(follow))
? AT_SYMLINK_FOLLOW
: 0;
ret = linkat(AT_FDCWD, p1, AT_FDCWD, p2, flags);
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* The OCaml programmers */
+/* */
+/* Copyright 2020 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include "unixsupport.h"
+
+#ifdef HAS_REALPATH
+
+CAMLprim value unix_realpath (value p)
+{
+ CAMLparam1 (p);
+ char *r;
+ value rp;
+
+ caml_unix_check_path (p, "realpath");
+ r = realpath (String_val (p), NULL);
+ if (r == NULL) { uerror ("realpath", p); }
+ rp = caml_copy_string (r);
+ free (r);
+ CAMLreturn (rp);
+}
+
+#else
+
+CAMLprim value unix_realpath (value p)
+{ caml_invalid_argument ("realpath not implemented"); }
+
+#endif
PF_UNIX, PF_INET,
#if defined(HAS_IPV6)
PF_INET6
-#elif defined(PF_UNDEF)
- PF_UNDEF
+#elif defined(PF_UNSPEC)
+ PF_UNSPEC
#else
0
#endif
#else
-CAMLprim value unix_socketpair(value domain, value type, value proto)
+CAMLprim value unix_socketpair(value cloexec, value domain, value type,
+ value proto)
{ caml_invalid_argument("socketpair not implemented"); }
#endif
return Val_int(optval.i);
case TYPE_LINGER:
if (optval.lg.l_onoff == 0) {
- return Val_int(0); /* None */
+ return Val_none;
} else {
- value res = caml_alloc_small(1, 0); /* Some */
- Field(res, 0) = Val_int(optval.lg.l_linger);
- return res;
+ return caml_alloc_some(Val_int(optval.lg.l_linger));
}
case TYPE_TIMEVAL:
return caml_copy_double((double) optval.tv.tv_sec
+ (double) optval.tv.tv_usec / 1e6);
case TYPE_UNIX_ERROR:
if (optval.i == 0) {
- return Val_int(0); /* None */
+ return Val_none;
} else {
value err, res;
err = unix_error_of_code(optval.i);
Begin_root(err);
- res = caml_alloc_small(1, 0); /* Some */
- Field(res, 0) = err;
+ res = caml_alloc_some(err);
End_roots();
return res;
}
break;
case TYPE_LINGER:
optsize = sizeof(optval.lg);
- optval.lg.l_onoff = Is_block (val);
+ optval.lg.l_onoff = Is_some(val);
if (optval.lg.l_onoff)
- optval.lg.l_linger = Int_val (Field (val, 0));
+ optval.lg.l_linger = Int_val(Some_val(val));
break;
case TYPE_TIMEVAL:
f = Double_val(val);
caml_unix_check_path(executable, "create_process");
path = String_val(executable);
argv = cstringvect(args, "create_process");
- if (Is_block(optenv)) {
- envp = cstringvect(Field(optenv, 0), "create_process");
+ if (Is_some(optenv)) {
+ envp = cstringvect(Some_val(optenv), "create_process");
} else {
envp = environ;
}
error:
posix_spawn_file_actions_destroy(&act);
cstringvect_free(argv);
- if (Is_block(optenv)) cstringvect_free(envp);
+ if (Is_some(optenv)) cstringvect_free(envp);
if (r != 0) unix_error(r, "create_process", executable);
return Val_long(pid);
}
caml_unix_check_path(executable, "create_process");
path = String_val(executable);
argv = cstringvect(args, "create_process");
- if (Is_block(optenv)) {
- envp = cstringvect(Field(optenv, 0), "create_process");
+ if (Is_some(optenv)) {
+ envp = cstringvect(Some_val(optenv), "create_process");
} else {
envp = NULL;
}
external unlink : string -> unit = "unix_unlink"
external rename : string -> string -> unit = "unix_rename"
external link : ?follow:bool -> string -> string -> unit = "unix_link"
+external realpath : string -> string = "unix_realpath"
module LargeFile =
struct
let pid = spawn shell [| shell; "-c"; cmd |] None false [| 0; 1; 2 |] in
snd(waitpid_non_intr pid)
-let create_process_gen usepath cmd args optenv
+let create_process_gen cmd args optenv
new_stdin new_stdout new_stderr =
let toclose = ref [] in
let close_after () =
(if new_stderr = 2 then 2 else file_descr_not_standard new_stderr)
|] in
Fun.protect ~finally:close_after
- (fun () -> spawn cmd args optenv usepath redirections)
+ (fun () -> spawn cmd args optenv true (* usepath *) redirections)
let create_process cmd args new_stdin new_stdout new_stderr =
- create_process_gen true cmd args None new_stdin new_stdout new_stderr
+ create_process_gen cmd args None new_stdin new_stdout new_stderr
let create_process_env cmd args env new_stdin new_stdout new_stderr =
- create_process_gen true cmd args (Some env) new_stdin new_stdout new_stderr
+ create_process_gen cmd args (Some env) new_stdin new_stdout new_stderr
type popen_process =
Process of in_channel * out_channel
let open_proc prog args envopt proc input output error =
let pid =
- create_process_gen false prog args envopt input output error in
+ create_process_gen prog args envopt input output error in
Hashtbl.add popen_processes proc pid
let open_process_args_in prog args =
When a new function is added which is not implemented on Windows (or
partially implemented), or the Windows-status of an existing function is
changed, remember to update the summary table in
- manual/manual/library/libunix.etex
+ manual/src/library/libunix.etex
*)
(** Interface to the Unix system.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows: [set_binary_mode_in] always fails on channels created
- with this function.
-
- Beware that channels are buffered so more characters may have been
- read from the file descriptor than those accessed using channel functions.
- Channels also keep a copy of the current position in the file.
-
- You need to explicitly close all channels created with this function.
- Closing the channel also closes the underlying file descriptor (unless
- it was already closed). *)
+ On Windows: {!Stdlib.set_binary_mode_in} always fails on channels
+ created with this function.
+
+ Beware that input channels are buffered, so more characters may
+ have been read from the descriptor than those accessed using
+ channel functions. Channels also keep a copy of the current
+ position in the file.
+
+ Closing the channel [ic] returned by [in_channel_of_descr fd]
+ using [close_in ic] also closes the underlying descriptor [fd].
+ It is incorrect to close both the channel [ic] and the descriptor [fd].
+
+ If several channels are created on the same descriptor, one of the
+ channels must be closed, but not the others.
+ Consider for example a descriptor [s] connected to a socket and two
+ channels [ic = in_channel_of_descr s] and [oc = out_channel_of_descr s].
+ The recommended closing protocol is to perform [close_out oc],
+ which flushes buffered output to the socket then closes the socket.
+ The [ic] channel must not be closed and will be collected by the GC
+ eventually.
+*)
val out_channel_of_descr : file_descr -> out_channel
(** Create an output channel writing on the given descriptor.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows: [set_binary_mode_out] always fails on channels created
+ On Windows: {!Stdlib.set_binary_mode_out} always fails on channels created
with this function.
- Beware that channels are buffered so you may have to [flush] them
- to ensure that all data has been sent to the file descriptor.
- Channels also keep a copy of the current position in the file.
+ Beware that output channels are buffered, so you may have to call
+ {!Stdlib.flush} to ensure that all data has been sent to the
+ descriptor. Channels also keep a copy of the current position in
+ the file.
- You need to explicitly close all channels created with this function.
- Closing the channel flushes the data and closes the underlying file
- descriptor (unless it has already been closed, in which case the
- buffered data is lost).*)
+ Closing the channel [oc] returned by [out_channel_of_descr fd]
+ using [close_out oc] also closes the underlying descriptor [fd].
+ It is incorrect to close both the channel [ic] and the descriptor [fd].
+
+ See {!Unix.in_channel_of_descr} for a discussion of the closing
+ protocol when several channels are created on the same descriptor.
+*)
val descr_of_in_channel : in_channel -> file_descr
(** Return the descriptor corresponding to an input channel. *)
unavailable.
@raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
+val realpath : string -> string
+(** [realpath p] is an absolute pathname for [p] obtained by resolving
+ all extra [/] characters, relative path segments and symbolic links.
+
+ @since 4.13.0 *)
(** {1 File permissions and ownership} *)
{!open_process_full}. *)
val open_process_args_in : string -> string array -> in_channel
-(** High-level pipe and process management. The first argument specifies the
- command to run, and the second argument specifies the argument array passed
- to the command. This function runs the command in parallel with the program.
- The standard output of the command is redirected to a pipe, which can be read
- via the returned input channel.
+(** [open_process_args_in prog args] runs the program [prog] with arguments
+ [args]. The new process executes concurrently with the current process.
+ The standard output of the new process is redirected to a pipe, which can be
+ read via the returned input channel.
+
+ The executable file [prog] is searched in the path. This behaviour changed
+ in 4.12; previously [prog] was looked up only in the current directory.
+
+ The new process has the same environment as the current process.
@since 4.08.0 *)
val open_process_args_out : string -> string array -> out_channel
-(** Same as {!open_process_args_in}, but redirect the standard input of the
- command to a pipe. Data written to the returned output channel is sent to
- the standard input of the command. Warning: writes on output channels are
- buffered, hence be careful to call {!Stdlib.flush} at the right times to
- ensure correct synchronization.
+(** Same as {!open_process_args_in}, but redirect the standard input of the new
+ process to a pipe. Data written to the returned output channel is sent to
+ the standard input of the program. Warning: writes on output channels are
+ buffered, hence be careful to call {!Stdlib.flush} at the right times to
+ ensure correct synchronization.
@since 4.08.0 *)
val open_process_args : string -> string array -> in_channel * out_channel
-(** Same as {!open_process_args_out}, but redirects both the standard input
- and standard output of the command to pipes connected to the two returned
- channels. The input channel is connected to the output of the command, and
- the output channel to the input of the command.
+(** Same as {!open_process_args_out}, but redirects both the standard input and
+ standard output of the new process to pipes connected to the two returned
+ channels. The input channel is connected to the output of the program, and
+ the output channel to the input of the program.
@since 4.08.0 *)
string -> string array -> string array ->
in_channel * out_channel * in_channel
(** Similar to {!open_process_args}, but the third argument specifies the
- environment passed to the command. The result is a triple of channels
- connected respectively to the standard output, standard input, and standard
- error of the command.
+ environment passed to the new process. The result is a triple of channels
+ connected respectively to the standard output, standard input, and standard
+ error of the program.
@since 4.08.0 *)
(** Connect to a server at the given address.
Return a pair of buffered channels connected to the server.
Remember to call {!Stdlib.flush} on the output channel at the right
- times to ensure correct synchronization. *)
+ times to ensure correct synchronization.
+
+ The two channels returned by [open_connection] share a descriptor
+ to a socket. Therefore, when the connection is over, you should
+ call {!Stdlib.close_out} on the output channel, which will also close
+ the underlying socket. Do not call {!Stdlib.close_in} on the input
+ channel; it will be collected by the GC eventually.
+*)
+
val shutdown_connection : in_channel -> unit
(** ``Shut down'' a connection established with {!open_connection};
that is, transmit an end-of-file condition to the server reading
- on the other side of the connection. This does not fully close the
- file descriptor associated with the channel, which you must remember
- to free via {!Stdlib.close_in}. *)
+ on the other side of the connection. This does not close the
+ socket and the channels used by the connection.
+ See {!Unix.open_connection} for how to close them once the
+ connection is over. *)
val establish_server :
(in_channel -> out_channel -> unit) -> sockaddr -> unit
is created for each connection. The function {!establish_server}
never returns normally.
+ The two channels given to the function share a descriptor to a
+ socket. The function does not need to close the channels, since this
+ occurs automatically when the function returns. If the function
+ prefers explicit closing, it should close the output channel using
+ {!Stdlib.close_out} and leave the input channel unclosed,
+ for reasons explained in {!Unix.in_channel_of_descr}.
+
On Windows: not implemented (use threads). *)
When a new function is added which is not implemented on Windows (or
partially implemented), or the Windows-status of an existing function is
changed, remember to update the summary table in
- manual/manual/library/libunix.etex
+ manual/src/library/libunix.etex
*)
(** Interface to the Unix system.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows: [set_binary_mode_in] always fails on channels created
- with this function.
-
- Beware that channels are buffered so more characters may have been
- read from the file descriptor than those accessed using channel functions.
- Channels also keep a copy of the current position in the file.
-
- You need to explicitly close all channels created with this function.
- Closing the channel also closes the underlying file descriptor (unless
- it was already closed). *)
+ On Windows: {!Stdlib.set_binary_mode_in} always fails on channels
+ created with this function.
+
+ Beware that input channels are buffered, so more characters may
+ have been read from the descriptor than those accessed using
+ channel functions. Channels also keep a copy of the current
+ position in the file.
+
+ Closing the channel [ic] returned by [in_channel_of_descr fd]
+ using [close_in ic] also closes the underlying descriptor [fd].
+ It is incorrect to close both the channel [ic] and the descriptor [fd].
+
+ If several channels are created on the same descriptor, one of the
+ channels must be closed, but not the others.
+ Consider for example a descriptor [s] connected to a socket and two
+ channels [ic = in_channel_of_descr s] and [oc = out_channel_of_descr s].
+ The recommended closing protocol is to perform [close_out oc],
+ which flushes buffered output to the socket then closes the socket.
+ The [ic] channel must not be closed and will be collected by the GC
+ eventually.
+*)
val out_channel_of_descr : file_descr -> out_channel
(** Create an output channel writing on the given descriptor.
Text mode is supported only if the descriptor refers to a file
or pipe, but is not supported if it refers to a socket.
- On Windows: [set_binary_mode_out] always fails on channels created
+ On Windows: {!Stdlib.set_binary_mode_out} always fails on channels created
with this function.
- Beware that channels are buffered so you may have to [flush] them
- to ensure that all data has been sent to the file descriptor.
- Channels also keep a copy of the current position in the file.
+ Beware that output channels are buffered, so you may have to call
+ {!Stdlib.flush} to ensure that all data has been sent to the
+ descriptor. Channels also keep a copy of the current position in
+ the file.
- You need to explicitly close all channels created with this function.
- Closing the channel flushes the data and closes the underlying file
- descriptor (unless it has already been closed, in which case the
- buffered data is lost).*)
+ Closing the channel [oc] returned by [out_channel_of_descr fd]
+ using [close_out oc] also closes the underlying descriptor [fd].
+ It is incorrect to close both the channel [ic] and the descriptor [fd].
+
+ See {!Unix.in_channel_of_descr} for a discussion of the closing
+ protocol when several channels are created on the same descriptor.
+*)
val descr_of_in_channel : in_channel -> file_descr
(** Return the descriptor corresponding to an input channel. *)
unavailable.
@raise ENOSYS On {e Windows} if [~follow:false] is requested. *)
+val realpath : string -> string
+(** [realpath p] is an absolute pathname for [p] obtained by resolving
+ all extra [/] characters, relative path segments and symbolic links.
+
+ @since 4.13.0 *)
(** {1 File permissions and ownership} *)
{!open_process_full}. *)
val open_process_args_in : string -> string array -> in_channel
-(** High-level pipe and process management. The first argument specifies the
- command to run, and the second argument specifies the argument array passed
- to the command. This function runs the command in parallel with the program.
- The standard output of the command is redirected to a pipe, which can be read
- via the returned input channel.
+(** [open_process_args_in prog args] runs the program [prog] with arguments
+ [args]. The new process executes concurrently with the current process.
+ The standard output of the new process is redirected to a pipe, which can be
+ read via the returned input channel.
+
+ The executable file [prog] is searched in the path. This behaviour changed
+ in 4.12; previously [prog] was looked up only in the current directory.
+
+ The new process has the same environment as the current process.
@since 4.08.0 *)
val open_process_args_out : string -> string array -> out_channel
-(** Same as {!open_process_args_in}, but redirect the standard input of the
- command to a pipe. Data written to the returned output channel is sent to
- the standard input of the command. Warning: writes on output channels are
- buffered, hence be careful to call {!Stdlib.flush} at the right times to
- ensure correct synchronization.
+(** Same as {!open_process_args_in}, but redirect the standard input of the new
+ process to a pipe. Data written to the returned output channel is sent to
+ the standard input of the program. Warning: writes on output channels are
+ buffered, hence be careful to call {!Stdlib.flush} at the right times to
+ ensure correct synchronization.
@since 4.08.0 *)
val open_process_args : string -> string array -> in_channel * out_channel
-(** Same as {!open_process_args_out}, but redirects both the standard input
- and standard output of the command to pipes connected to the two returned
- channels. The input channel is connected to the output of the command, and
- the output channel to the input of the command.
+(** Same as {!open_process_args_out}, but redirects both the standard input and
+ standard output of the new process to pipes connected to the two returned
+ channels. The input channel is connected to the output of the program, and
+ the output channel to the input of the program.
@since 4.08.0 *)
string -> string array -> string array ->
in_channel * out_channel * in_channel
(** Similar to {!open_process_args}, but the third argument specifies the
- environment passed to the command. The result is a triple of channels
- connected respectively to the standard output, standard input, and standard
- error of the command.
+ environment passed to the new process. The result is a triple of channels
+ connected respectively to the standard output, standard input, and standard
+ error of the program.
@since 4.08.0 *)
(** Connect to a server at the given address.
Return a pair of buffered channels connected to the server.
Remember to call {!Stdlib.flush} on the output channel at the right
- times to ensure correct synchronization. *)
+ times to ensure correct synchronization.
+
+ The two channels returned by [open_connection] share a descriptor
+ to a socket. Therefore, when the connection is over, you should
+ call {!Stdlib.close_out} on the output channel, which will also close
+ the underlying socket. Do not call {!Stdlib.close_in} on the input
+ channel; it will be collected by the GC eventually.
+*)
+
val shutdown_connection : in_channel -> unit
(** ``Shut down'' a connection established with {!open_connection};
that is, transmit an end-of-file condition to the server reading
- on the other side of the connection. This does not fully close the
- file descriptor associated with the channel, which you must remember
- to free via {!Stdlib.close_in}. *)
+ on the other side of the connection. This does not close the
+ socket and the channels used by the connection.
+ See {!Unix.open_connection} for how to close them once the
+ connection is over. *)
val establish_server :
(in_channel -> out_channel -> unit) -> addr:sockaddr -> unit
is created for each connection. The function {!establish_server}
never returns normally.
+ The two channels given to the function share a descriptor to a
+ socket. The function does not need to close the channels, since this
+ occurs automatically when the function returns. If the function
+ prefers explicit closing, it should close the output channel using
+ {!Stdlib.close_out} and leave the input channel unclosed,
+ for reasons explained in {!Unix.in_channel_of_descr}.
+
On Windows: not implemented (use threads). *)
return err;
}
-extern int code_of_unix_error (value error)
+int code_of_unix_error (value error)
{
if (Is_block(error)) {
return Int_val(Field(error, 0));
int unix_cloexec_p(value cloexec)
{
- /* [cloexec] is a [bool option]. */
- if (Is_block(cloexec))
- return Bool_val(Field(cloexec, 0));
+ if (Is_some(cloexec))
+ return Bool_val(Some_val(cloexec));
else
return unix_cloexec_default;
}
getpeername.c getpid.c getsockname.c gettimeofday.c isatty.c \
link.c listen.c lockf.c lseek.c nonblock.c \
mmap.c open.c pipe.c read.c readlink.c rename.c \
- select.c sendrecv.c \
+ realpath.c select.c sendrecv.c \
shutdown.c sleep.c socket.c sockopt.c startup.c stat.c \
symlink.c system.c times.c truncate.c unixsupport.c windir.c winwait.c \
write.c winlist.c winworker.c windbug.c utimes.c
.PHONY: depend
depend: $(ALL_FILES) $(UNIX_CAML_FILES) unix.ml
- $(CAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash $(UNIX_CAML_FILES) \
+ $(OCAMLRUN) $(ROOTDIR)/boot/ocamlc -depend -slash $(UNIX_CAML_FILES) \
unix.ml > .depend
include .depend
+
+# This empty target is here for AppVeyor to allow dependencies to be built
+# without doing anything else.
+.PHONY: setup-depend
+setup-depend:
#include "unixsupport.h"
#include <fcntl.h>
#include <io.h>
+#include <errno.h>
/* Check that the given file descriptor has "stream semantics" and
can therefore be used as part of buffered I/O. Things that
HANDLE h;
chan = Channel(vchan);
- if (chan->fd == -1) uerror("descr_of_channel", Nothing);
+ if (chan->fd == -1) unix_error(EBADF, "descr_of_channel", Nothing);
h = (HANDLE) _get_osfhandle(chan->fd);
if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
fd = win_alloc_socket((SOCKET) h);
#include <caml/osdeps.h>
#include "unixsupport.h"
-extern int error_table[];
-
CAMLprim value unix_error_message(value err)
{
int errnum;
wchar_t buffer[512];
- errnum = Is_block(err) ? Int_val(Field(err, 0)) : error_table[Int_val(err)];
+ errnum = code_of_unix_error(err);
if (errnum > 0)
return caml_copy_string(strerror(errnum));
if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
addr_len = sizeof(addr);
retcode = getsockname(Socket_val(sock), &addr.s_gen, &addr_len);
- if (retcode == -1) uerror("getsockname", Nothing);
+ if (retcode == -1) {
+ win32_maperr(WSAGetLastError());
+ uerror("getsockname", Nothing);
+ }
return alloc_sockaddr(&addr, addr_len, -1);
}
tCreateHardLink pCreateHardLink;
BOOL result;
wchar_t * wpath1, * wpath2;
- if (Is_block(follow) && !Bool_val(Field(follow, 0))) { /* Some false */
+ if (Is_some(follow) && !Bool_val(Some_val(follow))) {
errno = ENOSYS;
uerror("link", path2);
}
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* The OCaml programmers */
+/* */
+/* Copyright 2020 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#define CAML_INTERNALS
+
+/*
+ * Windows Vista functions enabled
+ */
+#undef _WIN32_WINNT
+#define _WIN32_WINNT 0x0600
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/fail.h>
+#include <caml/osdeps.h>
+#include "unixsupport.h"
+
+#include <windows.h>
+#include <stdio.h>
+
+CAMLprim value unix_realpath (value p)
+{
+ CAMLparam1 (p);
+ HANDLE h;
+ wchar_t *wp;
+ wchar_t *wr;
+ DWORD wr_len;
+ value rp;
+
+ caml_unix_check_path (p, "realpath");
+ wp = caml_stat_strdup_to_utf16 (String_val (p));
+ h = CreateFile (wp, 0,
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL,
+ OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL);
+ caml_stat_free (wp);
+
+ if (h == INVALID_HANDLE_VALUE)
+ {
+ win32_maperr (GetLastError ());
+ uerror ("realpath", p);
+ }
+
+ wr_len = GetFinalPathNameByHandle (h, NULL, 0, VOLUME_NAME_DOS);
+ if (wr_len == 0)
+ {
+ win32_maperr (GetLastError ());
+ CloseHandle (h);
+ uerror ("realpath", p);
+ }
+
+ wr = caml_stat_alloc ((wr_len + 1) * sizeof (wchar_t));
+ wr_len = GetFinalPathNameByHandle (h, wr, wr_len, VOLUME_NAME_DOS);
+
+ if (wr_len == 0)
+ {
+ win32_maperr (GetLastError ());
+ CloseHandle (h);
+ caml_stat_free (wr);
+ uerror ("realpath", p);
+ }
+
+ rp = caml_copy_string_of_utf16 (wr);
+ CloseHandle (h);
+ caml_stat_free (wr);
+ CAMLreturn (rp);
+}
#include "unixsupport.h"
int socket_domain_table[] = {
- PF_UNIX, PF_INET,
-#if defined(HAS_IPV6)
- PF_INET6
-#else
- 0
-#endif
+ PF_UNIX, PF_INET, PF_INET6
};
int socket_type_table[] = {
{
SOCKET s;
- #ifndef HAS_IPV6
- /* IPv6 requires WinSock2, we must raise an error on PF_INET6 */
- if (Int_val(domain) >= sizeof(socket_domain_table)/sizeof(int)) {
- win32_maperr(WSAEPFNOSUPPORT);
- uerror("socket", Nothing);
- }
- #endif
-
s = socket(socket_domain_table[Int_val(domain)],
socket_type_table[Int_val(type)],
Int_val(proto));
}
if (getsockopt(Socket_val(socket), level, option,
- (void *) &optval, &optsize) == -1)
+ (void *) &optval, &optsize) == -1) {
+ win32_maperr(WSAGetLastError());
uerror(name, Nothing);
+ }
switch (ty) {
case TYPE_BOOL:
return Val_int(optval.i);
case TYPE_LINGER:
if (optval.lg.l_onoff == 0) {
- return Val_int(0); /* None */
+ return Val_none;
} else {
- value res = caml_alloc_small(1, 0); /* Some */
- Field(res, 0) = Val_int(optval.lg.l_linger);
- return res;
+ return caml_alloc_some(Val_int(optval.lg.l_linger));
}
case TYPE_TIMEVAL:
return caml_copy_double((double) optval.tv.tv_sec
+ (double) optval.tv.tv_usec / 1e6);
case TYPE_UNIX_ERROR:
if (optval.i == 0) {
- return Val_int(0); /* None */
+ return Val_none;
} else {
value err, res;
err = unix_error_of_code(optval.i);
Begin_root(err);
- res = caml_alloc_small(1, 0); /* Some */
- Field(res, 0) = err;
+ res = caml_alloc_some(err);
End_roots();
return res;
}
break;
case TYPE_LINGER:
optsize = sizeof(optval.lg);
- optval.lg.l_onoff = Is_block (val);
+ optval.lg.l_onoff = Is_some(val);
if (optval.lg.l_onoff)
- optval.lg.l_linger = Int_val (Field (val, 0));
+ optval.lg.l_linger = Int_val(Some_val(val));
break;
case TYPE_TIMEVAL:
f = Double_val(val);
}
if (setsockopt(Socket_val(socket), level, option,
- (void *) &optval, optsize) == -1)
+ (void *) &optval, optsize) == -1) {
+ win32_maperr(WSAGetLastError());
uerror(name, Nothing);
+ }
return Val_unit;
}
fp.QuadPart = len;
if (SetFilePointerEx(fh, fp, NULL, FILE_BEGIN) == 0 ||
SetEndOfFile(fh) == 0) {
+ win32_maperr(GetLastError());
return -1;
}
return 0;
/* Duplicate the handle, so we are free to modify its file position. */
if (DuplicateHandle(currproc, fh, currproc, &dupfh, 0, FALSE,
DUPLICATE_SAME_ACCESS) == 0) {
- return -1;
+ win32_maperr(GetLastError());
+ return -1;
}
ret = win_truncate_handle(dupfh, len);
CloseHandle(dupfh);
fh = CreateFile(path, GENERIC_WRITE, 0, NULL,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
if (fh == INVALID_HANDLE_VALUE) {
+ win32_maperr(GetLastError());
return -1;
}
ret = win_truncate_handle(fh, len);
external unlink : string -> unit = "unix_unlink"
external rename : string -> string -> unit = "unix_rename"
external link : ?follow:bool -> string -> string -> unit = "unix_link"
+external realpath : string -> string = "unix_realpath"
+
+let realpath p =
+ let cleanup p = (* Remove any \\?\ prefix. *)
+ if String.length p <= 4 then p else
+ if p.[0] = '\\' && p.[1] = '\\' && p.[2] = '?' && p.[3] = '\\'
+ then (String.sub p 4 (String.length p - 4))
+ else p
+ in
+ try cleanup (realpath p) with
+ | (Unix_error (EACCES, _, _)) as e ->
+ (* On Windows this can happen on *files* on which you don't have
+ access. POSIX realpath(3) works in this case, we emulate this. *)
+ try
+ let dir = cleanup (realpath (Filename.dirname p)) in
+ Filename.concat dir (Filename.basename p)
+ with _ -> raise e
(* Operations on large files *)
{ WSAEINTR, 0, EINTR },
{ WSAEINVAL, 0, EINVAL },
{ WSAEMFILE, 0, EMFILE },
-#ifdef WSANAMETOOLONG
- { WSANAMETOOLONG, 0, ENAMETOOLONG },
-#endif
-#ifdef WSAENFILE
- { WSAENFILE, 0, ENFILE },
-#endif
+ { WSAENAMETOOLONG, 0, ENAMETOOLONG },
{ WSAENOTEMPTY, 0, ENOTEMPTY },
{ 0, -1, 0 }
};
return err;
}
+int code_of_unix_error (value error)
+{
+ if (Is_block(error)) {
+ return Int_val(Field(error, 0));
+ } else {
+ return error_table[Int_val(error)];
+ }
+}
+
void unix_error(int errcode, const char *cmdname, value cmdarg)
{
value res;
int unix_cloexec_p(value cloexec)
{
- /* [cloexec] is a [bool option]. */
- if (Is_block(cloexec))
- return Bool_val(Field(cloexec, 0));
+ if (Is_some(cloexec))
+ return Bool_val(Some_val(cloexec));
else
return unix_cloexec_default;
}
#include <process.h>
#include <sys/types.h>
#include <winsock2.h>
-#ifdef HAS_IPV6
#include <ws2tcpip.h>
#include <wspiapi.h>
-#endif
#ifdef __cplusplus
extern "C" {
extern void win32_maperr(DWORD errcode);
extern value unix_error_of_code (int errcode);
+extern int code_of_unix_error (value error);
CAMLnoreturn_start
extern void unix_error (int errcode, const char * cmdname, value arg)
let mod_subst ?loc a = mk ?loc (Psig_modsubst a)
let rec_module ?loc a = mk ?loc (Psig_recmodule a)
let modtype ?loc a = mk ?loc (Psig_modtype a)
+ let modtype_subst ?loc a = mk ?loc (Psig_modtypesubst a)
let open_ ?loc a = mk ?loc (Psig_open a)
let include_ ?loc a = mk ?loc (Psig_include a)
let class_ ?loc a = mk ?loc (Psig_class a)
val constant: ?loc:loc -> ?attrs:attrs -> constant -> pattern
val interval: ?loc:loc -> ?attrs:attrs -> constant -> constant -> pattern
val tuple: ?loc:loc -> ?attrs:attrs -> pattern list -> pattern
- val construct: ?loc:loc -> ?attrs:attrs -> lid -> pattern option -> pattern
+ val construct: ?loc:loc -> ?attrs:attrs ->
+ lid -> (str list * pattern) option -> pattern
val variant: ?loc:loc -> ?attrs:attrs -> label -> pattern option -> pattern
val record: ?loc:loc -> ?attrs:attrs -> (lid * pattern) list -> closed_flag
-> pattern
val mod_subst: ?loc:loc -> module_substitution -> signature_item
val rec_module: ?loc:loc -> module_declaration list -> signature_item
val modtype: ?loc:loc -> module_type_declaration -> signature_item
+ val modtype_subst: ?loc:loc -> module_type_declaration -> signature_item
val open_: ?loc:loc -> open_description -> signature_item
val include_: ?loc:loc -> include_description -> signature_item
val class_: ?loc:loc -> class_description list -> signature_item
let empty_let loc = err loc "Let with no bindings."
let empty_type loc = err loc "Type declarations cannot be empty."
let complex_id loc = err loc "Functor application not allowed here."
+let module_type_substitution_missing_rhs loc =
+ err loc "Module type substitution with no right hand side"
let simple_longident id =
let rec is_simple = function
in
let pat self pat =
begin match pat.ppat_desc with
- | Ppat_construct (_, Some ({ppat_desc = Ppat_tuple _} as p))
+ | Ppat_construct (_, Some (_, ({ppat_desc = Ppat_tuple _} as p)))
when Builtin_attributes.explicit_arity pat.ppat_attributes ->
super.pat self p (* allow unary tuple, see GPR#523. *)
| _ ->
let loc = sg.psig_loc in
match sg.psig_desc with
| Psig_type (_, []) -> empty_type loc
+ | Psig_modtypesubst {pmtd_type=None; _ } ->
+ module_type_substitution_missing_rhs loc
| _ -> ()
in
let row_field self field =
iter_loc sub lid; sub.type_declaration sub d
| Pwith_module (lid, lid2) ->
iter_loc sub lid; iter_loc sub lid2
+ | Pwith_modtype (lid, mty) ->
+ iter_loc sub lid; sub.module_type sub mty
| Pwith_typesubst (lid, d) ->
iter_loc sub lid; sub.type_declaration sub d
| Pwith_modsubst (s, lid) ->
iter_loc sub s; iter_loc sub lid
+ | Pwith_modtypesubst (lid, mty) ->
+ iter_loc sub lid; sub.module_type sub mty
let iter_signature_item sub {psig_desc = desc; psig_loc = loc} =
sub.location sub loc;
| Psig_modsubst x -> sub.module_substitution sub x
| Psig_recmodule l ->
List.iter (sub.module_declaration sub) l
- | Psig_modtype x -> sub.module_type_declaration sub x
+ | Psig_modtype x | Psig_modtypesubst x -> sub.module_type_declaration sub x
| Psig_open x -> sub.open_description sub x
| Psig_include x -> sub.include_description sub x
| Psig_class l -> List.iter (sub.class_description sub) l
| Ppat_interval _ -> ()
| Ppat_tuple pl -> List.iter (sub.pat sub) pl
| Ppat_construct (l, p) ->
- iter_loc sub l; iter_opt (sub.pat sub) p
+ iter_loc sub l;
+ iter_opt
+ (fun (vl,p) ->
+ List.iter (iter_loc sub) vl;
+ sub.pat sub p)
+ p
| Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
| Ppat_record (lpl, _cf) ->
List.iter (iter_tuple (iter_loc sub) (sub.pat sub)) lpl
Pwith_type (map_loc sub lid, sub.type_declaration sub d)
| Pwith_module (lid, lid2) ->
Pwith_module (map_loc sub lid, map_loc sub lid2)
+ | Pwith_modtype (lid, mty) ->
+ Pwith_modtype (map_loc sub lid, sub.module_type sub mty)
| Pwith_typesubst (lid, d) ->
Pwith_typesubst (map_loc sub lid, sub.type_declaration sub d)
| Pwith_modsubst (s, lid) ->
Pwith_modsubst (map_loc sub s, map_loc sub lid)
+ | Pwith_modtypesubst (lid, mty) ->
+ Pwith_modtypesubst (map_loc sub lid, sub.module_type sub mty)
let map_signature_item sub {psig_desc = desc; psig_loc = loc} =
let open Sig in
| Psig_recmodule l ->
rec_module ~loc (List.map (sub.module_declaration sub) l)
| Psig_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
+ | Psig_modtypesubst x ->
+ modtype_subst ~loc (sub.module_type_declaration sub x)
| Psig_open x -> open_ ~loc (sub.open_description sub x)
| Psig_include x -> include_ ~loc (sub.include_description sub x)
| Psig_class l -> class_ ~loc (List.map (sub.class_description sub) l)
| Ppat_var s -> var ~loc ~attrs (map_loc sub s)
| Ppat_alias (p, s) -> alias ~loc ~attrs (sub.pat sub p) (map_loc sub s)
| Ppat_constant c -> constant ~loc ~attrs (sub.constant sub c)
- | Ppat_interval (c1, c2) -> interval ~loc ~attrs c1 c2
+ | Ppat_interval (c1, c2) ->
+ interval ~loc ~attrs (sub.constant sub c1) (sub.constant sub c2)
| Ppat_tuple pl -> tuple ~loc ~attrs (List.map (sub.pat sub) pl)
| Ppat_construct (l, p) ->
- construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
+ construct ~loc ~attrs (map_loc sub l)
+ (map_opt
+ (fun (vl, p) -> List.map (map_loc sub) vl, sub.pat sub p)
+ p)
| Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
| Ppat_record (lpl, cf) ->
record ~loc ~attrs
let process loc txt errflag payload =
match string_of_payload payload with
| Some s ->
- begin try Warnings.parse_options errflag s
+ begin try
+ Option.iter (Location.prerr_alert loc)
+ (Warnings.parse_options errflag s)
with Arg.Bad msg -> warn_payload loc txt msg
end
| None ->
| Ppat_interval _
| Ppat_constant _ -> ()
| Ppat_tuple pl -> List.iter (add_pattern bv) pl
- | Ppat_construct(c, op) -> add bv c; add_opt add_pattern bv op
+ | Ppat_construct(c, opt) ->
+ add bv c;
+ add_opt
+ (fun bv (_,p) -> add_pattern bv p)
+ bv opt
| Ppat_record(pl, _) ->
List.iter (fun (lbl, p) -> add bv lbl; add_pattern bv p) pl
| Ppat_array pl -> List.iter (add_pattern bv) pl
(function
| Pwith_type (_, td) -> add_type_declaration bv td
| Pwith_module (_, lid) -> add_module_path bv lid
+ | Pwith_modtype (_, mty) -> add_modtype bv mty
| Pwith_typesubst (_, td) -> add_type_declaration bv td
| Pwith_modsubst (_, lid) -> add_module_path bv lid
+ | Pwith_modtypesubst (_, mty) -> add_modtype bv mty
)
cstrl
| Pmty_typeof m -> add_module_expr bv m
let bv' = add bv and m' = add m in
List.iter (fun pmd -> add_modtype bv' pmd.pmd_type) decls;
(bv', m')
- | Psig_modtype x ->
+ | Psig_modtype x | Psig_modtypesubst x->
begin match x.pmtd_type with
None -> ()
| Some mty -> add_modtype bv mty
| Unterminated_comment of Location.t
| Unterminated_string
| Unterminated_string_in_comment of Location.t * Location.t
+ | Empty_character_literal
| Keyword_as_label of string
| Invalid_literal of string
| Invalid_directive of string * string option
| Unterminated_comment of Location.t
| Unterminated_string
| Unterminated_string_in_comment of Location.t * Location.t
+ | Empty_character_literal
| Keyword_as_label of string
| Invalid_literal of string
| Invalid_directive of string * string option
Location.errorf ~loc
"This comment contains an unterminated string literal"
~sub:[Location.msg ~loc:literal_loc "String literal begins here"]
+ | Empty_character_literal ->
+ let msg = "Illegal empty character literal ''" in
+ let sub =
+ [Location.msg
+ "Hint: Did you mean ' ' or a type variable 'a?"] in
+ Location.error ~loc ~sub msg
| Keyword_as_label kwd ->
Location.errorf ~loc
"`%s' is a keyword, it cannot be used as label name" kwd
{ CHAR(char_for_hexadecimal_code lexbuf 3) }
| "\'" ("\\" _ as esc)
{ error lexbuf (Illegal_escape (esc, None)) }
+ | "\'\'"
+ { error lexbuf Empty_character_literal }
| "(*"
{ let s, loc = wrap_comment_lexer comment lexbuf in
COMMENT (s, loc) }
let pp_txt ppf txt = Format.fprintf ppf "@[%t@]" txt in
let pp self ppf report =
setup_colors ();
- (* Make sure we keep [num_loc_lines] updated. *)
+ (* Make sure we keep [num_loc_lines] updated.
+ The tabulation box is here to give submessage the option
+ to be aligned with the main message box
+ *)
print_updating_num_loc_lines ppf (fun ppf () ->
- Format.fprintf ppf "@[<v>%a%a: %a%a@]@."
+ Format.fprintf ppf "@[<v>%a%a%a: %a%a%a%a@]@."
+ Format.pp_open_tbox ()
(self.pp_main_loc self report) report.main.loc
(self.pp_report_kind self report) report.kind
+ Format.pp_set_tab ()
(self.pp_main_txt self report) report.main.txt
(self.pp_submsgs self report) report.sub
+ Format.pp_close_tbox ()
) ()
in
let pp_report_kind _self _ ppf = function
(* *)
(**************************************************************************)
-(** {1 Source code locations (ranges of positions), used in parsetree}
+(** Source code locations (ranges of positions), used in parsetree.
{b Warning:} this module is unstable and part of
{{!Compiler_libs}compiler-libs}.
{b Warning:} this module is unstable and part of
{{!Compiler_libs}compiler-libs}.
+ To print a longident, see {!Pprintast.longident}, using
+ {!Format.asprintf} to convert to a string.
+
*)
type t =
input-location support.
*)
-
-
-
-(** To print a longident, see {!Pprintast.longident}, using
- {!Format.asprintf} to convert to a string. *)
| Parser.SEMISEMI | Parser.EOF -> ()
| _ -> skip_phrase lexbuf
-let wrap parsing_fun lexbuf =
+type 'a parser =
+ (Lexing.lexbuf -> Parser.token) -> Lexing.lexbuf -> 'a
+
+let wrap (parser : 'a parser) lexbuf : 'a =
try
Docstrings.init ();
Lexer.init ();
- let ast = parsing_fun lexbuf in
+ let ast = parser token lexbuf in
Parsing.clear_parser();
Docstrings.warn_bad_docstrings ();
last_token := Parser.EOF;
then maybe_skip_phrase lexbuf;
raise(Syntaxerr.Error(Syntaxerr.Other loc))
-let rec loop lexbuf in_error checkpoint =
- let module I = Parser.MenhirInterpreter in
- match checkpoint with
- | I.InputNeeded _env ->
- let triple =
- if in_error then
- (* The parser detected an error.
- At this point we don't want to consume input anymore. In the
- top-level, it would translate into waiting for the user to type
- something, just to raise an error at some earlier position, rather
- than just raising the error immediately.
-
- This worked before with yacc because, AFAICT (@let-def):
- - yacc eagerly reduces "default reduction" (when the next action
- is to reduce the same production no matter what token is read,
- yacc reduces it immediately rather than waiting for that token
- to be read)
- - error productions in OCaml grammar are always in a position that
- allows default reduction ("error" symbol is the last producer,
- and the lookahead token will not be used to disambiguate between
- two possible error rules)
- This solution is fragile because it relies on an optimization
- (default reduction), that changes the semantics of the parser the
- way it is implemented in Yacc (an optimization that changes
- semantics? hmmmm).
-
- Rather than relying on implementation details of the parser, when
- an error is detected in this loop we stop looking at the input and
- fill the parser with EOF tokens.
- The skip_phrase logic will resynchronize the input stream by
- looking for the next ';;'. *)
- (Parser.EOF, lexbuf.Lexing.lex_curr_p, lexbuf.Lexing.lex_curr_p)
- else
- let token = token lexbuf in
- (token, lexbuf.Lexing.lex_start_p, lexbuf.Lexing.lex_curr_p)
- in
- let checkpoint = I.offer checkpoint triple in
- loop lexbuf in_error checkpoint
- | I.Shifting _ | I.AboutToReduce _ ->
- loop lexbuf in_error (I.resume checkpoint)
- | I.Accepted v -> v
- | I.Rejected -> raise Parser.Error
- | I.HandlingError _ ->
- loop lexbuf true (I.resume checkpoint)
-
-let wrap_menhir entry lexbuf =
- let initial = entry lexbuf.Lexing.lex_curr_p in
- wrap (fun lexbuf -> loop lexbuf false initial) lexbuf
-
-let implementation = wrap_menhir Parser.Incremental.implementation
-and interface = wrap_menhir Parser.Incremental.interface
-and toplevel_phrase = wrap_menhir Parser.Incremental.toplevel_phrase
-and use_file = wrap_menhir Parser.Incremental.use_file
-and core_type = wrap_menhir Parser.Incremental.parse_core_type
-and expression = wrap_menhir Parser.Incremental.parse_expression
-and pattern = wrap_menhir Parser.Incremental.parse_pattern
-
-let longident = wrap_menhir Parser.Incremental.parse_any_longident
-let val_ident = wrap_menhir Parser.Incremental.parse_val_longident
-let constr_ident= wrap_menhir Parser.Incremental.parse_constr_longident
-let extended_module_path =
- wrap_menhir Parser.Incremental.parse_mod_ext_longident
-let simple_module_path = wrap_menhir Parser.Incremental.parse_mod_longident
-let type_ident = wrap_menhir Parser.Incremental.parse_mty_longident
+(* We pass [--strategy simplified] to Menhir, which means that we wish to use
+ its "simplified" strategy for handling errors. When a syntax error occurs,
+ the current token is replaced with an [error] token. The parser then
+ continues shifting and reducing, as far as possible. After (possibly)
+ shifting the [error] token, though, the parser remains in error-handling
+ mode, and does not request the next token, so the current token remains
+ [error].
+
+ In OCaml's grammar, the [error] token always appears at the end of a
+ production, and this production always raises an exception. In such
+ a situation, the strategy described above means that:
+
+ - either the parser will not be able to shift [error],
+ and will raise [Parser.Error];
+
+ - or it will be able to shift [error] and will then reduce
+ a production whose semantic action raises an exception.
+
+ In either case, the parser will not attempt to read one token past
+ the syntax error. *)
+
+let implementation = wrap Parser.implementation
+and interface = wrap Parser.interface
+and toplevel_phrase = wrap Parser.toplevel_phrase
+and use_file = wrap Parser.use_file
+and core_type = wrap Parser.parse_core_type
+and expression = wrap Parser.parse_expression
+and pattern = wrap Parser.parse_pattern
+
+let longident = wrap Parser.parse_any_longident
+let val_ident = wrap Parser.parse_val_longident
+let constr_ident= wrap Parser.parse_constr_longident
+let extended_module_path = wrap Parser.parse_mod_ext_longident
+let simple_module_path = wrap Parser.parse_mod_longident
+let type_ident = wrap Parser.parse_mty_longident
(* Error reporting for Syntaxerr *)
(* The code has been moved here so that one can reuse Pprintast.tyvar *)
/* The parser definition */
+/* The commands [make list-parse-errors] and [make generate-parse-errors]
+ run Menhir on a modified copy of the parser where every block of
+ text comprised between the markers [BEGIN AVOID] and -----------
+ [END AVOID] has been removed. This file should be formatted in
+ such a way that this results in a clean removal of certain
+ symbols, productions, or declarations. */
+
%{
open Asttypes
mkexp ~loc (mkexp_cons_desc consloc args)
let mkpat_cons_desc consloc args =
- Ppat_construct(mkrhs (Lident "::") consloc, Some args)
+ Ppat_construct(mkrhs (Lident "::") consloc, Some ([], args))
let mkpat_cons ~loc consloc args =
mkpat ~loc (mkpat_cons_desc consloc args)
let ghexp_cons_desc consloc args =
Pexp_construct(ghrhs (Lident "::") consloc, Some args)
let ghpat_cons_desc consloc args =
- Ppat_construct(ghrhs (Lident "::") consloc, Some args)
+ Ppat_construct(ghrhs (Lident "::") consloc, Some ([], args))
let rec mktailexp nilloc = let open Location in function
[] ->
let expecting loc nonterm =
raise Syntaxerr.(Error(Expecting(make_loc loc, nonterm)))
+(* Using the function [not_expecting] in a semantic action means that this
+ syntactic form is recognized by the parser but is in fact incorrect. This
+ idiom is used in a few places to produce ad hoc syntax error messages. *)
+
+(* This idiom should be used as little as possible, because it confuses the
+ analyses performed by Menhir. Because Menhir views the semantic action as
+ opaque, it believes that this syntactic form is correct. This can lead
+ [make generate-parse-errors] to produce sentences that cause an early
+ (unexpected) syntax error and do not achieve the desired effect. This could
+ also lead a completion system to propose completions which in fact are
+ incorrect. In order to avoid these problems, the productions that use
+ [not_expecting] should be marked with AVOID. *)
+
let not_expecting loc nonterm =
raise Syntaxerr.(Error(Not_expecting(make_loc loc, nonterm)))
-let dotop ~left ~right ~assign ~ext ~multi =
- let assign = if assign then "<-" else "" in
- let mid = if multi then ";.." else "" in
- String.concat "" ["."; ext; left; mid; right; assign]
-let paren = "(",")"
-let brace = "{", "}"
-let bracket = "[", "]"
-let lident x = Lident x
-let ldot x y = Ldot(x,y)
-let dotop_fun ~loc dotop =
- ghexp ~loc (Pexp_ident (ghloc ~loc dotop))
-
-let array_function ~loc str name =
- ghloc ~loc (Ldot(Lident str,
- (if !Clflags.unsafe then "unsafe_" ^ name else name)))
-
-let array_get_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "Array" "get"))
-let string_get_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "String" "get"))
-
-let array_set_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "Array" "set"))
-let string_set_fun ~loc =
- ghexp ~loc (Pexp_ident(array_function ~loc "String" "set"))
-
-let multi_indices ~loc = function
- | [a] -> false, a
- | l -> true, mkexp ~loc (Pexp_array l)
-
-let index_get ~loc get_fun array index =
- let args = [Nolabel, array; Nolabel, index] in
- mkexp ~loc (Pexp_apply(get_fun, args))
-
-let index_set ~loc set_fun array index value =
- let args = [Nolabel, array; Nolabel, index; Nolabel, value] in
- mkexp ~loc (Pexp_apply(set_fun, args))
-
-let array_get ~loc = index_get ~loc (array_get_fun ~loc)
-let string_get ~loc = index_get ~loc (string_get_fun ~loc)
-let dotop_get ~loc path (left,right) ext array index =
- let multi, index = multi_indices ~loc index in
- index_get ~loc
- (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:false))
- array index
-
-let array_set ~loc = index_set ~loc (array_set_fun ~loc)
-let string_set ~loc = index_set ~loc (string_set_fun ~loc)
-let dotop_set ~loc path (left,right) ext array index value=
- let multi, index = multi_indices ~loc index in
- index_set ~loc
- (dotop_fun ~loc (path @@ dotop ~left ~right ~ext ~multi ~assign:true))
- array index value
-
-
-let bigarray_function ~loc str name =
- ghloc ~loc (Ldot(Ldot(Lident "Bigarray", str), name))
+(* Helper functions for desugaring array indexing operators *)
+type paren_kind = Paren | Brace | Bracket
+
+(* We classify the dimension of indices: Bigarray distinguishes
+ indices of dimension 1,2,3, or more. Similarly, user-defined
+ indexing operator behave differently for indices of dimension 1
+ or more.
+*)
+type index_dim =
+ | One
+ | Two
+ | Three
+ | Many
+type ('dot,'index) array_family = {
+
+ name:
+ Lexing.position * Lexing.position -> 'dot -> assign:bool -> paren_kind
+ -> index_dim -> Longident.t Location.loc
+ (*
+ This functions computes the name of the explicit indexing operator
+ associated with a sugared array indexing expression.
+
+ For instance, for builtin arrays, if Clflags.unsafe is set,
+ * [ a.[index] ] => [String.unsafe_get]
+ * [ a.{x,y} <- 1 ] => [ Bigarray.Array2.unsafe_set]
+
+ User-defined indexing operator follows a more local convention:
+ * [ a .%(index)] => [ (.%()) ]
+ * [ a.![1;2] <- 0 ] => [(.![;..]<-)]
+ * [ a.My.Map.?(0) => [My.Map.(.?())]
+ *);
+
+ index:
+ Lexing.position * Lexing.position -> paren_kind -> 'index
+ -> index_dim * (arg_label * expression) list
+ (*
+ [index (start,stop) paren index] computes the dimension of the
+ index argument and how it should be desugared when transformed
+ to a list of arguments for the indexing operator.
+ In particular, in both the Bigarray case and the user-defined case,
+ beyond a certain dimension, multiple indices are packed into a single
+ array argument:
+ * [ a.(x) ] => [ [One, [Nolabel, <<x>>] ]
+ * [ a.{1,2} ] => [ [Two, [Nolabel, <<1>>; Nolabel, <<2>>] ]
+ * [ a.{1,2,3,4} ] => [ [Many, [Nolabel, <<[|1;2;3;4|]>>] ] ]
+ *);
+
+}
let bigarray_untuplify = function
{ pexp_desc = Pexp_tuple explist; pexp_loc = _ } -> explist
| exp -> [exp]
-let bigarray_get ~loc arr arg =
- let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
- let bigarray_function = bigarray_function ~loc in
- let get = if !Clflags.unsafe then "unsafe_get" else "get" in
- match bigarray_untuplify arg with
- [c1] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" get)),
- [Nolabel, arr; Nolabel, c1]))
- | [c1;c2] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" get)),
- [Nolabel, arr; Nolabel, c1; Nolabel, c2]))
- | [c1;c2;c3] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" get)),
- [Nolabel, arr; Nolabel, c1; Nolabel, c2; Nolabel, c3]))
- | coords ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "get")),
- [Nolabel, arr; Nolabel, ghexp(Pexp_array coords)]))
-
-let bigarray_set ~loc arr arg newval =
- let mkexp, ghexp = mkexp ~loc, ghexp ~loc in
- let bigarray_function = bigarray_function ~loc in
- let set = if !Clflags.unsafe then "unsafe_set" else "set" in
- match bigarray_untuplify arg with
- [c1] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array1" set)),
- [Nolabel, arr; Nolabel, c1; Nolabel, newval]))
- | [c1;c2] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array2" set)),
- [Nolabel, arr; Nolabel, c1;
- Nolabel, c2; Nolabel, newval]))
- | [c1;c2;c3] ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Array3" set)),
- [Nolabel, arr; Nolabel, c1;
- Nolabel, c2; Nolabel, c3; Nolabel, newval]))
- | coords ->
- mkexp(Pexp_apply(ghexp(Pexp_ident(bigarray_function "Genarray" "set")),
- [Nolabel, arr;
- Nolabel, ghexp(Pexp_array coords);
- Nolabel, newval]))
+let builtin_arraylike_name loc _ ~assign paren_kind n =
+ let opname = if assign then "set" else "get" in
+ let opname = if !Clflags.unsafe then "unsafe_" ^ opname else opname in
+ let prefix = match paren_kind with
+ | Paren -> Lident "Array"
+ | Bracket -> Lident "String"
+ | Brace ->
+ let submodule_name = match n with
+ | One -> "Array1"
+ | Two -> "Array2"
+ | Three -> "Array3"
+ | Many -> "Genarray" in
+ Ldot(Lident "Bigarray", submodule_name) in
+ ghloc ~loc (Ldot(prefix,opname))
+
+let builtin_arraylike_index loc paren_kind index = match paren_kind with
+ | Paren | Bracket -> One, [Nolabel, index]
+ | Brace ->
+ (* Multi-indices for bigarray are comma-separated ([a.{1,2,3,4}]) *)
+ match bigarray_untuplify index with
+ | [x] -> One, [Nolabel, x]
+ | [x;y] -> Two, [Nolabel, x; Nolabel, y]
+ | [x;y;z] -> Three, [Nolabel, x; Nolabel, y; Nolabel, z]
+ | coords -> Many, [Nolabel, ghexp ~loc (Pexp_array coords)]
+
+let builtin_indexing_operators : (unit, expression) array_family =
+ { index = builtin_arraylike_index; name = builtin_arraylike_name }
+
+let paren_to_strings = function
+ | Paren -> "(", ")"
+ | Bracket -> "[", "]"
+ | Brace -> "{", "}"
+
+let user_indexing_operator_name loc (prefix,ext) ~assign paren_kind n =
+ let name =
+ let assign = if assign then "<-" else "" in
+ let mid = match n with
+ | Many | Three | Two -> ";.."
+ | One -> "" in
+ let left, right = paren_to_strings paren_kind in
+ String.concat "" ["."; ext; left; mid; right; assign] in
+ let lid = match prefix with
+ | None -> Lident name
+ | Some p -> Ldot(p,name) in
+ ghloc ~loc lid
+
+let user_index loc _ index =
+ (* Multi-indices for user-defined operators are semicolon-separated
+ ([a.%[1;2;3;4]]) *)
+ match index with
+ | [a] -> One, [Nolabel, a]
+ | l -> Many, [Nolabel, mkexp ~loc (Pexp_array l)]
+
+let user_indexing_operators:
+ (Longident.t option * string, expression list) array_family
+ = { index = user_index; name = user_indexing_operator_name }
+
+let mk_indexop_expr array_indexing_operator ~loc
+ (array,dot,paren,index,set_expr) =
+ let assign = match set_expr with None -> false | Some _ -> true in
+ let n, index = array_indexing_operator.index loc paren index in
+ let fn = array_indexing_operator.name loc dot ~assign paren n in
+ let set_arg = match set_expr with
+ | None -> []
+ | Some expr -> [Nolabel, expr] in
+ let args = (Nolabel,array) :: index @ set_arg in
+ mkexp ~loc (Pexp_apply(ghexp ~loc (Pexp_ident fn), args))
+
+let indexop_unclosed_error loc_s s loc_e =
+ let left, right = paren_to_strings s in
+ unclosed left loc_s right loc_e
let lapply ~loc p1 p2 =
if !Clflags.applicative_functors
type let_binding =
{ lb_pattern: pattern;
lb_expression: expression;
+ lb_is_pun: bool;
lb_attributes: attributes;
lb_docs: docs Lazy.t;
lb_text: text Lazy.t;
type let_bindings =
{ lbs_bindings: let_binding list;
lbs_rec: rec_flag;
- lbs_extension: string Asttypes.loc option;
- lbs_loc: Location.t }
+ lbs_extension: string Asttypes.loc option }
-let mklb first ~loc (p, e) attrs =
+let mklb first ~loc (p, e, is_pun) attrs =
{
lb_pattern = p;
lb_expression = e;
+ lb_is_pun = is_pun;
lb_attributes = attrs;
lb_docs = symbol_docs_lazy loc;
lb_text = (if first then empty_text_lazy
lb_loc = make_loc loc;
}
-let mklbs ~loc ext rf lb =
- {
- lbs_bindings = [lb];
- lbs_rec = rf;
- lbs_extension = ext ;
- lbs_loc = make_loc loc;
- }
-
let addlb lbs lb =
+ if lb.lb_is_pun && lbs.lbs_extension = None then syntax_error ();
{ lbs with lbs_bindings = lb :: lbs.lbs_bindings }
+let mklbs ext rf lb =
+ let lbs = {
+ lbs_bindings = [];
+ lbs_rec = rf;
+ lbs_extension = ext;
+ } in
+ addlb lbs lb
+
let val_of_let_bindings ~loc lbs =
let bindings =
List.map
/* Tokens */
-%token AMPERAMPER
-%token AMPERSAND
-%token AND
-%token AS
-%token ASSERT
-%token BACKQUOTE
-%token BANG
-%token BAR
-%token BARBAR
-%token BARRBRACKET
-%token BEGIN
-%token <char> CHAR
-%token CLASS
-%token COLON
-%token COLONCOLON
-%token COLONEQUAL
-%token COLONGREATER
-%token COMMA
-%token CONSTRAINT
-%token DO
-%token DONE
-%token DOT
-%token DOTDOT
-%token DOWNTO
-%token ELSE
-%token END
-%token EOF
-%token EQUAL
-%token EXCEPTION
-%token EXTERNAL
-%token FALSE
-%token <string * char option> FLOAT
-%token FOR
-%token FUN
-%token FUNCTION
-%token FUNCTOR
-%token GREATER
-%token GREATERRBRACE
-%token GREATERRBRACKET
-%token IF
-%token IN
-%token INCLUDE
-%token <string> INFIXOP0
-%token <string> INFIXOP1
-%token <string> INFIXOP2
-%token <string> INFIXOP3
-%token <string> INFIXOP4
-%token <string> DOTOP
-%token <string> LETOP
-%token <string> ANDOP
-%token INHERIT
-%token INITIALIZER
-%token <string * char option> INT
-%token <string> LABEL
-%token LAZY
-%token LBRACE
-%token LBRACELESS
-%token LBRACKET
-%token LBRACKETBAR
-%token LBRACKETLESS
-%token LBRACKETGREATER
-%token LBRACKETPERCENT
-%token LBRACKETPERCENTPERCENT
-%token LESS
-%token LESSMINUS
-%token LET
-%token <string> LIDENT
-%token LPAREN
-%token LBRACKETAT
-%token LBRACKETATAT
-%token LBRACKETATATAT
-%token MATCH
-%token METHOD
-%token MINUS
-%token MINUSDOT
-%token MINUSGREATER
-%token MODULE
-%token MUTABLE
-%token NEW
-%token NONREC
-%token OBJECT
-%token OF
-%token OPEN
-%token <string> OPTLABEL
-%token OR
-/* %token PARSER */
-%token PERCENT
-%token PLUS
-%token PLUSDOT
-%token PLUSEQ
-%token <string> PREFIXOP
-%token PRIVATE
-%token QUESTION
-%token QUOTE
-%token RBRACE
-%token RBRACKET
-%token REC
-%token RPAREN
-%token SEMI
-%token SEMISEMI
-%token HASH
-%token <string> HASHOP
-%token SIG
-%token STAR
-%token <string * Location.t * string option> STRING
-%token
- <string * Location.t * string * Location.t * string option> QUOTED_STRING_EXPR
-%token
- <string * Location.t * string * Location.t * string option> QUOTED_STRING_ITEM
-%token STRUCT
-%token THEN
-%token TILDE
-%token TO
-%token TRUE
-%token TRY
-%token TYPE
-%token <string> UIDENT
-%token UNDERSCORE
-%token VAL
-%token VIRTUAL
-%token WHEN
-%token WHILE
-%token WITH
-%token <string * Location.t> COMMENT
-%token <Docstrings.docstring> DOCSTRING
-
-%token EOL
+/* The alias that follows each token is used by Menhir when it needs to
+ produce a sentence (that is, a sequence of tokens) in concrete syntax. */
+
+/* Some tokens represent multiple concrete strings. In most cases, an
+ arbitrary concrete string can be chosen. In a few cases, one must
+ be careful: e.g., in PREFIXOP and INFIXOP2, one must choose a concrete
+ string that will not trigger a syntax error; see how [not_expecting]
+ is used in the definition of [type_variance]. */
+
+%token AMPERAMPER "&&"
+%token AMPERSAND "&"
+%token AND "and"
+%token AS "as"
+%token ASSERT "assert"
+%token BACKQUOTE "`"
+%token BANG "!"
+%token BAR "|"
+%token BARBAR "||"
+%token BARRBRACKET "|]"
+%token BEGIN "begin"
+%token <char> CHAR "'a'" (* just an example *)
+%token CLASS "class"
+%token COLON ":"
+%token COLONCOLON "::"
+%token COLONEQUAL ":="
+%token COLONGREATER ":>"
+%token COMMA ","
+%token CONSTRAINT "constraint"
+%token DO "do"
+%token DONE "done"
+%token DOT "."
+%token DOTDOT ".."
+%token DOWNTO "downto"
+%token ELSE "else"
+%token END "end"
+%token EOF ""
+%token EQUAL "="
+%token EXCEPTION "exception"
+%token EXTERNAL "external"
+%token FALSE "false"
+%token <string * char option> FLOAT "42.0" (* just an example *)
+%token FOR "for"
+%token FUN "fun"
+%token FUNCTION "function"
+%token FUNCTOR "functor"
+%token GREATER ">"
+%token GREATERRBRACE ">}"
+%token GREATERRBRACKET ">]"
+%token IF "if"
+%token IN "in"
+%token INCLUDE "include"
+%token <string> INFIXOP0 "!=" (* just an example *)
+%token <string> INFIXOP1 "@" (* just an example *)
+%token <string> INFIXOP2 "+!" (* chosen with care; see above *)
+%token <string> INFIXOP3 "land" (* just an example *)
+%token <string> INFIXOP4 "**" (* just an example *)
+%token <string> DOTOP ".+"
+%token <string> LETOP "let*" (* just an example *)
+%token <string> ANDOP "and*" (* just an example *)
+%token INHERIT "inherit"
+%token INITIALIZER "initializer"
+%token <string * char option> INT "42" (* just an example *)
+%token <string> LABEL "~label:" (* just an example *)
+%token LAZY "lazy"
+%token LBRACE "{"
+%token LBRACELESS "{<"
+%token LBRACKET "["
+%token LBRACKETBAR "[|"
+%token LBRACKETLESS "[<"
+%token LBRACKETGREATER "[>"
+%token LBRACKETPERCENT "[%"
+%token LBRACKETPERCENTPERCENT "[%%"
+%token LESS "<"
+%token LESSMINUS "<-"
+%token LET "let"
+%token <string> LIDENT "lident" (* just an example *)
+%token LPAREN "("
+%token LBRACKETAT "[@"
+%token LBRACKETATAT "[@@"
+%token LBRACKETATATAT "[@@@"
+%token MATCH "match"
+%token METHOD "method"
+%token MINUS "-"
+%token MINUSDOT "-."
+%token MINUSGREATER "->"
+%token MODULE "module"
+%token MUTABLE "mutable"
+%token NEW "new"
+%token NONREC "nonrec"
+%token OBJECT "object"
+%token OF "of"
+%token OPEN "open"
+%token <string> OPTLABEL "?label:" (* just an example *)
+%token OR "or"
+/* %token PARSER "parser" */
+%token PERCENT "%"
+%token PLUS "+"
+%token PLUSDOT "+."
+%token PLUSEQ "+="
+%token <string> PREFIXOP "!+" (* chosen with care; see above *)
+%token PRIVATE "private"
+%token QUESTION "?"
+%token QUOTE "'"
+%token RBRACE "}"
+%token RBRACKET "]"
+%token REC "rec"
+%token RPAREN ")"
+%token SEMI ";"
+%token SEMISEMI ";;"
+%token HASH "#"
+%token <string> HASHOP "##" (* just an example *)
+%token SIG "sig"
+%token STAR "*"
+%token <string * Location.t * string option>
+ STRING "\"hello\"" (* just an example *)
+%token <string * Location.t * string * Location.t * string option>
+ QUOTED_STRING_EXPR "{%hello|world|}" (* just an example *)
+%token <string * Location.t * string * Location.t * string option>
+ QUOTED_STRING_ITEM "{%%hello|world|}" (* just an example *)
+%token STRUCT "struct"
+%token THEN "then"
+%token TILDE "~"
+%token TO "to"
+%token TRUE "true"
+%token TRY "try"
+%token TYPE "type"
+%token <string> UIDENT "UIdent" (* just an example *)
+%token UNDERSCORE "_"
+%token VAL "val"
+%token VIRTUAL "virtual"
+%token WHEN "when"
+%token WHILE "while"
+%token WITH "with"
+%token <string * Location.t> COMMENT "(* comment *)"
+%token <Docstrings.docstring> DOCSTRING "(** documentation *)"
+
+%token EOL "\\n" (* not great, but EOL is unused *)
/* Precedences and associativities.
/* Entry points */
+/* Several start symbols are marked with AVOID so that they are not used by
+ [make generate-parse-errors]. The three start symbols that we keep are
+ [implementation], [use_file], and [toplevel_phrase]. The latter two are
+ of marginal importance; only [implementation] really matters, since most
+ states in the automaton are reachable from it. */
+
%start implementation /* for implementation files */
%type <Parsetree.structure> implementation
+/* BEGIN AVOID */
%start interface /* for interface files */
%type <Parsetree.signature> interface
+/* END AVOID */
%start toplevel_phrase /* for interactive use */
%type <Parsetree.toplevel_phrase> toplevel_phrase
%start use_file /* for the #use directive */
%type <Parsetree.toplevel_phrase list> use_file
+/* BEGIN AVOID */
%start parse_core_type
%type <Parsetree.core_type> parse_core_type
%start parse_expression
%type <Longident.t> parse_mod_longident
%start parse_any_longident
%type <Longident.t> parse_any_longident
+/* END AVOID */
+
%%
/* macros */
{ $1 }
;
+/* BEGIN AVOID */
(* An .mli file. *)
interface:
signature EOF
{ $1 }
;
+/* END AVOID */
(* A toplevel phrase. *)
toplevel_phrase:
{ $1 }
;
+/* BEGIN AVOID */
parse_core_type:
core_type EOF
{ $1 }
any_longident EOF
{ $1 }
;
+/* END AVOID */
+
(* -------------------------------------------------------------------------- *)
(* Functor arguments appear in module expressions and module types. *)
{ let (ext, l) = $1 in (Psig_recmodule l, ext) }
| module_type_declaration
{ let (body, ext) = $1 in (Psig_modtype body, ext) }
+ | module_type_subst
+ { let (body, ext) = $1 in (Psig_modtypesubst body, ext) }
| open_description
{ let (body, ext) = $1 in (Psig_open body, ext) }
| include_statement(module_type)
}
;
+(* A module type substitution *)
+module_type_subst:
+ MODULE TYPE
+ ext = ext
+ attrs1 = attributes
+ id = mkrhs(ident)
+ COLONEQUAL
+ typ=module_type
+ attrs2 = post_item_attributes
+ {
+ let attrs = attrs1 @ attrs2 in
+ let loc = make_loc $sloc in
+ let docs = symbol_docs $sloc in
+ Mtd.mk id ~typ ~attrs ~loc ~docs, ext
+ }
+
+
(* -------------------------------------------------------------------------- *)
(* Class declarations. *)
{ $1 }
;
+%inline indexop_expr(dot, index, right):
+ | array=simple_expr d=dot LPAREN i=index RPAREN r=right
+ { array, d, Paren, i, r }
+ | array=simple_expr d=dot LBRACE i=index RBRACE r=right
+ { array, d, Brace, i, r }
+ | array=simple_expr d=dot LBRACKET i=index RBRACKET r=right
+ { array, d, Bracket, i, r }
+;
+
+%inline indexop_error(dot, index):
+ | simple_expr dot _p=LPAREN index _e=error
+ { indexop_unclosed_error $loc(_p) Paren $loc(_e) }
+ | simple_expr dot _p=LBRACE index _e=error
+ { indexop_unclosed_error $loc(_p) Brace $loc(_e) }
+ | simple_expr dot _p=LBRACKET index _e=error
+ { indexop_unclosed_error $loc(_p) Bracket $loc(_e) }
+;
+
+%inline qualified_dotop: ioption(DOT mod_longident {$2}) DOTOP { $1, $2 };
+
expr:
simple_expr %prec below_HASH
{ $1 }
{ mkexp ~loc:$sloc (Pexp_setinstvar($1, $3)) }
| simple_expr DOT mkrhs(label_longident) LESSMINUS expr
{ mkexp ~loc:$sloc (Pexp_setfield($1, $3, $5)) }
- | simple_expr DOT LPAREN seq_expr RPAREN LESSMINUS expr
- { array_set ~loc:$sloc $1 $4 $7 }
- | simple_expr DOT LBRACKET seq_expr RBRACKET LESSMINUS expr
- { string_set ~loc:$sloc $1 $4 $7 }
- | simple_expr DOT LBRACE expr RBRACE LESSMINUS expr
- { bigarray_set ~loc:$sloc $1 $4 $7 }
- | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET LESSMINUS expr
- { dotop_set ~loc:$sloc lident bracket $2 $1 $4 $7 }
- | simple_expr DOTOP LPAREN expr_semi_list RPAREN LESSMINUS expr
- { dotop_set ~loc:$sloc lident paren $2 $1 $4 $7 }
- | simple_expr DOTOP LBRACE expr_semi_list RBRACE LESSMINUS expr
- { dotop_set ~loc:$sloc lident brace $2 $1 $4 $7 }
- | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
- LESSMINUS expr
- { dotop_set ~loc:$sloc (ldot $3) bracket $4 $1 $6 $9 }
- | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
- LESSMINUS expr
- { dotop_set ~loc:$sloc (ldot $3) paren $4 $1 $6 $9 }
- | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
- LESSMINUS expr
- { dotop_set ~loc:$sloc (ldot $3) brace $4 $1 $6 $9 }
+ | indexop_expr(DOT, seq_expr, LESSMINUS v=expr {Some v})
+ { mk_indexop_expr builtin_indexing_operators ~loc:$sloc $1 }
+ | indexop_expr(qualified_dotop, expr_semi_list, LESSMINUS v=expr {Some v})
+ { mk_indexop_expr user_indexing_operators ~loc:$sloc $1 }
| expr attribute
{ Exp.attr $1 $2 }
+/* BEGIN AVOID */
| UNDERSCORE
{ not_expecting $loc($1) "wildcard \"_\"" }
+/* END AVOID */
;
%inline expr_attrs:
| LET MODULE ext_attributes mkrhs(module_name) module_binding_body IN seq_expr
{ unclosed "(" $loc($1) ")" $loc($3) }
| LPAREN seq_expr type_constraint RPAREN
{ mkexp_constraint ~loc:$sloc $2 $3 }
- | simple_expr DOT LPAREN seq_expr RPAREN
- { array_get ~loc:$sloc $1 $4 }
- | simple_expr DOT LPAREN seq_expr error
- { unclosed "(" $loc($3) ")" $loc($5) }
- | simple_expr DOT LBRACKET seq_expr RBRACKET
- { string_get ~loc:$sloc $1 $4 }
- | simple_expr DOT LBRACKET seq_expr error
- { unclosed "[" $loc($3) "]" $loc($5) }
- | simple_expr DOTOP LBRACKET expr_semi_list RBRACKET
- { dotop_get ~loc:$sloc lident bracket $2 $1 $4 }
- | simple_expr DOTOP LBRACKET expr_semi_list error
- { unclosed "[" $loc($3) "]" $loc($5) }
- | simple_expr DOTOP LPAREN expr_semi_list RPAREN
- { dotop_get ~loc:$sloc lident paren $2 $1 $4 }
- | simple_expr DOTOP LPAREN expr_semi_list error
- { unclosed "(" $loc($3) ")" $loc($5) }
- | simple_expr DOTOP LBRACE expr_semi_list RBRACE
- { dotop_get ~loc:$sloc lident brace $2 $1 $4 }
- | simple_expr DOTOP LBRACE expr error
- { unclosed "{" $loc($3) "}" $loc($5) }
- | simple_expr DOT mod_longident DOTOP LBRACKET expr_semi_list RBRACKET
- { dotop_get ~loc:$sloc (ldot $3) bracket $4 $1 $6 }
- | simple_expr DOT
- mod_longident DOTOP LBRACKET expr_semi_list error
- { unclosed "[" $loc($5) "]" $loc($7) }
- | simple_expr DOT mod_longident DOTOP LPAREN expr_semi_list RPAREN
- { dotop_get ~loc:$sloc (ldot $3) paren $4 $1 $6 }
- | simple_expr DOT
- mod_longident DOTOP LPAREN expr_semi_list error
- { unclosed "(" $loc($5) ")" $loc($7) }
- | simple_expr DOT mod_longident DOTOP LBRACE expr_semi_list RBRACE
- { dotop_get ~loc:$sloc (ldot $3) brace $4 $1 $6 }
- | simple_expr DOT
- mod_longident DOTOP LBRACE expr_semi_list error
- { unclosed "{" $loc($5) "}" $loc($7) }
- | simple_expr DOT LBRACE expr RBRACE
- { bigarray_get ~loc:$sloc $1 $4 }
- | simple_expr DOT LBRACE expr error
- { unclosed "{" $loc($3) "}" $loc($5) }
+ | indexop_expr(DOT, seq_expr, { None })
+ { mk_indexop_expr builtin_indexing_operators ~loc:$sloc $1 }
+ | indexop_expr(qualified_dotop, expr_semi_list, { None })
+ { mk_indexop_expr user_indexing_operators ~loc:$sloc $1 }
+ | indexop_error (DOT, seq_expr) { $1 }
+ | indexop_error (qualified_dotop, expr_semi_list) { $1 }
| simple_expr_attrs
{ let desc, attrs = $1 in
mkexp_attrs ~loc:$sloc desc attrs }
%inline let_ident:
val_ident { mkpatvar ~loc:$sloc $1 }
;
-let_binding_body:
+let_binding_body_no_punning:
let_ident strict_binding
{ ($1, $2) }
| let_ident type_constraint EQUAL seq_expr
{ let loc = ($startpos($1), $endpos($3)) in
(ghpat ~loc (Ppat_constraint($1, $3)), $5) }
;
+let_binding_body:
+ | let_binding_body_no_punning
+ { let p,e = $1 in (p,e,false) }
+/* BEGIN AVOID */
+ | val_ident %prec below_HASH
+ { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1, true) }
+ (* The production that allows puns is marked so that [make list-parse-errors]
+ does not attempt to exploit it. That would be problematic because it
+ would then generate bindings such as [let x], which are rejected by the
+ auxiliary function [addlb] via a call to [syntax_error]. *)
+/* END AVOID */
+;
(* The formal parameter EXT can be instantiated with ext or no_ext
so as to indicate whether an extension is allowed or disallowed. *)
let_bindings(EXT):
attrs2 = post_item_attributes
{
let attrs = attrs1 @ attrs2 in
- mklbs ~loc:$sloc ext rec_flag (mklb ~loc:$sloc true body attrs)
+ mklbs ext rec_flag (mklb ~loc:$sloc true body attrs)
}
;
and_let_binding:
letop_binding_body:
pat = let_ident exp = strict_binding
{ (pat, exp) }
+ | val_ident
+ (* Let-punning *)
+ { (mkpatvar ~loc:$loc $1, mkexpvar ~loc:$loc $1) }
| pat = simple_pattern COLON typ = core_type EQUAL exp = seq_expr
{ let loc = ($startpos(pat), $endpos(typ)) in
(ghpat ~loc (Ppat_constraint(pat, typ)), exp) }
body = letop_binding_body
{ let let_pat, let_exp = body in
let_pat, let_exp, [] }
- | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = let_binding_body
+ | bindings = letop_bindings pbop_op = mkrhs(ANDOP) body = letop_binding_body
{ let let_pat, let_exp, rev_ands = bindings in
let pbop_pat, pbop_exp = body in
let pbop_loc = make_loc $sloc in
{ $1 }
| mkpat(
mkrhs(constr_longident) pattern %prec prec_constr_appl
- { Ppat_construct($1, Some $2) }
+ { Ppat_construct($1, Some ([], $2)) }
+ | constr=mkrhs(constr_longident) LPAREN TYPE newtypes=lident_list RPAREN
+ pat=simple_pattern
+ { Ppat_construct(constr, Some (newtypes, pat)) }
| name_tag pattern %prec prec_constr_appl
{ Ppat_variant($1, Some $2) }
) { $1 }
{ Pwith_module ($2, $4) }
| MODULE mkrhs(mod_longident) COLONEQUAL mkrhs(mod_ext_longident)
{ Pwith_modsubst ($2, $4) }
+ | MODULE TYPE l=mkrhs(mty_longident) EQUAL rhs=module_type
+ { Pwith_modtype (l, rhs) }
+ | MODULE TYPE l=mkrhs(mty_longident) COLONEQUAL rhs=module_type
+ { Pwith_modtypesubst (l, rhs) }
;
with_type_binder:
EQUAL { Public }
mk_longident(mod_longident,LIDENT) { $1 }
;
+/* BEGIN AVOID */
/* For compiler-libs: parse all valid longidents and a little more:
final identifiers which are value specific are accepted even when
the path prefix is only valid for types: (e.g. F(X).(::)) */
) { $1 }
| constr_extra_nonprefix_ident { Lident $1 }
;
+/* END AVOID */
/* Toplevel directives */
;
%inline no_nonrec_flag:
/* empty */ { Recursive }
+/* BEGIN AVOID */
| NONREC { not_expecting $loc "nonrec flag" }
+/* END AVOID */
;
direction_flag:
TO { Upto }
;
%inline no_ext:
| /* empty */ { None }
+/* BEGIN AVOID */
| PERCENT attr_id { not_expecting $loc "extension" }
+/* END AVOID */
;
%inline ext_attributes:
ext attributes { $1, $2 }
Invariant: n >= 2
*)
- | Ppat_construct of Longident.t loc * pattern option
- (* C None
- C P Some P
- C (P1, ..., Pn) Some (Ppat_tuple [P1; ...; Pn])
+ | Ppat_construct of
+ Longident.t loc * (string loc list * pattern) option
+ (* C None
+ C P Some ([], P)
+ C (P1, ..., Pn) Some ([], Ppat_tuple [P1; ...; Pn])
+ C (type a b) P Some ([a; b], P)
*)
| Ppat_variant of label * pattern option
(* `A (None)
| Psig_modtype of module_type_declaration
(* module type S = MT
module type S *)
+ | Psig_modtypesubst of module_type_declaration
+ (* module type S := ... *)
| Psig_open of open_description
(* open X *)
| Psig_include of include_description
the name of the type_declaration. *)
| Pwith_module of Longident.t loc * Longident.t loc
(* with module X.Y = Z *)
+ | Pwith_modtype of Longident.t loc * module_type
+ (* with module type X.Y = Z *)
+ | Pwith_modtypesubst of Longident.t loc * module_type
+ (* with module type X.Y := sig end *)
| Pwith_typesubst of Longident.t loc * type_declaration
(* with type X.t := ..., same format as [Pwith_type] *)
| Pwith_modsubst of Longident.t loc * Longident.t loc
let needs_spaces txt =
first_is '*' txt || last_is '*' txt
+let string_loc ppf x = fprintf ppf "%s" x.txt
+
(* add parentheses to binders when they are in fact infix or prefix operators *)
let protect_ident ppf txt =
let format : (_, _, _) format =
| {ppat_desc =
Ppat_construct
({ txt = Lident("::") ;_},
- Some ({ppat_desc = Ppat_tuple([pat1; pat2]);_}));
+ Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_}));
ppat_attributes = []}
->
else match x.ppat_desc with
| Ppat_variant (l, Some p) ->
pp f "@[<2>`%s@;%a@]" l (simple_pattern ctxt) p
- | Ppat_construct (({txt=Lident("()"|"[]");_}), _) -> simple_pattern ctxt f x
+ | Ppat_construct (({txt=Lident("()"|"[]");_}), _) ->
+ simple_pattern ctxt f x
| Ppat_construct (({txt;_} as li), po) ->
(* FIXME The third field always false *)
if txt = Lident "::" then
pp f "%a" pattern_list_helper x
else
(match po with
- | Some x -> pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
+ | Some ([], x) ->
+ pp f "%a@;%a" longident_loc li (simple_pattern ctxt) x
+ | Some (vl, x) ->
+ pp f "%a@ (type %a)@;%a" longident_loc li
+ (list ~sep:"@ " string_loc) vl
+ (simple_pattern ctxt) x
| None -> pp f "%a" longident_loc li)
| _ -> simple_pattern ctxt f x
and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit =
if x.ppat_attributes <> [] then pattern ctxt f x
else match x.ppat_desc with
- | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), _) -> pp f "%s" x
+ | Ppat_construct (({txt=Lident ("()"|"[]" as x);_}), None) ->
+ pp f "%s" x
| Ppat_any -> pp f "_";
| Ppat_var ({txt = txt;_}) -> protect_ident f txt
| Ppat_array l ->
let with_paren =
match p.ppat_desc with
| Ppat_array _ | Ppat_record _
- | Ppat_construct (({txt=Lident ("()"|"[]");_}), _) -> false
+ | Ppat_construct (({txt=Lident ("()"|"[]");_}), None) -> false
| _ -> true in
pp f "@[<2>%a.%a @]" longident_loc lid
(paren with_paren @@ pattern1 ctxt) p
end
| Pmty_with (mt, []) -> module_type ctxt f mt
| Pmty_with (mt, l) ->
- let with_constraint f = function
- | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
- let ls = List.map fst ls in
- pp f "type@ %a %a =@ %a"
- (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
- ls longident_loc li (type_declaration ctxt) td
- | Pwith_module (li, li2) ->
- pp f "module %a =@ %a" longident_loc li longident_loc li2;
- | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
- let ls = List.map fst ls in
- pp f "type@ %a %a :=@ %a"
- (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
- ls longident_loc li
- (type_declaration ctxt) td
- | Pwith_modsubst (li, li2) ->
- pp f "module %a :=@ %a" longident_loc li longident_loc li2 in
pp f "@[<hov2>%a@ with@ %a@]"
- (module_type1 ctxt) mt (list with_constraint ~sep:"@ and@ ") l
+ (module_type1 ctxt) mt
+ (list (with_constraint ctxt) ~sep:"@ and@ ") l
| _ -> module_type1 ctxt f x
+and with_constraint ctxt f = function
+ | Pwith_type (li, ({ptype_params= ls ;_} as td)) ->
+ let ls = List.map fst ls in
+ pp f "type@ %a %a =@ %a"
+ (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+ ls longident_loc li (type_declaration ctxt) td
+ | Pwith_module (li, li2) ->
+ pp f "module %a =@ %a" longident_loc li longident_loc li2;
+ | Pwith_modtype (li, mty) ->
+ pp f "module type %a =@ %a" longident_loc li (module_type ctxt) mty;
+ | Pwith_typesubst (li, ({ptype_params=ls;_} as td)) ->
+ let ls = List.map fst ls in
+ pp f "type@ %a %a :=@ %a"
+ (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")")
+ ls longident_loc li
+ (type_declaration ctxt) td
+ | Pwith_modsubst (li, li2) ->
+ pp f "module %a :=@ %a" longident_loc li longident_loc li2
+ | Pwith_modtypesubst (li, mty) ->
+ pp f "module type %a :=@ %a" longident_loc li (module_type ctxt) mty;
+
+
and module_type1 ctxt f x =
if x.pmty_attributes <> [] then module_type ctxt f x
else match x.pmty_desc with
| Psig_type (rf, l) ->
type_def_list ctxt f (rf, true, l)
| Psig_typesubst l ->
- type_def_list ctxt f (Nonrecursive, false, l)
+ (* Psig_typesubst is never recursive, but we specify [Recursive] here to
+ avoid printing a [nonrec] flag, which would be rejected by the parser.
+ *)
+ type_def_list ctxt f (Recursive, false, l)
| Psig_value vd ->
let intro = if vd.pval_prim = [] then "val" else "external" in
pp f "@[<2>%s@ %a@ :@ %a@]%a" intro
pp f "@ =@ %a" (module_type ctxt) mt
) md
(item_attributes ctxt) attrs
+ | Psig_modtypesubst {pmtd_name=s; pmtd_type=md; pmtd_attributes=attrs} ->
+ let md = match md with
+ | None -> assert false (* ast invariant *)
+ | Some mt -> mt in
+ pp f "@[<hov2>module@ type@ %s@ :=@ %a@]%a"
+ s.txt (module_type ctxt) md
+ (item_attributes ctxt) attrs
| Psig_class_type (l) -> class_type_declaration_list ctxt f l
| Psig_recmodule decls ->
let rec string_x_module_type_list f ?(first=true) l =
(list ~sep:"@," (binding "and" Nonrecursive)) xs
and binding_op ctxt f x =
- pp f "@[<2>%s %a@;=@;%a@]"
- x.pbop_op.txt (pattern ctxt) x.pbop_pat (expression ctxt) x.pbop_exp
+ match x.pbop_pat, x.pbop_exp with
+ | {ppat_desc = Ppat_var { txt=pvar; _ }; ppat_attributes = []; _},
+ {pexp_desc = Pexp_ident { txt=Lident evar; _}; pexp_attributes = []; _}
+ when pvar = evar ->
+ pp f "@[<2>%s %s@]" x.pbop_op.txt evar
+ | pat, exp ->
+ pp f "@[<2>%s %a@;=@;%a@]"
+ x.pbop_op.txt (pattern ctxt) pat (expression ctxt) exp
and structure_item ctxt f x =
match x.pstr_desc with
let pattern = pattern reset_ctxt
let signature = signature reset_ctxt
let structure = structure reset_ctxt
+let module_expr = module_expr reset_ctxt
val structure: Format.formatter -> Parsetree.structure -> unit
val string_of_structure: Parsetree.structure -> string
+val module_expr: Format.formatter -> Parsetree.module_expr -> unit
+
val toplevel_phrase : Format.formatter -> Parsetree.toplevel_phrase -> unit
val top_phrase: Format.formatter -> Parsetree.toplevel_phrase -> unit
list i pattern ppf l;
| Ppat_construct (li, po) ->
line i ppf "Ppat_construct %a\n" fmt_longident_loc li;
- option i pattern ppf po;
+ option i
+ (fun i ppf (vl, p) ->
+ list i string_loc ppf vl;
+ pattern i ppf p)
+ ppf po
| Ppat_variant (l, po) ->
line i ppf "Ppat_variant \"%s\"\n" l;
option i pattern ppf po;
line i ppf "Psig_modtype %a\n" fmt_string_loc x.pmtd_name;
attributes i ppf x.pmtd_attributes;
modtype_declaration i ppf x.pmtd_type
+ | Psig_modtypesubst x ->
+ line i ppf "Psig_modtypesubst %a\n" fmt_string_loc x.pmtd_name;
+ attributes i ppf x.pmtd_attributes;
+ modtype_declaration i ppf x.pmtd_type
| Psig_open od ->
line i ppf "Psig_open %a %a\n" fmt_override_flag od.popen_override
fmt_longident_loc od.popen_expr;
line i ppf "Pwith_modsubst %a = %a\n"
fmt_longident_loc lid1
fmt_longident_loc lid2;
+ | Pwith_modtype (lid1, mty) ->
+ line i ppf "Pwith_modtype %a\n"
+ fmt_longident_loc lid1;
+ module_type (i+1) ppf mty
+ | Pwith_modtypesubst (lid1, mty) ->
+ line i ppf "Pwith_modtypesubst %a\n"
+ fmt_longident_loc lid1;
+ module_type (i+1) ppf mty
and module_expr i ppf x =
line i ppf "module_expr %a\n" fmt_location x.pmod_loc;
cat >/tmp/env-$USER.sh <<EOF
# Update the data below
export MAJOR=4
-export MINOR=08
+export MINOR=13
export BUGFIX=0
-export PLUSEXT=
+export PLUSEXT=~alpha1
# names for the release announce
-export HUMAN=
+export HUMAN=Florian Angeletti
# do we need to use tar or gtar?
export TAR=tar
export BRANCH=\$MAJOR.\$MINOR
export VERSION=\$MAJOR.\$MINOR.\$BUGFIX\$PLUSEXT
+export TAGVERSION=\`echo \$VERSION | sed s/\~/-/g\`
export REPO=https://github.com/ocaml/ocaml
# update VERSION with the new release; for example,
# 4.07.0+dev9-2018-06-26 => 4.07.0+rc2
# Update ocaml-variants.opam with new version.
-# Update \year in manual/manual/macros.hva
+# Update \year in manual/src/macros.hva
make -B configure
# For a production release
make coreboot -j5
make coreboot -j5 # must say "Fixpoint reached, bootstrap succeeded."
git commit -m "release $VERSION" -a
-git tag -m "release $VERSION" $VERSION
+git tag -m "release $VERSION" $TAGVERSION
# for production releases, change the VERSION file into (N+1)+dev0; for example,
# 4.08.0 => 4.08.1+dev0
make -B configure
# Add a "Working version" section" to Changes
# Add common subsections in Changes, see Changelog.
-git commit -m "first commit after branching $VERSION" -a
+git commit -m "first commit after branching $BRANCH" -a
git push
# Switch to the new branch
## 5.4 new badge in README.adoc (for a new release branch)
Add a badge for the new branch in README.adoc.
-Remove any badge that tracks a version older than Debian stable.
-
+Remove the oldest badge.
## 6: create OPAM packages
```
cd $WORKTREE
TMPDIR=/tmp/ocaml-release
-git checkout $VERSION
+git checkout $TAGVERSION
git checkout-index -a -f --prefix=$TMPDIR/ocaml-$VERSION/
cd $TMPDIR
$TAR -c --owner 0 --group 0 -f ocaml-$VERSION.tar ocaml-$VERSION
dynlink clambda_checks afl bigarray \
memprof domain skiplist codefrag)
-GENERATED_HEADERS := caml/opnames.h caml/version.h caml/jumptbl.h
+GENERATED_HEADERS := caml/opnames.h caml/version.h caml/jumptbl.h build_config.h
CONFIG_HEADERS := caml/m.h caml/s.h
ifeq "$(TOOLCHAIN)" "msvc"
NATIVE_STATIC_LIBRARIES += libasmrund.$(A)
endif
-ifeq "$(RUNTIMEI)" "true"
+ifeq "$(INSTRUMENTED_RUNTIME)" "true"
PROGRAMS += ocamlruni$(EXE)
BYTECODE_STATIC_LIBRARIES += libcamlruni.$(A)
NATIVE_STATIC_LIBRARIES += libasmruni.$(A)
libcamlrun_OBJECTS := $(BYTECODE_C_SOURCES:.c=.b.$(O))
+libcamlrun_non_shared_OBJECTS := \
+ $(subst $(UNIX_OR_WIN32).b.$(O),$(UNIX_OR_WIN32)_non_shared.b.$(O), \
+ $(libcamlrun_OBJECTS))
+
libcamlrund_OBJECTS := $(BYTECODE_C_SOURCES:.c=.bd.$(O)) \
instrtrace.bd.$(O)
# General (non target-specific) assembler and compiler flags
-ifdef BOOTSTRAPPING_FLEXLINK
-OC_CPPFLAGS += -DBOOTSTRAPPING_FLEXLINK
-endif
-
-# On Windows, OCAML_STDLIB_DIR needs to be defined dynamically
-
-ifeq "$(UNIX_OR_WIN32)" "win32"
-# OCAML_STDLIB_DIR needs to arrive in dynlink.c as a string which both gcc and
-# msvc are willing parse without warning. This means we can't pass UTF-8
-# directly since, as far as I can tell, cl can cope, but the pre-processor
-# can't. So the string needs to be directly translated to L"" form. To do this,
-# we take advantage of the fact that Cygwin uses GNU libiconv which includes a
-# Java pseudo-encoding which translates any UTF-8 sequences to \uXXXX (and,
-# unlike the C99 pseudo-encoding, emits two surrogate values when needed, rather
-# than \UXXXXXXXX). The \u is then translated to \x in order to accommodate
-# pre-Visual Studio 2013 compilers where \x is a non-standard alias for \u.
-OCAML_STDLIB_DIR = $(shell echo $(LIBDIR)| iconv -t JAVA | sed -e 's/\\u/\\x/g')
-STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='L"$(OCAML_STDLIB_DIR)"'
-else # Unix
-OCAML_STDLIB_DIR = $(LIBDIR)
-STDLIB_CPP_FLAG = -DOCAML_STDLIB_DIR='"$(OCAML_STDLIB_DIR)"'
-endif
-
-OC_CPPFLAGS += $(IFLEXDIR)
-
ifneq "$(CCOMPTYPE)" "msvc"
OC_CFLAGS += -g
endif
OC_NATIVE_CPPFLAGS += -DMODEL_$(MODEL)
endif
-OC_NATIVE_CPPFLAGS += -DSYS_$(SYSTEM) $(IFLEXDIR)
+OC_NATIVE_CPPFLAGS += -DSYS_$(SYSTEM)
OC_DEBUG_CPPFLAGS=-DDEBUG
OC_INSTR_CPPFLAGS=-DCAML_INSTR
# Commands used to build native libraries
+LIBS := $(BYTECCLIBS)
+
ifeq "$(UNIX_OR_WIN32)" "win32"
-LIBS = $(BYTECCLIBS) $(EXTRALIBS)
-ifdef BOOTSTRAPPING_FLEXLINK
-MAKE_OCAMLRUN=$(MKEXE_BOOT)
-else
-MAKE_OCAMLRUN = $(MKEXE) -o $(1) $(2)
-endif
-else
-LIBS = $(BYTECCLIBS)
-MAKE_OCAMLRUN = $(MKEXE) -o $(1) $(2)
+LIBS += $(EXTRALIBS)
endif
# Build, install and clean targets
.PHONY: all
-all: $(BYTECODE_STATIC_LIBRARIES) $(BYTECODE_SHARED_LIBRARIES) $(PROGRAMS)
+all: $(BYTECODE_STATIC_LIBRARIES) $(BYTECODE_SHARED_LIBRARIES) $(PROGRAMS) \
+ sak$(EXE)
.PHONY: allopt
ifneq "$(NATIVE_COMPILER)" "false"
.PHONY: clean
clean:
rm -f *.o *.obj *.a *.lib *.so *.dll ld.conf
- rm -f ocamlrun ocamlrund ocamlruni
- rm -f ocamlrun.exe ocamlrund.exe ocamlruni.exe
+ rm -f ocamlrun ocamlrund ocamlruni ocamlruns sak
+ rm -f ocamlrun.exe ocamlrund.exe ocamlruni.exe ocamlruns.exe sak.exe
rm -f primitives primitives.new prims.c $(GENERATED_HEADERS)
rm -f domain_state*.inc
rm -rf $(DEPDIR)
echo '#include "caml/prims.h"'; \
sed -e 's/.*/extern value &();/' primitives; \
echo 'c_primitive caml_builtin_cprim[] = {'; \
- sed -e 's/.*/ &,/' primitives; \
- echo ' 0 };'; \
+ sed -e 's/.*/ &,/' primitives; \
+ echo ' 0 };'; \
echo 'char * caml_names_of_builtin_cprim[] = {'; \
- sed -e 's/.*/ "&",/' primitives; \
- echo ' 0 };') > prims.c
+ sed -e 's/.*/ "&",/' primitives; \
+ echo ' 0 };') > prims.c
caml/opnames.h : caml/instruct.h
tr -d '\r' < $< | \
caml/version.h : $(ROOTDIR)/tools/make-version-header.sh $(ROOTDIR)/VERSION
$^ > $@
+# These are provided as a temporary shim to allow cross-compilation systems
+# to supply a host C compiler and different flags and a linking macro.
+SAK_CC ?= $(CC)
+SAK_CFLAGS ?= $(OC_CFLAGS) $(CFLAGS) $(OC_CPPFLAGS) $(CPPFLAGS)
+SAK_LINK ?= $(MKEXE_USING_COMPILER)
+
+sak$(EXE): sak.$(O)
+ $(call SAK_LINK,$@,$^)
+
+sak.$(O): sak.c caml/misc.h caml/config.h
+ $(SAK_CC) -c $(SAK_CFLAGS) $(OUTPUTOBJ)$@ $<
+
+C_LITERAL = $(shell ./sak$(EXE) encode-C-literal '$(1)')
+
+build_config.h: $(ROOTDIR)/Makefile.config sak$(EXE)
+ echo '/* This file is generated from $(ROOTDIR)/Makefile.config */' > $@
+ echo '#define OCAML_STDLIB_DIR $(call C_LITERAL,$(LIBDIR))' >> $@
+ echo '#define HOST "$(HOST)"' >> $@
+
# Libraries and programs
ocamlrun$(EXE): prims.$(O) libcamlrun.$(A)
- $(call MAKE_OCAMLRUN,$@,$^ $(LIBS))
+ $(MKEXE) -o $@ $^ $(LIBS)
+
+ocamlruns$(EXE): prims.$(O) libcamlrun_non_shared.$(A)
+ $(call MKEXE_USING_COMPILER,$@,$^ $(LIBS))
libcamlrun.$(A): $(libcamlrun_OBJECTS)
$(call MKLIB,$@, $^)
+libcamlrun_non_shared.$(A): $(libcamlrun_non_shared_OBJECTS)
+ $(call MKLIB,$@, $^)
+
ocamlrund$(EXE): prims.$(O) libcamlrund.$(A)
$(MKEXE) $(MKEXEDEBUGFLAG) -o $@ $^ $(LIBS)
$(call MKLIB,$@, $^)
ocamlruni$(EXE): prims.$(O) libcamlruni.$(A)
- $(MKEXE) -o $@ $^ $(LIBS)
+ $(MKEXE) -o $@ $^ $(INSTRUMENTED_RUNTIME_LIBS) $(LIBS)
libcamlruni.$(A): $(libcamlruni_OBJECTS)
$(call MKLIB,$@, $^)
$(DEPDIR)/$(1).$(D): %.c | $(DEPDIR) $(GENERATED_HEADERS)
$$(DEP_CC) $$(OC_CPPFLAGS) $$(CPPFLAGS) $$< -MT \
'$$*$(subst %,,$(1)).$(O)' -MF $$@
-endif
-$(1).$(O): %.c
+endif # ifneq "$(1)" "%"
+$(1).$(O): $(2).c
else
-$(1).$(O): %.c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
-endif
+$(1).$(O): $(2).c $(CONFIG_HEADERS) $(GENERATED_HEADERS) $(RUNTIME_HEADERS)
+endif # ifneq "$(COMPUTE_DEPS)" "false"
$$(CC) -c $$(OC_CFLAGS) $$(CFLAGS) $$(OC_CPPFLAGS) $$(CPPFLAGS) \
$$(OUTPUTOBJ)$$@ $$<
endef
endif
$(foreach object_type, $(object_types), \
- $(eval $(call COMPILE_C_FILE,$(object_type))))
+ $(eval $(call COMPILE_C_FILE,$(object_type),%)))
+
+$(UNIX_OR_WIN32)_non_shared.%.$(O): OC_CPPFLAGS += -DBUILDING_LIBCAMLRUNS
-dynlink.%.$(O): OC_CPPFLAGS += $(STDLIB_CPP_FLAG)
+$(eval $(call COMPILE_C_FILE,$(UNIX_OR_WIN32)_non_shared.%,$(UNIX_OR_WIN32)))
$(foreach object_type,$(subst %,,$(object_types)), \
$(eval dynlink$(object_type).$(O): $(ROOTDIR)/Makefile.config))
ifeq "$(COMPUTE_DEPS)" "true"
include $(addprefix $(DEPDIR)/, $(DEP_FILES))
endif
+
+# This empty target is here for AppVeyor to allow dependencies to be built
+# without doing anything else.
+.PHONY: setup-depend
+setup-depend:
#include "caml/mlvalues.h"
-CAMLprim value caml_setup_afl (value unit)
+CAMLprim value caml_reset_afl_instrumentation(value full)
{
return Val_unit;
}
-CAMLprim value caml_reset_afl_instrumentation(value unused)
+CAMLexport value caml_setup_afl(value unit)
{
+ /* AFL is not supported */
return Val_unit;
}
return msg;
}
-CAMLprim value caml_setup_afl(value unit)
+CAMLexport value caml_setup_afl(value unit)
{
char* shm_id_str;
char* shm_id_end;
/* Special registers */
-#define DOMAIN_STATE_PTR x25
+#define DOMAIN_STATE_PTR x28
#define TRAP_PTR x26
#define ALLOC_PTR x27
-#define ALLOC_LIMIT x28
#define ADDITIONAL_ARG x8
#define TMP x16
#define TMP2 x17
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE
-#define Caml_state(var) [x25, 8*domain_field_caml_##var]
+#define Caml_state(var) [DOMAIN_STATE_PTR, 8*domain_field_caml_##var]
/* Globals and labels */
#if defined(SYS_macosx)
ldp d26, d27, [sp, 352]
ldp d28, d29, [sp, 368]
ldp d30, d31, [sp, 384]
- /* Reload new allocation pointer and allocation limit */
+ /* Reload new allocation pointer */
ldr ALLOC_PTR, Caml_state(young_ptr)
- ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Free stack space and return to caller */
ldp x29, x30, [sp], 400
ret
FUNCTION(caml_alloc1)
CFI_STARTPROC
+ ldr TMP, Caml_state(young_limit)
sub ALLOC_PTR, ALLOC_PTR, #16
- cmp ALLOC_PTR, ALLOC_LIMIT
+ cmp ALLOC_PTR, TMP
b.lo L(caml_call_gc)
ret
CFI_ENDPROC
FUNCTION(caml_alloc2)
CFI_STARTPROC
+ ldr TMP, Caml_state(young_limit)
sub ALLOC_PTR, ALLOC_PTR, #24
- cmp ALLOC_PTR, ALLOC_LIMIT
+ cmp ALLOC_PTR, TMP
b.lo L(caml_call_gc)
ret
CFI_ENDPROC
FUNCTION(caml_alloc3)
CFI_STARTPROC
+ ldr TMP, Caml_state(young_limit)
sub ALLOC_PTR, ALLOC_PTR, #32
- cmp ALLOC_PTR, ALLOC_LIMIT
+ cmp ALLOC_PTR, TMP
b.lo L(caml_call_gc)
ret
CFI_ENDPROC
FUNCTION(caml_allocN)
CFI_STARTPROC
+ ldr TMP, Caml_state(young_limit)
sub ALLOC_PTR, ALLOC_PTR, ADDITIONAL_ARG
- cmp ALLOC_PTR, ALLOC_LIMIT
+ cmp ALLOC_PTR, TMP
b.lo L(caml_call_gc)
ret
CFI_ENDPROC
str TRAP_PTR, Caml_state(exception_pointer)
/* Call the function */
blr ADDITIONAL_ARG
- /* Reload alloc ptr and alloc limit */
+ /* Reload alloc ptr */
ldr ALLOC_PTR, Caml_state(young_ptr)
- ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Return */
ret x19
CFI_ENDPROC
stp x8, x9, [sp, -16]!
CFI_ADJUST(16)
add TRAP_PTR, sp, #0
- /* Reload allocation pointers */
+ /* Reload allocation pointer */
ldr ALLOC_PTR, Caml_state(young_ptr)
- ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Call the OCaml code */
blr TMP2
L(caml_retaddr):
mov DOMAIN_STATE_PTR, C_ARG_1
/* Load the exception bucket */
mov x0, C_ARG_2
- /* Reload trap ptr, alloc ptr and alloc limit */
+ /* Reload trap ptr and alloc ptr */
ldr TRAP_PTR, Caml_state(exception_pointer)
ldr ALLOC_PTR, Caml_state(young_ptr)
- ldr ALLOC_LIMIT, Caml_state(young_limit)
/* Test if backtrace is active */
ldr TMP, Caml_state(backtrace_active)
cbnz TMP, 2f
CFI_ENDPROC
END_FUNCTION(caml_raise_exception)
+/* Raise a Stack_overflow exception on return from segv_handler()
+ (in runtime/signals_nat.c). On entry, the stack is full, so we
+ cannot record a backtrace.
+ No CFI information here since this function disrupts the stack
+ backtrace anyway.
+ Since we have returned from the signal handler, the DOMAIN_STATE_PTR,
+ TRAP_PTR and ALLOC_PTR registers should have the same values
+ they had in the faulting OCaml code, so don't try to reload them. */
+
+FUNCTION(caml_stack_overflow)
+ /* Load the exception bucket */
+ ADDRGLOBAL(x0, caml_exn_Stack_overflow)
+ /* Cut stack at current trap handler */
+ mov sp, TRAP_PTR
+ /* Pop previous handler and jump to it */
+ ldr TMP, [sp, 8]
+ ldr TRAP_PTR, [sp], 16
+ br TMP
+ END_FUNCTION(caml_stack_overflow)
+
/* Callback from C to OCaml */
FUNCTION(caml_callback_asm)
return Field(array, idx);
}
-/* [ float array -> int -> float ] */
-CAMLprim value caml_array_get_float(value array, value index)
+/* [ floatarray -> int -> float ] */
+CAMLprim value caml_floatarray_get(value array, value index)
{
intnat idx = Long_val(index);
-#ifdef FLAT_FLOAT_ARRAY
double d;
value res;
+ CAMLassert (Tag_val(array) == Double_array_tag);
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
caml_array_bound_error();
d = Double_flat_field(array, idx);
#undef Restore_after_gc
Store_double_val(res, d);
return res;
-#else
- CAMLassert (Tag_val (array) != Double_array_tag);
- if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
- return Field(array, idx);
-#endif /* FLAT_FLOAT_ARRAY */
}
/* [ 'a array -> int -> 'a ] */
{
#ifdef FLAT_FLOAT_ARRAY
if (Tag_val(array) == Double_array_tag)
- return caml_array_get_float(array, index);
+ return caml_floatarray_get(array, index);
#else
CAMLassert (Tag_val(array) != Double_array_tag);
#endif
return caml_array_get_addr(array, index);
}
-/* [ floatarray -> int -> float ] */
-CAMLprim value caml_floatarray_get(value array, value index)
-{
- intnat idx = Long_val(index);
- double d;
- value res;
-
- CAMLassert (Tag_val(array) == Double_array_tag);
- if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
- caml_array_bound_error();
- d = Double_flat_field(array, idx);
-#define Setup_for_gc
-#define Restore_after_gc
- Alloc_small(res, Double_wosize, Double_tag);
-#undef Setup_for_gc
-#undef Restore_after_gc
- Store_double_val(res, d);
- return res;
-}
-
/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
CAMLprim value caml_array_set_addr(value array, value index, value newval)
{
return Val_unit;
}
-/* [ float array -> int -> float -> unit ] */
-CAMLprim value caml_array_set_float(value array, value index, value newval)
+/* [ floatarray -> int -> float -> unit ] */
+CAMLprim value caml_floatarray_set(value array, value index, value newval)
{
intnat idx = Long_val(index);
-#ifdef FLAT_FLOAT_ARRAY
double d = Double_val (newval);
+ CAMLassert (Tag_val(array) == Double_array_tag);
if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
caml_array_bound_error();
Store_double_flat_field(array, idx, d);
-#else
- CAMLassert (Tag_val (array) != Double_array_tag);
- if (idx < 0 || idx >= Wosize_val(array)) caml_array_bound_error();
- Modify(&Field(array, idx), newval);
-#endif
return Val_unit;
}
{
#ifdef FLAT_FLOAT_ARRAY
if (Tag_val(array) == Double_array_tag)
- return caml_array_set_float(array, index, newval);
+ return caml_floatarray_set(array, index, newval);
#else
CAMLassert (Tag_val(array) != Double_array_tag);
#endif
return caml_array_set_addr(array, index, newval);
}
-/* [ floatarray -> int -> float -> unit ] */
-CAMLprim value caml_floatarray_set(value array, value index, value newval)
+/* [ floatarray -> int -> float ] */
+CAMLprim value caml_floatarray_unsafe_get(value array, value index)
{
intnat idx = Long_val(index);
- double d = Double_val (newval);
- CAMLassert (Tag_val(array) == Double_array_tag);
- if (idx < 0 || idx >= Wosize_val(array) / Double_wosize)
- caml_array_bound_error();
- Store_double_flat_field(array, idx, d);
- return Val_unit;
-}
-
-/* [ float array -> int -> float ] */
-CAMLprim value caml_array_unsafe_get_float(value array, value index)
-{
- intnat idx = Long_val (index);
-#ifdef FLAT_FLOAT_ARRAY
double d;
value res;
+ CAMLassert (Tag_val(array) == Double_array_tag);
d = Double_flat_field(array, idx);
#define Setup_for_gc
#define Restore_after_gc
#undef Restore_after_gc
Store_double_val(res, d);
return res;
-#else /* FLAT_FLOAT_ARRAY */
- CAMLassert (Tag_val(array) != Double_array_tag);
- return Field(array, idx);
-#endif /* FLAT_FLOAT_ARRAY */
}
/* [ 'a array -> int -> 'a ] */
{
#ifdef FLAT_FLOAT_ARRAY
if (Tag_val(array) == Double_array_tag)
- return caml_array_unsafe_get_float(array, index);
+ return caml_floatarray_unsafe_get(array, index);
#else
CAMLassert (Tag_val(array) != Double_array_tag);
#endif
return Field(array, Long_val(index));
}
-/* [ floatarray -> int -> float ] */
-CAMLprim value caml_floatarray_unsafe_get(value array, value index)
-{
- intnat idx = Long_val(index);
- double d;
- value res;
-
- CAMLassert (Tag_val(array) == Double_array_tag);
- d = Double_flat_field(array, idx);
-#define Setup_for_gc
-#define Restore_after_gc
- Alloc_small(res, Double_wosize, Double_tag);
-#undef Setup_for_gc
-#undef Restore_after_gc
- Store_double_val(res, d);
- return res;
-}
-
/* [ 'a array -> int -> 'a -> unit ] where 'a != float */
-CAMLprim value caml_array_unsafe_set_addr(value array, value index,value newval)
+static value caml_array_unsafe_set_addr(value array, value index,value newval)
{
intnat idx = Long_val(index);
Modify(&Field(array, idx), newval);
return Val_unit;
}
-/* [ float array -> int -> float -> unit ] */
-CAMLprim value caml_array_unsafe_set_float(value array,value index,value newval)
+/* [ floatarray -> int -> float -> unit ] */
+CAMLprim value caml_floatarray_unsafe_set(value array, value index,value newval)
{
intnat idx = Long_val(index);
-#ifdef FLAT_FLOAT_ARRAY
double d = Double_val (newval);
Store_double_flat_field(array, idx, d);
-#else
- Modify(&Field(array, idx), newval);
-#endif
return Val_unit;
}
{
#ifdef FLAT_FLOAT_ARRAY
if (Tag_val(array) == Double_array_tag)
- return caml_array_unsafe_set_float(array, index, newval);
+ return caml_floatarray_unsafe_set(array, index, newval);
#else
CAMLassert (Tag_val(array) != Double_array_tag);
#endif
return caml_array_unsafe_set_addr(array, index, newval);
}
-/* [ floatarray -> int -> float -> unit ] */
-CAMLprim value caml_floatarray_unsafe_set(value array, value index,value newval)
-{
- intnat idx = Long_val(index);
- double d = Double_val (newval);
- Store_double_flat_field(array, idx, d);
- return Val_unit;
-}
-
/* [len] is a [value] representing number of floats. */
/* [ int -> floatarray ] */
CAMLprim value caml_floatarray_create(value len)
intnat count;
#ifdef FLAT_FLOAT_ARRAY
- if (Tag_val(a2) == Double_array_tag) {
- /* Arrays of floats. The values being copied are floats, not
- pointer, so we can do a direct copy. memmove takes care of
- potential overlap between the copied areas. */
- memmove((double *)a2 + Long_val(ofs2),
- (double *)a1 + Long_val(ofs1),
- Long_val(n) * sizeof(double));
- return Val_unit;
- }
+ if (Tag_val(a2) == Double_array_tag)
+ return caml_floatarray_blit(a1, ofs1, a2, ofs2, n);
#endif
CAMLassert (Tag_val(a2) != Double_array_tag);
if (Is_young(a2)) {
}
/* Start or stop the backtrace machinery */
-CAMLprim value caml_record_backtrace(value vflag)
+CAMLexport void caml_record_backtraces(int flag)
{
- int flag = Int_val(vflag);
-
if (flag != Caml_state->backtrace_active) {
Caml_state->backtrace_active = flag;
Caml_state->backtrace_pos = 0;
Caml_state->backtrace_buffer). So we don't have to allocate it here.
*/
}
+ return;
+}
+
+CAMLprim value caml_record_backtrace(value flag)
+{
+ caml_record_backtraces(Int_val(flag));
return Val_unit;
}
/* Processes a (Instruct.debug_event list array) into a form suitable
for quick lookup and registers it for the (code_start,code_size) pc range. */
-CAMLprim value caml_add_debug_info(code_t code_start, value code_size,
- value events_heap)
+value caml_add_debug_info(code_t code_start, value code_size, value events_heap)
{
CAMLparam1(events_heap);
struct debug_info *debug_info;
CAMLreturn(Val_unit);
}
-CAMLprim value caml_remove_debug_info(code_t start)
+value caml_remove_debug_info(code_t start)
{
CAMLparam0();
CAMLlocal2(dis, prev);
li->loc_endchr = ((info2 & 0xF) << 6) | (info1 >> 26);
}
-CAMLprim value caml_add_debug_info(backtrace_slot start, value size,
- value events)
+value caml_add_debug_info(backtrace_slot start, value size, value events)
{
return Val_unit;
}
-CAMLprim value caml_remove_debug_info(backtrace_slot start)
+value caml_remove_debug_info(backtrace_slot start)
{
return Val_unit;
}
#ifndef CAML_BACKTRACE_H
#define CAML_BACKTRACE_H
+#include "mlvalues.h"
+
+/* [caml_record_backtraces] controls backtrace recording.
+ * This function can be called at runtime by user-code, or during
+ * initialization if backtraces were requested.
+ *
+ * It might be called before GC initialization, so it shouldn't do OCaml
+ * allocation.
+ */
+CAMLextern void caml_record_backtraces(int);
+
#ifdef CAML_INTERNALS
-#include "mlvalues.h"
#include "exec.h"
/* Runtime support for backtrace generation.
* OCaml values of algebraic data-type [Printexc.backtrace_slot]
*/
/* [Caml_state->backtrace_active] is non zero iff backtraces are recorded.
- * This variable must be changed with [caml_record_backtrace].
+ * This variable must be changed with [caml_record_backtrace] in OCaml or
+ * [caml_record_backtraces] in C.
*/
#define caml_backtrace_active (Caml_state_field(backtrace_active))
/* The [Caml_state->backtrace_buffer] and [Caml_state->backtrace_last_exn]
runtimes for raise.
*/
-/* [caml_record_backtrace] toggle backtrace recording on and off.
- * This function can be called at runtime by user-code, or during
- * initialization if backtraces were requested.
- *
- * It might be called before GC initialization, so it shouldn't do OCaml
- * allocation.
- */
-CAMLextern value caml_record_backtrace(value vflag);
-
-
#ifndef NATIVE_CODE
/* Path to the file containing debug information, if any, or NULL. */
*/
void caml_compact_heap (intnat new_allocation_policy);
-void caml_compact_heap_maybe (void);
+void caml_compact_heap_maybe (double previous_overhead);
void caml_invert_root (value v, value *p);
#endif /* CAML_INTERNALS */
#define page_table caml_page_table
/* **** md5.c */
-#define md5_string caml_md5_string
-#define md5_chan caml_md5_chan
#define MD5Init caml_MD5Init
#define MD5Update caml_MD5Update
#define MD5Final caml_MD5Final
/* **** sys.c */
#define sys_error caml_sys_error
-#define sys_exit caml_sys_exit
/* **** terminfo.c */
#include "s.h"
-#ifdef BOOTSTRAPPING_FLEXLINK
-#undef SUPPORT_DYNAMIC_LINKING
-#endif
-
#ifndef CAML_NAME_SPACE
#include "compatibility.h"
#endif
/* Default speed setting for the major GC. The heap will grow until
the dead objects and the free list represent this percentage of the
total size of live objects. */
-#define Percent_free_def 80
+#define Percent_free_def 120
/* Default setting for the compacter: 500%
(i.e. trigger the compacter when 5/6 of the heap is free or garbage)
Documented in gc.mli */
#define Custom_minor_max_bsz_def 8192
+/* Default allocation policy. */
+#define Allocation_policy_def caml_policy_best_fit
+
#endif /* CAML_CONFIG_H */
/* */
/**************************************************************************/
-DOMAIN_STATE(value*, young_ptr)
DOMAIN_STATE(value*, young_limit)
+DOMAIN_STATE(value*, young_ptr)
/* Minor heap limit. See minor_gc.c. */
DOMAIN_STATE(char*, exception_pointer)
/* Unload all the previously loaded shared libraries */
extern void caml_free_shared_libs(void);
+/* Return the effective location of the standard library */
+extern char_os * caml_get_stdlib_location(void);
+
+/* Parse ld.conf and add the lines read to caml_shared_libs_path */
+extern char_os * caml_parse_ld_conf(void);
+
#endif /* CAML_INTERNALS */
#endif /* CAML_DYNLINK_H */
/* Magic number for this release */
-#define EXEC_MAGIC "Caml1999X029"
+#define EXEC_MAGIC "Caml1999X030"
#endif /* CAML_INTERNALS */
#include "mlvalues.h"
#ifdef CAML_INTERNALS
+/* Built-in exceptions. In bytecode, these exceptions are the first fields in
+ caml_global_data (which is loaded from the bytecode DATA section) - see
+ bytecomp/bytelink.ml. In native code, these exceptions are created if
+ needed in the startup object - see asmcomp/asmlink.ml and
+ Cmm_helpers.predef_exception. */
#define OUT_OF_MEMORY_EXN 0 /* "Out_of_memory" */
#define SYS_ERROR_EXN 1 /* "Sys_error" */
#define FAILURE_EXN 2 /* "Failure" */
void caml_final_oldify_young_roots (void);
void caml_final_empty_young (void);
void caml_final_update_minor_roots(void);
-value caml_final_register (value f, value v);
void caml_final_invariant_check(void);
#endif /* CAML_INTERNALS */
(value *p, mlsize_t size, int do_merge, int color)
{ (*caml_fl_p_make_free_blocks) (p, size, do_merge, color); }
-extern void caml_set_allocation_policy (intnat);
+enum {
+ caml_policy_next_fit = 0,
+ caml_policy_first_fit = 1,
+ caml_policy_best_fit = 2,
+};
+extern void caml_set_allocation_policy (uintnat);
+
extern void caml_fl_reset_and_switch_policy (intnat);
+/* -1 means do not change the allocation policy */
#ifdef DEBUG
Caml_inline void caml_fl_check (void)
window : cf. window_size in gc.mli
custom_maj: cf. custom_major_ratio in gc.mli
custom_min: cf. custom_minor_ratio in gc.mli
- custom_sz : cf. custom_minor_max_size in gc.mli
+ custom_bsz: cf. custom_minor_max_size in gc.mli
+ policy : cf. allocation_policy in gc.mli
*/
void caml_init_gc (uintnat minor_size, uintnat major_size, uintnat major_incr,
uintnat percent_fr, uintnat percent_m, uintnat window,
- uintnat custom_maj, uintnat custom_min, uintnat custom_bsz);
+ uintnat custom_maj, uintnat custom_min, uintnat custom_bsz,
+ uintnat policy);
-CAMLextern value caml_gc_stat(value v);
-
#ifdef DEBUG
void caml_heap_check (void);
#endif
char * max; /* Logical end of the buffer (for input) */
void * mutex; /* Placeholder for mutex (for systhreads) */
struct channel * next, * prev;/* Double chaining of channels (flush_all) */
- int revealed; /* For Cash only */
- int old_revealed; /* For Cash only */
- int refcount; /* For flush_all and for Cash */
+ int refcount; /* Number of custom blocks owning the channel */
int flags; /* Bitfield */
char buff[IO_BUFFER_SIZE]; /* The buffer itself */
char * name; /* Optional name (to report fd leaks) */
/* I/O on channels from C. The channel must be locked (see below) before
calling any of the functions and macros below */
-#define caml_putch(channel, ch) do{ \
- if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
- *((channel)->curr)++ = (ch); \
-}while(0)
-
-#define caml_getch(channel) \
- ((channel)->curr >= (channel)->max \
- ? caml_refill(channel) \
- : (unsigned char) *((channel)->curr)++)
-
CAMLextern value caml_alloc_channel(struct channel *chan);
CAMLextern int caml_channel_binary_mode (struct channel *);
CAMLextern int caml_flush_partial (struct channel *);
CAMLextern void caml_flush (struct channel *);
+CAMLextern void caml_putch(struct channel *, int);
CAMLextern void caml_putword (struct channel *, uint32_t);
CAMLextern int caml_putblock (struct channel *, char *, intnat);
CAMLextern void caml_really_putblock (struct channel *, char *, intnat);
CAMLextern unsigned char caml_refill (struct channel *);
+CAMLextern unsigned char caml_getch(struct channel *);
CAMLextern uint32_t caml_getword (struct channel *);
CAMLextern int caml_getblock (struct channel *, char *, intnat);
CAMLextern intnat caml_really_getblock (struct channel *, char *, intnat);
*/
void caml_finalise_heap (void);
+#ifdef NAKED_POINTERS_CHECKER
+extern int caml_naked_pointers_detected;
+#endif
+
#endif /* CAML_INTERNALiS */
#endif /* CAML_MAJOR_GC_H */
#include "mlvalues.h"
#include "io.h"
-CAMLextern value caml_md5_string (value str, value ofs, value len);
-CAMLextern value caml_md5_chan (value vchan, value len);
CAMLextern void caml_md5_block(unsigned char digest[16],
void * data, uintnat len);
#endif
CAMLextern value caml_alloc_shr (mlsize_t wosize, tag_t);
-#ifdef WITH_PROFINFO
+
+/* Variant of [caml_alloc_shr] with explicit profinfo.
+ Equivalent to caml_alloc_shr unless WITH_PROFINFO is true */
CAMLextern value caml_alloc_shr_with_profinfo (mlsize_t, tag_t, intnat);
-#else
-#define caml_alloc_shr_with_profinfo(size, tag, profinfo) \
- caml_alloc_shr(size, tag)
-#endif /* WITH_PROFINFO */
/* Variant of [caml_alloc_shr] where no memprof sampling is performed. */
CAMLextern value caml_alloc_shr_no_track_noexc (mlsize_t, tag_t);
#error "How do I align values on this platform?"
#endif
+/* Prefetching */
+
+#ifdef CAML_INTERNALS
+#if defined(__GNUC__) && (defined(__i386__) || defined(__x86_64__))
+#define caml_prefetch(p) __builtin_prefetch((p), 1, 3)
+/* 1 = intent to write; 3 = all cache levels */
+#else
+#define caml_prefetch(p)
+#endif
+#endif
+
/* CAMLunused is preserved for compatibility reasons.
Instead of the legacy GCC/Clang-only
CAMLunused foo;
#define mktemp_os _wmktemp
#define fopen_os _wfopen
+#define clock_os caml_win32_clock
+
#define caml_stat_strdup_os caml_stat_wcsdup
#define caml_stat_strconcat_os caml_stat_wcsconcat
#define mktemp_os mktemp
#define fopen_os fopen
+#define clock_os clock
+
#define caml_stat_strdup_os caml_stat_strdup
#define caml_stat_strconcat_os caml_stat_strconcat
#ifdef WITH_PROFINFO
#define PROFINFO_SHIFT (Gen_profinfo_shift(PROFINFO_WIDTH))
#define PROFINFO_MASK (Gen_profinfo_mask(PROFINFO_WIDTH))
+/* Use NO_PROFINFO to debug problems with profinfo macros */
+#define NO_PROFINFO 0xff
#define Hd_no_profinfo(hd) ((hd) & ~(PROFINFO_MASK << PROFINFO_SHIFT))
#define Wosize_hd(hd) ((mlsize_t) ((Hd_no_profinfo(hd)) >> 10))
#define Profinfo_hd(hd) (Gen_profinfo_hd(PROFINFO_WIDTH, hd))
#else
+#define NO_PROFINFO 0
#define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10))
+#define Profinfo_hd(hd) NO_PROFINFO
#endif /* WITH_PROFINFO */
#define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */
#define Num_tags (1 << 8)
#ifdef ARCH_SIXTYFOUR
+#ifdef WITH_PROFINFO
#define Max_wosize (((intnat)1 << (54-PROFINFO_WIDTH)) - 1)
#else
+#define Max_wosize (((intnat)1 << 54) - 1)
+#endif
+#else
#define Max_wosize ((1 << 22) - 1)
#endif /* ARCH_SIXTYFOUR */
#define CAML_OSDEPS_H
#ifdef _WIN32
+#include <time.h>
+
extern unsigned short caml_win32_major;
extern unsigned short caml_win32_minor;
extern unsigned short caml_win32_build;
char *out,
int outlen);
+CAMLextern int caml_win32_isatty(int fd);
+
+CAMLextern void caml_expand_command_line (int *, wchar_t ***);
+
+CAMLextern clock_t caml_win32_clock(void);
+
+#endif /* _WIN32 */
+
+#endif /* CAML_INTERNALS */
+
+#ifdef _WIN32
+
/* [caml_stat_strdup_to_utf16(s)] returns a NULL-terminated copy of [s],
re-encoded in UTF-16. The encoding of [s] is assumed to be UTF-8 if
[caml_windows_unicode_runtime_enabled] is non-zero **and** [s] is valid
*/
CAMLextern value caml_copy_string_of_utf16(const wchar_t *s);
-CAMLextern int caml_win32_isatty(int fd);
-
-CAMLextern void caml_expand_command_line (int *, wchar_t ***);
-
#endif /* _WIN32 */
-#endif /* CAML_INTERNALS */
-
#endif /* CAML_OSDEPS_H */
#undef HAS_C99_FLOAT_OPS
/* Define HAS_C99_FLOAT_OPS if <math.h> conforms to ISO C99.
- In particular, it should provide expm1(), log1p(), hypot(), copysign(). */
+ In particular, it should provide expm1(), log1p(), hypot(), fma(),
+ exp2(), log2(), cbrt(), acosh(), asinh(), atanh(), erf(), erfc(),
+ trunc(), round(), copysign(). */
#undef HAS_WORKING_FMA
/* Define HAS_WORKING_FMA if the fma function is correctly implemented. The
- newlib library (intentionally) just has return x * y + z. */
+ newlib library (intentionally) just has return x * y + z. This hatch is
+ also used for https://sourceforge.net/p/mingw-w64/bugs/848/ */
+
+#undef HAS_WORKING_ROUND
+
+/* Define HAS_WORKING_ROUND is the round function is correctly implemented. This
+ hatch exists primarily for https://sourceforge.net/p/mingw-w64/bugs/573/ */
#undef HAS_GETRUSAGE
/* Define HAS_SYMLINK if you have symlink() and readlink() and lstat(). */
+#undef HAS_REALPATH
+/* Define HAS_REALPATH if you have realpath(). */
+
#undef HAS_WAIT4
#undef HAS_WAITPID
value caml_process_pending_actions_with_root (value extra_root); // raises
value caml_process_pending_actions_with_root_exn (value extra_root);
int caml_set_signal_action(int signo, int action);
-CAMLextern void caml_setup_stack_overflow_detection(void);
+CAMLextern int caml_setup_stack_overflow_detection(void);
CAMLextern void (*caml_enter_blocking_section_hook)(void);
CAMLextern void (*caml_leave_blocking_section_hook)(void);
extern uintnat caml_init_custom_major_ratio;
extern uintnat caml_init_custom_minor_ratio;
extern uintnat caml_init_custom_minor_max_bsz;
+extern uintnat caml_init_policy;
extern uintnat caml_trace_level;
extern int caml_cleanup_on_exit;
CAMLextern void caml_sys_init (char_os * exe_name, char_os ** argv);
CAMLnoreturn_start
-CAMLextern value caml_sys_exit (value)
+CAMLextern void caml_do_exit (int)
CAMLnoreturn_end;
-CAMLextern value caml_sys_get_argv(value unit);
-
extern char_os * caml_exe_name;
#ifdef __cplusplus
We use the GC's color bits in the following way:
- - White words are headers of live blocks.
+ - White words are headers of live blocks except for 0, which is a
+ fragment.
- Blue words are headers of free blocks.
- Black words are headers of out-of-heap "blocks".
- Gray words are the encoding of pointers in inverted lists.
{
char *chunk, *adr;
- while (Chunk_size (compact_fl) - Chunk_alloc (compact_fl) <= Bhsize_wosize (3)
- && Chunk_size (Chunk_next (compact_fl))
- - Chunk_alloc (Chunk_next (compact_fl))
- <= Bhsize_wosize (3)){
+ while (Chunk_size(compact_fl) - Chunk_alloc(compact_fl) < Bhsize_wosize(1)){
compact_fl = Chunk_next (compact_fl);
+ CAMLassert (compact_fl != NULL);
}
chunk = compact_fl;
while (Chunk_size (chunk) - Chunk_alloc (chunk) < size){
CAMLassert (!Is_black_hd (h));
CAMLassert (!Is_gray_hd (h));
- if (Is_white_hd (h)){
+ if (h != 0 && Is_white_hd (h)){
word q;
tag_t t;
char *newadr;
chend = ch + Chunk_size (ch);
while ((char *) p < chend){
word q = *p;
- if (Color_hd (q) == Caml_white){
+ if (q != 0 && Is_white_hd (q)){
size_t sz = Bhsize_hd (q);
char *newadr = compact_allocate (sz);
memmove (newadr, p, sz);
p += Wsize_bsize (sz);
}else{
- CAMLassert (Color_hd (q) == Caml_blue);
+ CAMLassert (q == 0 || Is_blue_hd (q));
p += Whsize_hd (q);
}
}
}
}
-void caml_compact_heap_maybe (void)
+void caml_compact_heap_maybe (double previous_overhead)
{
- /* Estimated free+garbage words in the heap:
- FW = fl_size_at_phase_change + 3 * (caml_fl_cur_wsz
- - caml_fl_wsz_at_phase_change)
- FW = 3 * caml_fl_cur_wsz - 2 * caml_fl_wsz_at_phase_change
- Estimated live words: LW = Caml_state->stat_heap_wsz - FW
- Estimated free percentage: FP = 100 * FW / LW
- We compact the heap if FP > caml_percent_max
- */
- double fw, fp;
CAMLassert (caml_gc_phase == Phase_idle);
if (caml_percent_max >= 1000000) return;
if (Caml_state->stat_major_collections < 3) return;
return;
#endif
- fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change;
- if (fw < 0) fw = caml_fl_cur_wsz;
+ if (previous_overhead >= caml_percent_max){
+ double current_overhead;
- if (fw >= Caml_state->stat_heap_wsz){
- fp = 1000000.0;
- }else{
- fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
- if (fp > 1000000.0) fp = 1000000.0;
- }
- caml_gc_message (0x200, "FL size at phase change = %"
- ARCH_INTNAT_PRINTF_FORMAT "u words\n",
- (uintnat) caml_fl_wsz_at_phase_change);
- caml_gc_message (0x200, "FL current size = %"
- ARCH_INTNAT_PRINTF_FORMAT "u words\n",
- (uintnat) caml_fl_cur_wsz);
- caml_gc_message (0x200, "Estimated overhead = %"
- ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
- (uintnat) fp);
- if (fp >= caml_percent_max){
caml_gc_message (0x200, "Automatic compaction triggered.\n");
caml_empty_minor_heap (); /* minor heap must be empty for compaction */
caml_gc_message
caml_finish_major_cycle ();
++ Caml_state->stat_forced_major_collections;
- fw = caml_fl_cur_wsz;
- fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
- caml_gc_message (0x200, "Measured overhead: %"
+ /* Note: There is no floating garbage because we just did a complete
+ major cycle*/
+ current_overhead =
+ 100.0 * caml_fl_cur_wsz / (Caml_state->stat_heap_wsz - caml_fl_cur_wsz);
+ caml_gc_message (0x200, "Current overhead: %"
ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
- (uintnat) fp);
- if (fp >= caml_percent_max)
- caml_compact_heap (-1);
+ (uintnat) current_overhead);
+ if (current_overhead >= caml_percent_max)
+ caml_compact_heap (-1);
else
- caml_gc_message (0x200, "Automatic compaction aborted.\n");
-
+ caml_gc_message (0x200, "Automatic compaction aborted.\n");
}
}
#include <netdb.h>
#else
#define ATOM ATOM_WS
-#include <winsock.h>
+#include <winsock2.h>
#undef ATOM
#include <process.h>
#endif
static void open_connection(void)
{
#ifdef _WIN32
- /* Set socket to synchronous mode so that file descriptor-oriented
- functions (read()/write() etc.) can be used */
-
- int oldvalue, oldvaluelen, newvalue, retcode;
- oldvaluelen = sizeof(oldvalue);
- retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *) &oldvalue, &oldvaluelen);
- if (retcode == 0) {
- newvalue = SO_SYNCHRONOUS_NONALERT;
- setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *) &newvalue, sizeof(newvalue));
- }
-#endif
+ /* Set socket to synchronous mode (= non-overlapped) so that file
+ descriptor-oriented functions (read()/write() etc.) can be
+ used */
+ SOCKET sock = WSASocket(sock_domain, SOCK_STREAM, 0,
+ NULL, 0,
+ 0 /* not WSA_FLAG_OVERLAPPED */);
+ if (sock == INVALID_SOCKET
+ || connect(sock, &sock_addr.s_gen, sock_addr_len) != 0)
+ caml_fatal_error("cannot connect to debugger at %s\n"
+ "WSA error code: %d",
+ (dbg_addr ? dbg_addr : "(none)"),
+ WSAGetLastError());
+ dbg_socket = _open_osfhandle(sock, 0);
+ if (dbg_socket == -1)
+#else
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
-#ifdef _WIN32
- if (retcode == 0) {
- /* Restore initial mode */
- setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
- (char *) &oldvalue, oldvaluelen);
- }
-#endif
if (dbg_socket == -1 ||
- connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1){
- caml_fatal_error
- (
- "cannot connect to debugger at %s\n"
- "error: %s",
- (dbg_addr ? dbg_addr : "(none)"),
- strerror (errno)
- );
- }
-#ifdef _WIN32
- dbg_socket = _open_osfhandle(dbg_socket, 0);
- if (dbg_socket == -1)
- caml_fatal_error("_open_osfhandle failed");
+ connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1)
#endif
+ caml_fatal_error("cannot connect to debugger at %s\n"
+ "error: %s",
+ (dbg_addr ? dbg_addr : "(none)"),
+ strerror (errno));
dbg_in = caml_open_descriptor_in(dbg_socket);
dbg_out = caml_open_descriptor_out(dbg_socket);
/* The code in this file does not bracket channel I/O operations with
(wrapped false)
(modules runtime)
(flags (-nostdlib -nopervasives))
+ (library_flags -cclib "-I runtime")
(self_build_stubs_archive (runtime)))
(rule
#include "caml/prims.h"
#include "caml/signals.h"
+#include "build_config.h"
+
#ifndef NATIVE_CODE
/* The table of primitives */
return NULL;
}
-/* Parse the OCAML_STDLIB_DIR/ld.conf file and add the directories
+/* Parse the ld.conf file and add the directories
listed there to the search path */
#define LD_CONF_NAME T("ld.conf")
-static char_os * parse_ld_conf(void)
+CAMLexport char_os * caml_get_stdlib_location(void)
+{
+ char_os * stdlib;
+ stdlib = caml_secure_getenv(T("OCAMLLIB"));
+ if (stdlib == NULL) stdlib = caml_secure_getenv(T("CAMLLIB"));
+ if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
+ return stdlib;
+}
+
+CAMLexport char_os * caml_parse_ld_conf(void)
{
char_os * stdlib, * ldconfname, * wconfig, * p, * q;
char * config;
#endif
int ldconf, nread;
- stdlib = caml_secure_getenv(T("OCAMLLIB"));
- if (stdlib == NULL) stdlib = caml_secure_getenv(T("CAMLLIB"));
- if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
+ stdlib = caml_get_stdlib_location();
ldconfname = caml_stat_strconcat_os(3, stdlib, T("/"), LD_CONF_NAME);
if (stat_os(ldconfname, &st) == -1) {
caml_stat_free(ldconfname);
if (lib_path != NULL)
for (p = lib_path; *p != 0; p += strlen_os(p) + 1)
caml_ext_table_add(&caml_shared_libs_path, p);
- tofree2 = parse_ld_conf();
+ tofree2 = caml_parse_ld_conf();
/* Open the shared libraries */
caml_ext_table_init(&shared_libs, 8);
if (libs != NULL)
#elif defined(HAS_MACH_ABSOLUTE_TIME)
static mach_timebase_info_data_t time_base = {0};
+ uint64_t now;
if (time_base.denom == 0) {
if (mach_timebase_info (&time_base) != KERN_SUCCESS)
return 0;
}
- uint64_t now = mach_absolute_time ();
+ now = mach_absolute_time ();
return (int64_t)((now * time_base.numer) / time_base.denom);
#elif defined(HAS_POSIX_MONOTONIC_CLOCK)
#endif
#endif
+#ifndef M_LOG2E
+#define M_LOG2E 1.44269504088896340735992468100 /* log_2 (e) */
+#endif
+
#ifdef ARCH_ALIGN_DOUBLE
CAMLexport double caml_Double_val(value val)
return caml_copy_double(exp(Double_val(f)));
}
+CAMLexport double caml_exp2(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return exp2(x);
+#else
+ return pow(2, x);
+#endif
+}
+
+CAMLprim value caml_exp2_float(value f)
+{
+ return caml_copy_double(caml_exp2(Double_val(f)));
+}
+
CAMLexport double caml_trunc(double x)
{
#ifdef HAS_C99_FLOAT_OPS
CAMLexport double caml_round(double f)
{
-#ifdef HAS_C99_FLOAT_OPS
+#ifdef HAS_WORKING_ROUND
return round(f);
#else
union { uint64_t i; double d; } u, pred_one_half; /* predecessor of 0.5 */
CAMLprim value caml_frexp_float(value f)
{
- CAMLparam1 (f);
- CAMLlocal2 (res, mantissa);
+ CAMLparam0 ();
+ CAMLlocal1 (mantissa);
+ value res;
int exponent;
mantissa = caml_copy_double(frexp (Double_val(f), &exponent));
- res = caml_alloc_tuple(2);
+ res = caml_alloc_small(2, 0);
Field(res, 0) = mantissa;
Field(res, 1) = Val_int(exponent);
CAMLreturn (res);
return caml_copy_double(log10(Double_val(f)));
}
+CAMLexport double caml_log2(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return log2(x);
+#else
+ return log(x) * M_LOG2E;
+#endif
+}
+
+CAMLprim value caml_log2_float(value f)
+{
+ return caml_copy_double(caml_log2(Double_val(f)));
+}
+
CAMLprim value caml_modf_float(value f)
{
+ CAMLparam0 ();
+ CAMLlocal2 (quo, rem);
+ value res;
double frem;
- CAMLparam1 (f);
- CAMLlocal3 (res, quo, rem);
-
quo = caml_copy_double(modf (Double_val(f), &frem));
rem = caml_copy_double(frem);
- res = caml_alloc_tuple(2);
+ res = caml_alloc_small(2, 0);
Field(res, 0) = quo;
Field(res, 1) = rem;
CAMLreturn (res);
return caml_copy_double(sqrt(Double_val(f)));
}
+CAMLexport double caml_cbrt(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return cbrt(x);
+#else
+ static const double third = 1.0 / 3.0;
+ double res = exp(third * log(fabs(x)));
+ return (x >= 0) ? res : -res;
+#endif
+}
+
+CAMLprim value caml_cbrt_float(value f)
+{
+ return caml_copy_double(caml_cbrt(Double_val(f)));
+}
+
CAMLprim value caml_power_float(value f, value g)
{
return caml_copy_double(pow(Double_val(f), Double_val(g)));
return caml_copy_double(asin(Double_val(f)));
}
+CAMLexport double caml_asinh(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return asinh(x);
+#else
+ return log(x + sqrt(x * x + 1.0));
+#endif
+}
+
+CAMLprim value caml_asinh_float(value f)
+{
+ return caml_copy_double(caml_asinh(Double_val(f)));
+}
+
CAMLprim value caml_acos_float(value f)
{
return caml_copy_double(acos(Double_val(f)));
}
+CAMLexport double caml_acosh(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return acosh(x);
+#else
+ return log(x + sqrt(x * x - 1.0));
+#endif
+}
+
+CAMLprim value caml_acosh_float(value f)
+{
+ return caml_copy_double(caml_acosh(Double_val(f)));
+}
+
CAMLprim value caml_atan_float(value f)
{
return caml_copy_double(atan(Double_val(f)));
}
+CAMLexport double caml_atanh(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return atanh(x);
+#else
+ return 0.5 * log((1.0 + x) / (1.0 - x));
+#endif
+}
+
+CAMLprim value caml_atanh_float(value f)
+{
+ return caml_copy_double(caml_atanh(Double_val(f)));
+}
+
CAMLprim value caml_atan2_float(value f, value g)
{
return caml_copy_double(atan2(Double_val(f), Double_val(g)));
return caml_copy_double(caml_log1p(Double_val(f)));
}
+#ifndef HAS_C99_FLOAT_OPS
+Caml_inline double simple_erf(double x)
+{
+ /* This algorithm for calculating the error function is based on formula
+ 7.1.26 from the "Handbook of Mathematical Functions" by Abramowitz
+ and Stegun. The implementation using Horner's method for evaluating the
+ polynomial approximation is derived from Python code by John D. Cook. */
+ double a1 = 0.254829592, a2 = -0.284496736, a3 = 1.421413741,
+ a4 = -1.453152027, a5 = 1.061405429, p = 0.3275911,
+ t, y;
+
+ int sign = (x >= 0) ? 1 : -1;
+ x = fabs(x);
+ t = 1.0 / (1.0 + p * x);
+ y = 1.0 - (((((a5 *t + a4) * t) + a3) * t + a2) * t + a1) * t * exp(-x * x);
+ return sign * y;
+}
+#endif
+
+CAMLexport double caml_erf(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return erf(x);
+#else
+ return simple_erf(x);
+#endif
+}
+
+CAMLprim value caml_erf_float(value f)
+{
+ return caml_copy_double(caml_erf(Double_val(f)));
+}
+
+CAMLexport double caml_erfc(double x)
+{
+#ifdef HAS_C99_FLOAT_OPS
+ return erfc(x);
+#else
+ return 1.0 - simple_erf(x);
+#endif
+}
+
+CAMLprim value caml_erfc_float(value f)
+{
+ return caml_copy_double(caml_erfc(Double_val(f)));
+}
+
union double_as_two_int32 {
double d;
#if defined(ARCH_BIG_ENDIAN) || (defined(__arm__) && !defined(__ARM_EABI__))
}
caml_fl_cur_wsz += Whsize_val (cur);
next:
+ caml_prefetch(Hp_val(cur + 4096));
cur = Next_in_mem (cur);
if (Hp_val (cur) >= (header_t *) limit){
CAMLassert (Hp_val (cur) == (header_t *) limit);
}
}
-/*********************** policy selection *****************************/
-
-enum {
- policy_next_fit = 0,
- policy_first_fit = 1,
- policy_best_fit = 2,
-};
-
-uintnat caml_allocation_policy = policy_next_fit;
-
/********************* exported functions *****************************/
/* [caml_fl_allocate] does not set the header of the newly allocated block.
[caml_fl_allocate] returns a head pointer, or NULL if no suitable block
is found in the free set.
*/
-header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = &nf_allocate;
+header_t *(*caml_fl_p_allocate) (mlsize_t wo_sz) = NULL;
/* Initialize the merge_block machinery (at start of sweeping). */
-void (*caml_fl_p_init_merge) (void) = &nf_init_merge;
+void (*caml_fl_p_init_merge) (void) = NULL;
/* These are called internally. */
-static void (*caml_fl_p_init) (void) = &nf_init;
-static void (*caml_fl_p_reset) (void) = &nf_reset;
+static void (*caml_fl_p_init) (void) = NULL;
+static void (*caml_fl_p_reset) (void) = NULL;
/* [caml_fl_merge_block] returns the head pointer of the next block after [bp],
because merging blocks may change the size of [bp]. */
-header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = &nf_merge_block;
+header_t *(*caml_fl_p_merge_block) (value bp, char *limit) = NULL;
/* [bp] must point to a list of blocks of wosize >= 1 chained by their field 0,
terminated by Val_NULL, and field 1 of the first block must point to
the last block.
The blocks must be blue.
*/
-void (*caml_fl_p_add_blocks) (value bp) = &nf_add_blocks;
+void (*caml_fl_p_add_blocks) (value bp) = NULL;
/* Cut a block of memory into pieces of size [Max_wosize], give them headers,
and optionally merge them into the free list.
*/
void (*caml_fl_p_make_free_blocks)
(value *p, mlsize_t size, int do_merge, int color)
- = &nf_make_free_blocks;
+ = NULL;
+
#ifdef DEBUG
-void (*caml_fl_p_check) (void) = &nf_check;
+void (*caml_fl_p_check) (void) = NULL;
#endif
-void caml_set_allocation_policy (intnat p)
+/* This variable and the above function pointers must be initialized with
+ a call to [caml_set_allocation_policy]. */
+uintnat caml_allocation_policy = 999;
+
+void caml_set_allocation_policy (uintnat p)
{
switch (p){
- case policy_next_fit: default:
- caml_allocation_policy = policy_next_fit;
+ case caml_policy_next_fit:
+ caml_allocation_policy = p;
caml_fl_p_allocate = &nf_allocate;
caml_fl_p_init_merge = &nf_init_merge;
caml_fl_p_reset = &nf_reset;
caml_fl_p_check = &nf_check;
#endif
break;
- case policy_first_fit:
- caml_allocation_policy = policy_first_fit;
+
+ case caml_policy_first_fit:
+ caml_allocation_policy = p;
caml_fl_p_allocate = &ff_allocate;
caml_fl_p_init_merge = &ff_init_merge;
caml_fl_p_reset = &ff_reset;
caml_fl_p_check = &ff_check;
#endif
break;
- case policy_best_fit:
- caml_allocation_policy = policy_best_fit;
+
+ default:
+ case caml_policy_best_fit:
+ caml_allocation_policy = caml_policy_best_fit;
caml_fl_p_allocate = &bf_allocate;
caml_fl_p_init_merge = &bf_init_merge;
caml_fl_p_reset = &bf_reset;
++ fragments;
CAMLassert (prev_hp == NULL
|| Color_hp (prev_hp) != Caml_blue
- || cur_hp == (header_t *) caml_gc_sweep_hp);
+ || cur_hp == (header_t *) caml_gc_sweep_hp
+ || Wosize_hp (prev_hp) == Max_wosize);
}else{
if (caml_gc_phase == Phase_sweep
&& cur_hp >= (header_t *) caml_gc_sweep_hp){
uintnat major_incr, uintnat percent_fr,
uintnat percent_m, uintnat window,
uintnat custom_maj, uintnat custom_min,
- uintnat custom_bsz)
+ uintnat custom_bsz, uintnat policy)
{
uintnat major_bsize;
if (major_size < Heap_chunk_min) major_size = Heap_chunk_min;
caml_major_heap_increment = major_incr;
caml_percent_free = norm_pfree (percent_fr);
caml_percent_max = norm_pmax (percent_m);
+ caml_set_allocation_policy (policy);
caml_init_major_heap (major_bsize);
caml_major_window = norm_window (window);
caml_custom_major_ratio = norm_custom_maj (custom_maj);
channel->curr = channel->max = channel->buff;
channel->end = channel->buff + IO_BUFFER_SIZE;
channel->mutex = NULL;
- channel->revealed = 0;
- channel->old_revealed = 0;
channel->refcount = 0;
channel->flags = descriptor_is_in_binary_mode(fd) ? 0 : CHANNEL_TEXT_MODE;
channel->next = caml_all_opened_channels;
CAMLexport void caml_close_channel(struct channel *channel)
{
close(channel->fd);
- if (channel->refcount > 0) return;
if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(channel);
unlink_channel(channel);
caml_stat_free(channel->name);
/* Output data */
+#define Putch(channel, ch) do{ \
+ if ((channel)->curr >= (channel)->end) caml_flush_partial(channel); \
+ *((channel)->curr)++ = (ch); \
+}while(0)
+
+CAMLexport void caml_putch(struct channel *channel, int ch)
+{
+ Putch(channel, ch);
+}
+
CAMLexport void caml_putword(struct channel *channel, uint32_t w)
{
if (! caml_channel_binary_mode(channel))
return (unsigned char)(channel->buff[0]);
}
+#define Getch(channel) \
+ ((channel)->curr >= (channel)->max \
+ ? caml_refill(channel) \
+ : (unsigned char) *((channel)->curr)++)
+
+CAMLexport unsigned char caml_getch(struct channel *channel)
+{
+ return Getch(channel);
+}
+
CAMLexport uint32_t caml_getword(struct channel *channel)
{
int i;
caml_failwith("input_binary_int: not a binary channel");
res = 0;
for(i = 0; i < 4; i++) {
- res = (res << 8) + caml_getch(channel);
+ res = (res << 8) + Getch(channel);
}
return res;
}
CAMLexport value caml_alloc_channel(struct channel *chan)
{
value res;
- chan->refcount++; /* prevent finalization during next alloc */
+ chan->refcount++;
res = caml_alloc_custom_mem(&channel_operations, sizeof(struct channel *),
sizeof(struct channel));
Channel(res) = chan;
return Val_unit;
}
-#define Pair_tag 0
-
CAMLprim value caml_ml_out_channels_list (value unit)
{
CAMLparam0 ();
for (channel = caml_all_opened_channels;
channel != NULL;
channel = channel->next)
- /* Testing channel->fd >= 0 looks unnecessary, as
+ /* Include only output channels opened from OCaml and not closed yet.
+ Testing channel->fd >= 0 looks unnecessary, as
caml_ml_close_channel changes max when setting fd to -1. */
- if (channel->max == NULL) {
+ if (channel->max == NULL
+ && channel->flags & CHANNEL_FLAG_MANAGED_BY_GC) {
chan = caml_alloc_channel (channel);
tail = res;
- res = caml_alloc_small (2, Pair_tag);
+ res = caml_alloc_small (2, Tag_cons);
Field (res, 0) = chan;
Field (res, 1) = tail;
}
CAMLprim value caml_ml_close_channel(value vchannel)
{
int result;
- int do_syscall;
int fd;
/* For output channels, must have flushed before */
struct channel * channel = Channel(vchannel);
- if (channel->fd != -1){
- fd = channel->fd;
- channel->fd = -1;
- do_syscall = 1;
- }else{
- do_syscall = 0;
- result = 0;
- }
+
/* Ensure that every read or write on the channel will cause an
immediate caml_flush_partial or caml_refill, thus raising a Sys_error
exception */
channel->curr = channel->max = channel->end;
- if (do_syscall) {
- caml_enter_blocking_section_no_pending();
- result = close(fd);
- caml_leave_blocking_section();
- }
+ /* If already closed, we are done */
+ if (channel->fd == -1) return Val_unit;
+
+ fd = channel->fd;
+ channel->fd = -1;
+ caml_enter_blocking_section_no_pending();
+ result = close(fd);
+ caml_leave_blocking_section();
if (result == -1) caml_sys_error (NO_ARG);
return Val_unit;
struct channel * channel = Channel(vchannel);
Lock(channel);
- caml_putch(channel, Long_val(ch));
+ Putch(channel, Long_val(ch));
Unlock(channel);
CAMLreturn (Val_unit);
}
unsigned char c;
Lock(channel);
- c = caml_getch(channel);
+ c = Getch(channel);
Unlock(channel);
CAMLreturn (Val_long(c));
}
#endif
caml_main(argv);
- caml_sys_exit(Val_int(0));
+ caml_do_exit(0);
return 0; /* not reached */
}
};
uintnat caml_percent_free;
+static uintnat marked_words, heap_wsz_at_cycle_start;
uintnat caml_major_heap_increment;
CAMLexport char *caml_heap_start;
char *caml_gc_sweep_hp;
redarkening required */
static char *redarken_first_chunk = NULL;
-static char *sweep_chunk, *sweep_limit;
+static char *sweep_chunk;
static double p_backlog = 0.0; /* backlog for the gc speedup parameter */
int caml_gc_subphase; /* Subphase_{mark_roots,mark_main,mark_final} */
static unsigned long major_gc_counter = 0;
#endif
+#ifdef NAKED_POINTERS_CHECKER
+int caml_naked_pointers_detected = 0;
+#endif
+
void (*caml_major_gc_hook)(void) = NULL;
/* This function prunes the mark stack if it's about to overflow. It does so
if (Is_white_hd (h)){
ephe_list_pure = 0;
Hd_val (v) = Blackhd_hd (h);
+ marked_words += Whsize_hd (h);
if (t < No_scan_tag){
mark_stack_push(Caml_state->mark_stack, v, 0, NULL);
}
caml_gc_message (0x08, "Shrinking mark stack to %"
ARCH_INTNAT_PRINTF_FORMAT "uk bytes\n",
- init_stack_bsize);
+ init_stack_bsize / 1024);
shrunk_stack = (mark_entry*) caml_stat_resize_noexc ((char*) stk->stack,
init_stack_bsize);
CAMLassert (Caml_state->mark_stack->count == 0);
CAMLassert (redarken_first_chunk == NULL);
caml_gc_message (0x01, "Starting new major GC cycle\n");
+ marked_words = 0;
caml_darken_all_roots_start ();
caml_gc_phase = Phase_mark;
+ heap_wsz_at_cycle_start = Caml_state->stat_heap_wsz;
caml_gc_subphase = Subphase_mark_roots;
ephe_list_pure = 1;
ephes_checked_if_pure = &caml_ephe_list_head;
caml_gc_phase = Phase_sweep;
sweep_chunk = caml_heap_start;
caml_gc_sweep_hp = sweep_chunk;
- sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
caml_fl_wsz_at_phase_change = caml_fl_cur_wsz;
if (caml_major_gc_hook) (*caml_major_gc_hook)();
}
caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work);
caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase);
+ marked_words += work;
while (1){
int can_mark = 0;
}
} else if (caml_gc_subphase == Subphase_mark_roots) {
CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
+ marked_words -= work;
work = caml_darken_all_roots_slice (work);
+ marked_words += work;
CAML_EV_END(EV_MAJOR_MARK_ROOTS);
if (work > 0){
caml_gc_subphase = Subphase_mark_main;
/* Initialise the sweep phase. */
init_sweep_phase();
}
+ marked_words -= work;
work = 0;
CAML_EV_END(EV_MAJOR_MARK_FINAL);
}
}
}
}
+ marked_words -= work; /* work may be negative */
CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_FIELDS, slice_fields);
CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_POINTERS, slice_pointers);
}
static void sweep_slice (intnat work)
{
- char *hp;
+ char *hp, *sweep_hp, *limit;
header_t hd;
caml_gc_message (0x40, "Sweeping %"
ARCH_INTNAT_PRINTF_FORMAT "d words\n", work);
+ sweep_hp = caml_gc_sweep_hp;
+ limit = sweep_chunk + Chunk_size(sweep_chunk);
while (work > 0){
- if (caml_gc_sweep_hp < sweep_limit){
- hp = caml_gc_sweep_hp;
+ if (sweep_hp < limit){
+ caml_prefetch(sweep_hp + 4000);
+ hp = sweep_hp;
hd = Hd_hp (hp);
work -= Whsize_hd (hd);
- caml_gc_sweep_hp += Bhsize_hd (hd);
+ sweep_hp += Bhsize_hd (hd);
switch (Color_hd (hd)){
case Caml_white:
- caml_gc_sweep_hp =
- (char *)caml_fl_merge_block(Val_hp (hp), sweep_limit);
+ caml_gc_sweep_hp = sweep_hp;
+ sweep_hp = (char *) caml_fl_merge_block (Val_hp (hp), limit);
break;
case Caml_blue:
/* Only the blocks of the free-list are blue. See [freelist.c]. */
Hd_hp (hp) = Whitehd_hd (hd);
break;
}
- CAMLassert (caml_gc_sweep_hp <= sweep_limit);
+ CAMLassert (sweep_hp <= limit);
}else{
sweep_chunk = Chunk_next (sweep_chunk);
if (sweep_chunk == NULL){
/* Sweeping is done. */
+ caml_gc_sweep_hp = sweep_hp;
++ Caml_state->stat_major_collections;
work = 0;
caml_gc_phase = Phase_idle;
caml_request_minor_gc ();
}else{
- caml_gc_sweep_hp = sweep_chunk;
- sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
+ sweep_hp = sweep_chunk;
+ limit = sweep_chunk + Chunk_size (sweep_chunk);
}
}
}
+ caml_gc_sweep_hp = sweep_hp;
}
/* The main entry point for the major GC. Called about once for each
}
if (caml_gc_phase == Phase_idle){
+ double previous_overhead; // overhead at the end of the previous cycle
+
CAML_EV_BEGIN(EV_MAJOR_CHECK_AND_COMPACT);
- caml_compact_heap_maybe ();
+ caml_gc_message (0x200, "marked words = %"
+ ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+ marked_words);
+ caml_gc_message (0x200, "heap size at start of cycle = %"
+ ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+ heap_wsz_at_cycle_start);
+ if (marked_words == 0){
+ previous_overhead = 1000000.;
+ caml_gc_message (0x200, "overhead at start of cycle = +inf\n");
+ }else{
+ previous_overhead =
+ 100.0 * (heap_wsz_at_cycle_start - marked_words) / marked_words;
+ caml_gc_message (0x200, "overhead at start of cycle = %.0f%%\n",
+ previous_overhead);
+ }
+ caml_compact_heap_maybe (previous_overhead);
CAML_EV_END(EV_MAJOR_CHECK_AND_COMPACT);
}
caml_gc_phase = Phase_sweep;
sweep_chunk = caml_heap_start;
caml_gc_sweep_hp = sweep_chunk;
- sweep_limit = sweep_chunk + Chunk_size (sweep_chunk);
while (caml_gc_phase == Phase_sweep)
sweep_slice (LONG_MAX);
}
#if defined(NAKED_POINTERS_CHECKER) && defined(NATIVE_CODE)
-#ifdef _WIN32
+#if defined(_WIN32)
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
return 1;
}
-#else
+#elif defined(TARGET_amd64)
Caml_inline int safe_load (header_t * addr, /*out*/ header_t * contents)
{
return ok;
}
+#elif defined(TARGET_arm64)
+
+Caml_inline int safe_load (header_t * addr, /*out*/ header_t * contents)
+{
+ int ok;
+ header_t h;
+ intnat tmp;
+
+ asm volatile(
+ "adr %[tmp], 1f \n\t"
+ "str %[tmp], [%[handler]] \n\t"
+ "mov %w[ok], #0 \n\t"
+ "ldr %[h], [%[addr]] \n\t"
+ "mov %w[ok], #1 \n\t"
+ "1: \n\t"
+ "mov %[tmp], #0 \n\t"
+ "str %[tmp], [%[handler]]"
+ : [tmp] "=&r" (tmp), [ok] "=&r" (ok), [h] "=&r" (h)
+ : [addr] "r" (addr),
+ [handler] "r" (&(Caml_state->checking_pointer_pc)));
+ *contents = h;
+ return ok;
+}
+
+#else
+#error "NAKED_POINTERS_CHECKER not supported on this platform"
#endif
static void is_naked_pointer_safe (value v, value *p)
if (Is_black_hd(h) && Wosize_hd(h) < (INT64_LITERAL(1) << 40))
return;
+ caml_naked_pointers_detected = 1;
if (!Is_black_hd(h)) {
fprintf (stderr, "Out-of-heap pointer at %p of value %p has "
"non-black head (tag=%d)\n", p, (void*)v, t);
return;
on_segfault:
+ caml_naked_pointers_detected = 1;
fprintf (stderr, "Out-of-heap pointer at %p of value %p. "
"Cannot read head.\n", p, (void*)v);
}
}
Caml_inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag, int track,
- int raise_oom, uintnat profinfo)
+ uintnat profinfo)
{
header_t *hp;
value *new_block;
- if (wosize > Max_wosize) {
- if (raise_oom)
- caml_raise_out_of_memory ();
- else
- return 0;
- }
+ if (wosize > Max_wosize) return 0;
CAML_EV_ALLOC(wosize);
hp = caml_fl_allocate (wosize);
if (hp == NULL){
new_block = expand_heap (wosize);
- if (new_block == NULL) {
- if (!raise_oom)
- return 0;
- else if (Caml_state->in_minor_collection)
- caml_fatal_error ("out of memory");
- else
- caml_raise_out_of_memory ();
- }
+ if (new_block == NULL) return 0;
caml_fl_add_blocks ((value) new_block);
hp = caml_fl_allocate (wosize);
}
return Val_hp (hp);
}
-#ifdef WITH_PROFINFO
-
-/* Use this to debug problems with macros... */
-#define NO_PROFINFO 0xff
-
-CAMLexport value caml_alloc_shr_with_profinfo (mlsize_t wosize, tag_t tag,
- intnat profinfo)
+Caml_inline value check_oom(value v)
{
- return caml_alloc_shr_aux(wosize, tag, 1, 1, profinfo);
+ if (v == 0) {
+ if (Caml_state->in_minor_collection)
+ caml_fatal_error ("out of memory");
+ else
+ caml_raise_out_of_memory ();
+ }
+ return v;
}
-CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
- tag_t tag, header_t old_header)
+CAMLexport value caml_alloc_shr_with_profinfo (mlsize_t wosize, tag_t tag,
+ intnat profinfo)
{
- return caml_alloc_shr_aux (wosize, tag, 0, 1, Profinfo_hd(old_header));
+ return check_oom(caml_alloc_shr_aux(wosize, tag, 1, profinfo));
}
-#else
-#define NO_PROFINFO 0
-
CAMLexport value caml_alloc_shr_for_minor_gc (mlsize_t wosize,
- tag_t tag, header_t old_header)
+ tag_t tag, header_t old_hd)
{
- return caml_alloc_shr_aux (wosize, tag, 0, 1, NO_PROFINFO);
+ return check_oom(caml_alloc_shr_aux(wosize, tag, 0, Profinfo_hd(old_hd)));
}
-#endif /* WITH_PROFINFO */
CAMLexport value caml_alloc_shr (mlsize_t wosize, tag_t tag)
{
- return caml_alloc_shr_aux (wosize, tag, 1, 1, NO_PROFINFO);
+ return caml_alloc_shr_with_profinfo(wosize, tag, NO_PROFINFO);
}
CAMLexport value caml_alloc_shr_no_track_noexc (mlsize_t wosize, tag_t tag)
{
- return caml_alloc_shr_aux (wosize, tag, 0, 0, NO_PROFINFO);
+ return caml_alloc_shr_aux(wosize, tag, 0, NO_PROFINFO);
}
/* Dependent memory is all memory blocks allocated out of the heap
#define MIN_ENTRIES_LOCAL_ALLOC_LEN 16
#define MIN_ENTRIES_GLOBAL_ALLOC_LEN 128
-/* Entries for other blocks. This variable is shared accross threads. */
+/* Entries for other blocks. This variable is shared across threads. */
static struct entry_array entries_global =
{ NULL, MIN_ENTRIES_GLOBAL_ALLOC_LEN, 0, 0, 0, 0 };
#define C_CALL_FUN 25
#define C_CALL_TOC 26
#define C_CALL_RET_ADDR 27
-#define DOMAIN_STATE_PTR 28
#define TRAP_PTR 29
-#define ALLOC_LIMIT 30
+#define DOMAIN_STATE_PTR 30
#define ALLOC_PTR 31
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE
-#define Caml_state(var) 8*domain_field_caml_##var(28)
+#define Caml_state(var) 8*domain_field_caml_##var(DOMAIN_STATE_PTR)
#if defined(MODEL_ppc64)
.section ".opd","aw"
#if defined(MODEL_ppc64) || defined(MODEL_ppc64le)
nop
#endif
- /* Reload new allocation pointer and allocation limit */
+ /* Reload new allocation pointer */
lg ALLOC_PTR, Caml_state(young_ptr)
- lg ALLOC_LIMIT, Caml_state(young_limit)
/* Restore all regs used by the code generator */
addi 11, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK - WORD
lgu 3, WORD(11)
#endif
/* Restore return address (in 27, preserved by the C function) */
mtlr C_CALL_RET_ADDR
- /* Reload allocation pointer and allocation limit*/
+ /* Reload allocation pointer*/
lg ALLOC_PTR, Caml_state(young_ptr)
- lg ALLOC_LIMIT, Caml_state(young_limit)
/* Return to caller */
blr
.cfi_endproc
/* Reload OCaml global registers */
lg 1, Caml_state(exception_pointer)
lg ALLOC_PTR, Caml_state(young_ptr)
- lg ALLOC_LIMIT, Caml_state(young_limit)
/* Pop trap frame */
lg 0, TRAP_HANDLER_OFFSET(1)
mtctr 0
lg 11, Caml_state(exception_pointer)
stg 11, TRAP_PREVIOUS_OFFSET(1)
mr TRAP_PTR, 1
- /* Reload allocation pointers */
+ /* Reload allocation pointer */
lg ALLOC_PTR, Caml_state(young_ptr)
- lg ALLOC_LIMIT, Caml_state(young_limit)
/* Call the OCaml code (address in r12) */
#if defined(MODEL_ppc)
mtctr 12
/* Must be preprocessed by cpp */
#define ARG_DOMAIN_STATE_PTR t0
-#define DOMAIN_STATE_PTR s0
+#define DOMAIN_STATE_PTR s11
#define TRAP_PTR s1
#define ALLOC_PTR s10
-#define ALLOC_LIMIT s11
#define TMP t1
#define ARG t2
#include "../runtime/caml/domain_state.tbl"
#undef DOMAIN_STATE
-#define Caml_state(var) (8*domain_field_caml_##var)(s0)
+#define Caml_state(var) (8*domain_field_caml_##var)(DOMAIN_STATE_PTR)
#define FUNCTION(name) \
.align 2; \
/* Record lowest stack address */
STORE sp, Caml_state(bottom_of_stack)
/* Set up stack space, saving return address */
- /* (1 reg for RA, 1 reg for FP, 22 allocatable int regs,
+ /* (1 reg for RA, 1 reg for FP, 23 allocatable int regs,
20 caller-save float regs) * 8 */
- addi sp, sp, -0x160
+ /* + 1 for alignment */
+ addi sp, sp, -0x170
STORE ra, 0x8(sp)
- STORE s0, 0x0(sp)
/* Save allocatable integer registers on the stack,
in the order given in proc.ml */
STORE a0, 0x10(sp)
STORE t4, 0xa0(sp)
STORE t5, 0xa8(sp)
STORE t6, 0xb0(sp)
- STORE t0, 0xb8(sp)
+ STORE s0, 0xb8(sp)
+ STORE t0, 0xc0(sp)
/* Save caller-save floating-point registers on the stack
(callee-saves are preserved by caml_garbage_collection) */
- fsd ft0, 0xc0(sp)
- fsd ft1, 0xc8(sp)
- fsd ft2, 0xd0(sp)
- fsd ft3, 0xd8(sp)
- fsd ft4, 0xe0(sp)
- fsd ft5, 0xe8(sp)
- fsd ft6, 0xf0(sp)
- fsd ft7, 0xf8(sp)
- fsd fa0, 0x100(sp)
- fsd fa1, 0x108(sp)
- fsd fa2, 0x110(sp)
- fsd fa3, 0x118(sp)
- fsd fa4, 0x120(sp)
- fsd fa5, 0x128(sp)
- fsd fa6, 0x130(sp)
- fsd fa7, 0x138(sp)
- fsd ft8, 0x140(sp)
- fsd ft9, 0x148(sp)
- fsd ft10, 0x150(sp)
- fsd ft11, 0x158(sp)
+ fsd ft0, 0xd0(sp)
+ fsd ft1, 0xd8(sp)
+ fsd ft2, 0xe0(sp)
+ fsd ft3, 0xe8(sp)
+ fsd ft4, 0xf0(sp)
+ fsd ft5, 0xf8(sp)
+ fsd ft6, 0x100(sp)
+ fsd ft7, 0x108(sp)
+ fsd fa0, 0x110(sp)
+ fsd fa1, 0x118(sp)
+ fsd fa2, 0x120(sp)
+ fsd fa3, 0x128(sp)
+ fsd fa4, 0x130(sp)
+ fsd fa5, 0x138(sp)
+ fsd fa6, 0x140(sp)
+ fsd fa7, 0x148(sp)
+ fsd ft8, 0x150(sp)
+ fsd ft9, 0x158(sp)
+ fsd ft10, 0x160(sp)
+ fsd ft11, 0x168(sp)
/* Store pointer to saved integer registers in caml_gc_regs */
addi TMP, sp, 0x10
STORE TMP, Caml_state(gc_regs)
LOAD t4, 0xa0(sp)
LOAD t5, 0xa8(sp)
LOAD t6, 0xb0(sp)
- LOAD t0, 0xb8(sp)
- fld ft0, 0xc0(sp)
- fld ft1, 0xc8(sp)
- fld ft2, 0xd0(sp)
- fld ft3, 0xd8(sp)
- fld ft4, 0xe0(sp)
- fld ft5, 0xe8(sp)
- fld ft6, 0xf0(sp)
- fld ft7, 0xf8(sp)
- fld fa0, 0x100(sp)
- fld fa1, 0x108(sp)
- fld fa2, 0x110(sp)
- fld fa3, 0x118(sp)
- fld fa4, 0x120(sp)
- fld fa5, 0x128(sp)
- fld fa6, 0x130(sp)
- fld fa7, 0x138(sp)
- fld ft8, 0x140(sp)
- fld ft9, 0x148(sp)
- fld ft10, 0x150(sp)
- fld ft11, 0x158(sp)
- /* Reload new allocation pointer and allocation limit */
+ LOAD s0, 0xb8(sp)
+ LOAD t0, 0xc0(sp)
+ fld ft0, 0xd0(sp)
+ fld ft1, 0xd8(sp)
+ fld ft2, 0xe0(sp)
+ fld ft3, 0xe8(sp)
+ fld ft4, 0xf0(sp)
+ fld ft5, 0xf8(sp)
+ fld ft6, 0x100(sp)
+ fld ft7, 0x108(sp)
+ fld fa0, 0x110(sp)
+ fld fa1, 0x118(sp)
+ fld fa2, 0x120(sp)
+ fld fa3, 0x128(sp)
+ fld fa4, 0x130(sp)
+ fld fa5, 0x138(sp)
+ fld fa6, 0x140(sp)
+ fld fa7, 0x148(sp)
+ fld ft8, 0x150(sp)
+ fld ft9, 0x158(sp)
+ fld ft10, 0x160(sp)
+ fld ft11, 0x168(sp)
+ /* Reload new allocation pointer */
LOAD ALLOC_PTR, Caml_state(young_ptr)
- LOAD ALLOC_LIMIT, Caml_state(young_limit)
/* Free stack space and return to caller */
LOAD ra, 0x8(sp)
- LOAD s0, 0x0(sp)
- addi sp, sp, 0x160
+ addi sp, sp, 0x170
ret
.size caml_call_gc, .-caml_call_gc
STORE TRAP_PTR, Caml_state(exception_pointer)
/* Call the function */
jalr ARG
- /* Reload alloc ptr and alloc limit */
+ /* Reload alloc ptr */
LOAD ALLOC_PTR, Caml_state(young_ptr)
- LOAD ALLOC_LIMIT, Caml_state(young_limit)
/* Return */
jr s2
.size caml_c_call, .-caml_c_call
mv a0, a1
LOAD TRAP_PTR, Caml_state(exception_pointer)
LOAD ALLOC_PTR, Caml_state(young_ptr)
- LOAD ALLOC_LIMIT, Caml_state(young_limit)
LOAD TMP, Caml_state(backtrace_active)
bnez TMP, 2f
1: /* Cut stack at current trap handler */
STORE TMP, 8(sp)
mv TRAP_PTR, sp
LOAD ALLOC_PTR, Caml_state(young_ptr)
- LOAD ALLOC_LIMIT, Caml_state(young_limit)
STORE x0, Caml_state(last_return_address)
jalr ARG
.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* David Allsopp, OCaml Labs, Cambridge. */
+/* */
+/* Copyright 2021 David Allsopp Ltd. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+/* Runtime Builder's Swiss Army Knife. This utility performs functions
+ previously delegated to classic Unix utilities but which ultimately seem to
+ cause more hassle for maintenance than the initial simplicity suggests.
+
+ This tool is a memorial to the many hours and PRs spent chasing down strange
+ locale issues, stray CR characters and fighting yet another incompatible
+ implementation of sed or awk. */
+
+/* Borrow the Unicode *_os definitions and T() macro from misc.h */
+#define CAML_INTERNALS
+#include "caml/misc.h"
+
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+
+#ifdef _WIN32
+#define strncmp_os wcsncmp
+#define toupper_os towupper
+#define printf_os wprintf
+#else
+#define strncmp_os strncmp
+#define toupper_os toupper
+#define printf_os printf
+#endif
+
+/* Operations
+ - encode-C-literal. Used for the OCAML_STDLIB_DIR macro in
+ runtime/build_config.h to ensure the LIBDIR make variable is correctly
+ represented as a C string literal.
+
+ On Unix, `sak encode-C-literal /usr/local/lib` returns `"/usr/local/lib"`
+
+ On Windows, `sak encode-C-literal "C:\OCaml🐫\lib"` returns
+ `L"C:\\OCaml\xd83d\xdc2b\\lib"`
+ - add-stdlib-prefix. Used in stdlib/StdlibModules to convert the list of
+ basenames given in STDLIB_MODULE_BASENAMES to the actual file basenames
+ in STDLIB_MODULES.
+
+ For example, `sak add-stdlib-prefix stdlib camlinternalAtomic Sys` returns
+ ` stdlib camlinternalAtomic stdlib__Sys`
+ */
+
+void usage(void)
+{
+ printf(
+ "OCaml Build System Swiss Army Knife\n"
+ "Usage: sak command\n"
+ "Commands:\n"
+ " * encode-C-literal path - encodes path as a C string literal\n"
+ " * add-stdlib-prefix name1 ... - prefix standard library module names\n"
+ );
+}
+
+/* Converts the supplied path (UTF-8 on Unix and UCS-2ish on Windows) to a valid
+ C string literal. On Windows, this is always a wchar_t* (L"..."). */
+void encode_C_literal(char_os *path)
+{
+ char_os c;
+
+#ifdef _WIN32
+ putchar('L');
+#endif
+ putchar('"');
+
+ while ((c = *path++) != 0) {
+ /* Escape \, " and \n */
+ if (c == '\\') {
+ printf("\\\\");
+ } else if (c == '"') {
+ printf("\\\"");
+ } else if (c == '\n') {
+ printf("\\n");
+#ifndef _WIN32
+ /* On Unix, nothing else needs escaping */
+ } else {
+ putchar(c);
+#else
+ /* On Windows, allow 7-bit printable characters to be displayed literally
+ and escape everything else (using the older \x notation for increased
+ compatibility, rather than the newer \U. */
+ } else if (c < 0x80 && iswprint(c)) {
+ putwchar(c);
+ } else {
+ printf("\\x%04x", c);
+#endif
+ }
+ }
+
+ putchar('"');
+}
+
+/* Print the given array of module names to stdout. "stdlib" and names beginning
+ "camlinternal" are printed unaltered. All other names are prefixed "stdlib__"
+ with the original name capitalised (i.e. "foo" prints "stdlib__Foo"). */
+void add_stdlib_prefix(int count, char_os **names)
+{
+ int i;
+ char_os *name;
+
+ for (i = 0; i < count; i++) {
+ name = *names++;
+
+ /* "stdlib" and camlinternal* do not get changed. All other names get
+ capitalised and prefixed "stdlib__". */
+ if (strcmp_os(T("stdlib"), name) == 0
+ || strncmp_os(T("camlinternal"), name, 12) == 0) {
+ printf_os(T(" %s"), name);
+ } else {
+ /* name is a null-terminated string, so an empty string simply has the
+ null-terminator "capitalised". */
+ *name = toupper_os(*name);
+ printf_os(T(" stdlib__%s"), name);
+ }
+ }
+}
+
+#ifdef _WIN32
+int wmain(int argc, wchar_t **argv)
+#else
+int main(int argc, char **argv)
+#endif
+{
+ if (argc == 3 && !strcmp_os(argv[1], T("encode-C-literal"))) {
+ encode_C_literal(argv[2]);
+ } else if (argc > 1 && !strcmp_os(argv[1], T("add-stdlib-prefix"))) {
+ add_stdlib_prefix(argc - 2, &argv[2]);
+ } else {
+ usage();
+ return 1;
+ }
+
+ return 0;
+}
return 0;
}
-CAMLexport void caml_setup_stack_overflow_detection(void) {}
+CAMLexport int caml_setup_stack_overflow_detection(void) { return 0; }
including allocations combined by Comballoc */
alloc_len = (unsigned char*)(&d->live_ofs[d->num_live]);
nallocs = *alloc_len++;
- for (i = 0; i < nallocs; i++) {
- allocsz += Whsize_wosize(Wosize_encoded_alloc_len(alloc_len[i]));
+
+ if (nallocs == 0) {
+ /* This is a poll */
+ caml_process_pending_actions();
}
- /* We have computed whsize (including header), but need wosize (without) */
- allocsz -= 1;
+ else
+ {
+ for (i = 0; i < nallocs; i++) {
+ allocsz += Whsize_wosize(Wosize_encoded_alloc_len(alloc_len[i]));
+ }
+
+ /* We have computed whsize (including header), but need wosize (without) */
+ allocsz -= 1;
- caml_alloc_small_dispatch(allocsz, CAML_DO_TRACK | CAML_FROM_CAML,
- nallocs, alloc_len);
+ caml_alloc_small_dispatch(allocsz, CAML_DO_TRACK | CAML_FROM_CAML,
+ nallocs, alloc_len);
+ }
}
DECLARE_SIGNAL_HANDLER(handle_signal)
#endif
if (sig < 0 || sig >= NSIG) return;
caml_record_signal(sig);
- /* Some ports cache [Caml_state->young_limit] in a register.
- Use the signal context to modify that register too, but only if
- we are inside OCaml code (not inside C code). */
-#if defined(CONTEXT_PC) && defined(CONTEXT_YOUNG_LIMIT)
- if (caml_find_code_fragment_by_pc((char *) CONTEXT_PC) != NULL)
- CONTEXT_YOUNG_LIMIT = (context_reg) Caml_state->young_limit;
-#endif
errno = saved_errno;
}
#error "CONTEXT_SP is required if HAS_STACK_OVERFLOW_DETECTION is defined"
#endif
-static char sig_alt_stack[SIGSTKSZ];
-
/* Code compiled with ocamlopt never accesses more than
EXTRA_STACK bytes below the stack pointer. */
#define EXTRA_STACK 256
#endif
#ifdef HAS_STACK_OVERFLOW_DETECTION
- {
- stack_t stk;
+ if (caml_setup_stack_overflow_detection() != -1) {
struct sigaction act;
- stk.ss_sp = sig_alt_stack;
- stk.ss_size = SIGSTKSZ;
- stk.ss_flags = 0;
SET_SIGACT(act, segv_handler);
act.sa_flags |= SA_ONSTACK | SA_NODEFER;
sigemptyset(&act.sa_mask);
- if (sigaltstack(&stk, NULL) == 0) { sigaction(SIGSEGV, &act, NULL); }
+ sigaction(SIGSEGV, &act, NULL);
}
#endif
}
-CAMLexport void caml_setup_stack_overflow_detection(void)
+/* Allocate and select an alternate stack for handling signals,
+ especially SIGSEGV signals.
+ Each thread needs its own alternate stack.
+ The alternate stack used to be statically-allocated for the main thread,
+ but this is incompatible with Glibc 2.34 and newer, where SIGSTKSZ
+ may not be a compile-time constant (issue #10250). */
+
+CAMLexport int caml_setup_stack_overflow_detection(void)
{
#ifdef HAS_STACK_OVERFLOW_DETECTION
stack_t stk;
stk.ss_sp = malloc(SIGSTKSZ);
+ if (stk.ss_sp == NULL) return -1;
stk.ss_size = SIGSTKSZ;
stk.ss_flags = 0;
- if (stk.ss_sp)
- sigaltstack(&stk, NULL);
+ return sigaltstack(&stk, NULL);
+#else
+ return 0;
#endif
}
#define RETURN_AFTER_STACK_OVERFLOW
+/****************** AMD64, Solaris x86 */
+
+#elif defined(TARGET_amd64) && defined (SYS_solaris)
+
+ #include <ucontext.h>
+
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ typedef greg_t context_reg;
+ #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+ #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** AMD64, OpenBSD */
+
+#elif defined(TARGET_amd64) && defined (SYS_openbsd)
+
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, struct sigcontext * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ #define CONTEXT_PC (context->sc_rip)
+ #define CONTEXT_C_ARG_1 (context->sc_rdi)
+ #define CONTEXT_SP (context->sc_rsp)
+ #define CONTEXT_YOUNG_PTR (context->sc_r15)
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
+/****************** AMD64, NetBSD */
+
+#elif defined(TARGET_amd64) && defined (SYS_netbsd)
+
+ #include <ucontext.h>
+ #define DECLARE_SIGNAL_HANDLER(name) \
+ static void name(int sig, siginfo_t * info, ucontext_t * context)
+
+ #define SET_SIGACT(sigact,name) \
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
+
+ #define CONTEXT_PC (_UC_MACHINE_PC(context))
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
+ #define CONTEXT_SP (_UC_MACHINE_SP(context))
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+ #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+
/****************** ARM, Linux */
#elif defined(TARGET_arm) && (defined(SYS_linux_eabi) \
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.pc)
#define CONTEXT_SP (context->uc_mcontext.sp)
- #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.regs[26])
+ #define CONTEXT_C_ARG_1 (context->uc_mcontext.regs[0])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.regs[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) context->uc_mcontext.fault_address)
-/****************** ARM64, FreeBSD */
+ #define RETURN_AFTER_STACK_OVERFLOW
-#elif defined(TARGET_arm64) && defined(SYS_freebsd)
+/****************** ARM64, MacOSX */
+
+#elif defined(TARGET_arm64) && defined (SYS_macosx)
#include <sys/ucontext.h>
#define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, siginfo_t * info, ucontext_t * context)
+ static void name(int sig, siginfo_t * info, void * context)
#define SET_SIGACT(sigact,name) \
- sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_sigaction = (name); \
sigact.sa_flags = SA_SIGINFO
- typedef unsigned long context_reg;
- #define CONTEXT_PC (context->uc_mcontext.mc_gpregs.gp_elr)
- #define CONTEXT_SP (context->uc_mcontext.mc_gpregs.gp_sp)
- #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.mc_gpregs.gp_x[26])
- #define CONTEXT_YOUNG_PTR (context->uc_mcontext.mc_gpregs.gp_x[27])
+ typedef unsigned long long context_reg;
+ #define CONTEXT_STATE (((ucontext_t *)context)->uc_mcontext->__ss)
+ #define CONTEXT_PC (CONTEXT_STATE.__pc)
+ #define CONTEXT_SP (CONTEXT_STATE.__sp)
+ #define CONTEXT_C_ARG_1 (CONTEXT_STATE.__x[0])
+ #define CONTEXT_YOUNG_PTR (CONTEXT_STATE.__x[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
+ #define RETURN_AFTER_STACK_OVERFLOW
-/****************** AMD64, Solaris x86 */
+/****************** ARM64, FreeBSD */
-#elif defined(TARGET_amd64) && defined (SYS_solaris)
+#elif defined(TARGET_arm64) && defined(SYS_freebsd)
- #include <ucontext.h>
+ #include <sys/ucontext.h>
#define DECLARE_SIGNAL_HANDLER(name) \
static void name(int sig, siginfo_t * info, ucontext_t * context)
#define SET_SIGACT(sigact,name) \
- sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
- sigact.sa_flags = SA_SIGINFO
+ sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
+ sigact.sa_flags = SA_SIGINFO
- typedef greg_t context_reg;
- #define CONTEXT_PC (context->uc_mcontext.gregs[REG_RIP])
- #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
- #define CONTEXT_SP (context->uc_mcontext.gregs[REG_RSP])
- #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
+ typedef unsigned long context_reg;
+ #define CONTEXT_PC (context->uc_mcontext.mc_gpregs.gp_elr)
+ #define CONTEXT_SP (context->uc_mcontext.mc_gpregs.gp_sp)
+ #define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.mc_gpregs.gp_x[26])
+ #define CONTEXT_YOUNG_PTR (context->uc_mcontext.mc_gpregs.gp_x[27])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
-/****************** AMD64, OpenBSD */
-
-#elif defined(TARGET_amd64) && defined (SYS_openbsd)
-
- #define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, siginfo_t * info, struct sigcontext * context)
-
- #define SET_SIGACT(sigact,name) \
- sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
- sigact.sa_flags = SA_SIGINFO
-
- #define CONTEXT_PC (context->sc_rip)
- #define CONTEXT_C_ARG_1 (context->sc_rdi)
- #define CONTEXT_SP (context->sc_rsp)
- #define CONTEXT_YOUNG_PTR (context->sc_r15)
- #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
-
-/****************** AMD64, NetBSD */
-
-#elif defined(TARGET_amd64) && defined (SYS_netbsd)
-
- #include <ucontext.h>
- #define DECLARE_SIGNAL_HANDLER(name) \
- static void name(int sig, siginfo_t * info, ucontext_t * context)
-
- #define SET_SIGACT(sigact,name) \
- sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
- sigact.sa_flags = SA_SIGINFO
-
- #define CONTEXT_PC (_UC_MACHINE_PC(context))
- #define CONTEXT_C_ARG_1 (context->uc_mcontext.gregs[REG_RDI])
- #define CONTEXT_SP (_UC_MACHINE_SP(context))
- #define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[REG_R15])
- #define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
/****************** I386, Linux */
#define CONTEXT_STATE (CONTEXT_MCONTEXT->CONTEXT_REG(ss))
#define CONTEXT_PC (CONTEXT_STATE.CONTEXT_REG(srr0))
#define CONTEXT_EXCEPTION_POINTER (CONTEXT_STATE.CONTEXT_REG(r29))
- #define CONTEXT_YOUNG_LIMIT (CONTEXT_STATE.CONTEXT_REG(r30))
#define CONTEXT_YOUNG_PTR (CONTEXT_STATE.CONTEXT_REG(r31))
#define CONTEXT_SP (CONTEXT_STATE.CONTEXT_REG(r1))
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
typedef unsigned long context_reg;
#define CONTEXT_PC (context->regs->nip)
#define CONTEXT_EXCEPTION_POINTER (context->regs->gpr[29])
- #define CONTEXT_YOUNG_LIMIT (context->regs->gpr[30])
#define CONTEXT_YOUNG_PTR (context->regs->gpr[31])
#define CONTEXT_SP (context->regs->gpr[1])
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.gp_regs[32])
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gp_regs[29])
- #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.gp_regs[30])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gp_regs[31])
#define CONTEXT_SP (context->uc_mcontext.gp_regs[1])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
typedef long context_reg;
#define CONTEXT_PC (_UC_MACHINE_PC(context))
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.__gregs[_REG_R29])
- #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.__gregs[_REG_R30])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.__gregs[_REG_R31])
#define CONTEXT_SP (_UC_MACHINE_SP(context))
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
typedef unsigned long context_reg;
#define CONTEXT_PC (context->sc_frame.srr0)
#define CONTEXT_EXCEPTION_POINTER (context->sc_frame.fixreg[29])
- #define CONTEXT_YOUNG_LIMIT (context->sc_frame.fixreg[30])
#define CONTEXT_YOUNG_PTR (context->sc_frame.fixreg[31])
#define CONTEXT_SP (context->sc_frame.fixreg[1])
typedef unsigned long context_reg;
#define CONTEXT_PC (context->uc_mcontext.psw.addr)
#define CONTEXT_EXCEPTION_POINTER (context->uc_mcontext.gregs[13])
- #define CONTEXT_YOUNG_LIMIT (context->uc_mcontext.gregs[10])
#define CONTEXT_YOUNG_PTR (context->uc_mcontext.gregs[11])
#define CONTEXT_SP (context->uc_mcontext.gregs[15])
#define CONTEXT_FAULTING_ADDRESS ((char *) info->si_addr)
uintnat caml_init_custom_major_ratio = Custom_major_ratio_def;
uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def;
uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
+uintnat caml_init_policy = Allocation_policy_def;
extern int caml_parser_trace;
uintnat caml_trace_level = 0;
int caml_cleanup_on_exit = 0;
if (opt != NULL){
while (*opt != '\0'){
switch (*opt++){
- case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
- break;
- case 'b': scanmult (opt, &p); caml_record_backtrace(Val_int (p));
- break;
+ case 'a': scanmult (opt, &caml_init_policy); break;
+ case 'b': scanmult (opt, &p); caml_record_backtraces(p); break;
case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
case 'h': scanmult (opt, &caml_init_heap_wsz); break;
case 'H': scanmult (opt, &caml_use_huge_pages); break;
#include "caml/startup_aux.h"
#include "caml/version.h"
+#include "build_config.h"
+
#ifndef O_BINARY
#define O_BINARY 0
#endif
static char magicstr[EXEC_MAGIC_LENGTH+1];
static int print_magic = 0;
+static int print_config = 0;
/* Print the specified error message followed by an end-of-line and exit */
static void error(char *msg, ...)
*/
+static void do_print_help(void)
+{
+ printf("%s\n",
+ "Usage: ocamlrun [<options>] [--] <executable> [<command-line>]\n"
+ "Options are:\n"
+ " -b Set runtime parameter b (detailed exception backtraces)\n"
+ " -config Print configuration values and exit\n"
+ " -I <dir> Add <dir> to the list of DLL search directories\n"
+ " -m Print the magic number of <executable> and exit\n"
+ " -M Print the magic number expected by this runtime and exit\n"
+ " -p Print the names of the primitives known to this runtime\n"
+ " -t Trace the execution of the bytecode interpreter (specify multiple\n"
+ " times to increase verbosity)\n"
+ " -v Set runtime parameter v=61 (GC event information)\n"
+ " -version Print version string and exit\n"
+ " -vnum Print short version number and exit\n"
+ " -help Display this list of options\n"
+ " --help Display this list of options");
+}
+
/* Parse options on the command line */
static int parse_command_line(char_os **argv)
{
- int i, j;
+ int i, j, len, parsed;
for(i = 1; argv[i] != NULL && argv[i][0] == '-'; i++) {
- switch(argv[i][1]) {
- case 't':
- ++ caml_trace_level; /* ignored unless DEBUG mode */
- break;
- case 'v':
- if (!strcmp_os (argv[i], T("-version"))){
- printf ("%s\n", "The OCaml runtime, version " OCAML_VERSION_STRING);
- exit (0);
- }else if (!strcmp_os (argv[i], T("-vnum"))){
- printf ("%s\n", OCAML_VERSION_STRING);
- exit (0);
- }else{
+ len = strlen_os(argv[i]);
+ parsed = 1;
+ if (len == 2) {
+ /* Single-letter options, e.g. -v */
+ switch(argv[i][1]) {
+ case '-':
+ return i + 1;
+ break;
+ case 't':
+ ++ caml_trace_level; /* ignored unless DEBUG mode */
+ break;
+ case 'v':
caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
+ break;
+ case 'p':
+ for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
+ printf("%s\n", caml_names_of_builtin_cprim[j]);
+ exit(0);
+ break;
+ case 'b':
+ caml_record_backtraces(1);
+ break;
+ case 'I':
+ if (argv[i + 1] != NULL) {
+ caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]);
+ i++;
+ } else {
+ error("option '-I' needs an argument.");
+ }
+ break;
+ case 'm':
+ print_magic = 1;
+ break;
+ case 'M':
+ printf("%s\n", EXEC_MAGIC);
+ exit(0);
+ break;
+ default:
+ parsed = 0;
}
- break;
- case 'p':
- for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
- printf("%s\n", caml_names_of_builtin_cprim[j]);
- exit(0);
- break;
- case 'b':
- caml_record_backtrace(Val_true);
- break;
- case 'I':
- if (argv[i + 1] != NULL) {
- caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]);
- i++;
+ } else {
+ /* Named options, e.g. -version */
+ if (!strcmp_os(argv[i], T("-version"))) {
+ printf("%s\n", "The OCaml runtime, version " OCAML_VERSION_STRING);
+ exit(0);
+ } else if (!strcmp_os(argv[i], T("-vnum"))) {
+ printf("%s\n", OCAML_VERSION_STRING);
+ exit(0);
+ } else if (!strcmp_os(argv[i], T("-help")) ||
+ !strcmp_os(argv[i], T("--help"))) {
+ do_print_help();
+ exit(0);
+ } else if (!strcmp_os(argv[i], T("-config"))) {
+ print_config = 1;
+ } else {
+ parsed = 0;
}
- break;
- case 'm':
- print_magic = 1;
- break;
- case 'M':
- printf ( "%s\n", EXEC_MAGIC);
- exit(0);
- break;
- default:
- error("unknown option %s", caml_stat_strdup_of_os(argv[i]));
}
+
+ if (!parsed)
+ error("unknown option %s", caml_stat_strdup_of_os(argv[i]));
}
+
return i;
}
+/* Print the configuration of the runtime to stdout; memory allocated is not
+ freed, since the runtime will terminate after calling this. */
+static void do_print_config(void)
+{
+ int i;
+ char_os * dir;
+
+ /* Print the runtime configuration */
+ printf("version: %s\n", OCAML_VERSION_STRING);
+ printf("standard_library_default: %s\n",
+ caml_stat_strdup_of_os(OCAML_STDLIB_DIR));
+ printf("standard_library: %s\n",
+ caml_stat_strdup_of_os(caml_get_stdlib_location()));
+ printf("int_size: %d\n", 8 * (int)sizeof(value));
+ printf("word_size: %d\n", 8 * (int)sizeof(value) - 1);
+ printf("os_type: %s\n", OCAML_OS_TYPE);
+ printf("host: %s\n", HOST);
+ printf("flat_float_array: %s\n",
+#ifdef FLAT_FLOAT_ARRAY
+ "true");
+#else
+ "false");
+#endif
+ printf("supports_afl: %s\n",
+#ifdef HAS_SYS_SHM_H
+ "true");
+#else
+ "false");
+#endif
+ printf("windows_unicode: %s\n",
+#if WINDOWS_UNICODE
+ "true");
+#else
+ "false");
+#endif
+ printf("supports_shared_libraries: %s\n",
+#ifdef SUPPORT_DYNAMIC_LINKING
+ "true");
+#else
+ "false");
+#endif
+ printf("no_naked_pointers: %s\n",
+#ifdef NO_NAKED_POINTERS
+ "true");
+#else
+ "false");
+#endif
+ printf("profinfo: %s\n"
+ "profinfo_width: %d\n",
+#ifdef WITH_PROFINFO
+ "true", PROFINFO_WIDTH);
+#else
+ "false", 0);
+#endif
+ printf("exec_magic_number: %s\n", EXEC_MAGIC);
+
+ /* Parse ld.conf and print the effective search path */
+ puts("shared_libs_path:");
+ caml_parse_ld_conf();
+ for (i = 0; i < caml_shared_libs_path.size; i++) {
+ dir = caml_shared_libs_path.contents[i];
+ if (dir[0] == 0)
+#ifdef _WIN32
+ /* See caml_search_in_path in win32.c */
+ continue;
+#else
+ dir = ".";
+#endif
+ printf(" %s\n", caml_stat_strdup_of_os(dir));
+ }
+}
+
#ifdef _WIN32
extern void caml_signal_thread(void * lpParam);
#endif
if (fd < 0) {
pos = parse_command_line(argv);
+ if (print_config) {
+ do_print_config();
+ exit(0);
+ }
if (argv[pos] == 0) {
error("no bytecode file specified");
}
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free, caml_init_major_window,
caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
- caml_init_custom_minor_max_bsz);
+ caml_init_custom_minor_max_bsz, caml_init_policy);
caml_init_stack (caml_init_max_stack_wsz);
caml_init_atom_table();
caml_init_backtrace();
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free, caml_init_major_window,
caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
- caml_init_custom_minor_max_bsz);
+ caml_init_custom_minor_max_bsz, caml_init_policy);
caml_init_stack (caml_init_max_stack_wsz);
caml_init_atom_table();
caml_init_backtrace();
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free, caml_init_major_window,
caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
- caml_init_custom_minor_max_bsz);
+ caml_init_custom_minor_max_bsz, caml_init_policy);
init_static();
caml_init_signals();
#ifdef _WIN32
#include "caml/debugger.h"
#include "caml/fail.h"
#include "caml/gc_ctrl.h"
+#include "caml/major_gc.h"
#include "caml/io.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
}
}
-CAMLprim value caml_sys_exit(value retcode_v)
+CAMLexport void caml_do_exit(int retcode)
{
- int retcode = Int_val(retcode_v);
-
if ((caml_verb_gc & 0x400) != 0) {
/* cf caml_gc_counters */
double minwords = Caml_state->stat_minor_words
caml_shutdown();
#ifdef _WIN32
caml_restore_win32_terminal();
+#endif
+#ifdef NAKED_POINTERS_CHECKER
+ if (retcode == 0 && caml_naked_pointers_detected) {
+ fprintf (stderr, "\nOut-of-heap pointers were detected by the runtime.\n"
+ "The process would otherwise have terminated normally.\n");
+ retcode = 70; /* EX_SOFTWARE; see sysexits.h */
+ }
#endif
exit(retcode);
}
+CAMLprim value caml_sys_exit(value retcode)
+{
+ caml_do_exit(Int_val(retcode));
+}
+
#ifndef O_BINARY
#define O_BINARY 0
#endif
#else
/* clock() is standard ANSI C. We have no way of getting
subprocess times in this branch. */
- return (double)clock() / CLOCKS_PER_SEC;
+ return (double)clock_os() / CLOCKS_PER_SEC;
#endif
#endif
}
#include <sys/ioctl.h>
#include <fcntl.h>
#include "caml/config.h"
-#ifdef SUPPORT_DYNAMIC_LINKING
+#if defined(SUPPORT_DYNAMIC_LINKING) && !defined(BUILDING_LIBCAMLRUNS)
+#define WITH_DYNAMIC_LINKING
#ifdef __CYGWIN__
#include "flexdll.h"
#else
return res;
}
-#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef WITH_DYNAMIC_LINKING
#ifdef __CYGWIN__
/* Use flexdll */
return flexdll_dlerror();
}
-#else
+#else /* ! __CYGWIN__ */
/* Use normal dlopen */
#ifndef RTLD_GLOBAL
return (char*) dlerror();
}
-#endif
+#endif /* __CYGWIN__ */
#else
void * caml_dlopen(char * libname, int for_execution, int global)
return "dynamic loading not supported on this platform";
}
-#endif
+#endif /* WITH_DYNAMIC_LINKING */
/* Add to [contents] the (short) names of the files contained in
the directory named [dirname]. No entries are added for [.] and [..].
#include "caml/sys.h"
#include "caml/config.h"
-#ifdef SUPPORT_DYNAMIC_LINKING
+
+#if defined(SUPPORT_DYNAMIC_LINKING) && !defined(BUILDING_LIBCAMLRUNS)
+#define WITH_DYNAMIC_LINKING
+#endif
+
+#ifdef WITH_DYNAMIC_LINKING
#include <flexdll.h>
#endif
return res;
}
-#ifdef SUPPORT_DYNAMIC_LINKING
+#ifdef WITH_DYNAMIC_LINKING
void * caml_dlopen(wchar_t * libname, int for_execution, int global)
{
return "dynamic loading not supported on this platform";
}
-#endif
+#endif /* WITH_DYNAMIC_LINKING */
/* Proper emulation of signal(), including ctrl-C and ctrl-break */
char iobuf[2];
/* This shall always return a single character */
ret = ReadFile(h, iobuf, 1, &numread, NULL);
- if (!ret || numread != 1) caml_sys_exit(Val_int(2));
+ if (!ret || numread != 1) caml_do_exit(2);
switch (iobuf[0]) {
case 'C':
caml_record_signal(SIGINT);
{
return -1;
}
+
+/* UCRT clock function returns wall-clock time */
+CAMLexport clock_t caml_win32_clock(void)
+{
+ FILETIME c, e, stime, utime;
+ ULARGE_INTEGER tmp;
+ ULONGLONG total, clocks_per_sec;
+
+ if (!(GetProcessTimes(GetCurrentProcess(), &c, &e, &stime, &utime))) {
+ return (clock_t)(-1);
+ }
+
+ tmp.u.LowPart = stime.dwLowDateTime;
+ tmp.u.HighPart = stime.dwHighDateTime;
+ total = tmp.QuadPart;
+ tmp.u.LowPart = utime.dwLowDateTime;
+ tmp.u.HighPart = utime.dwHighDateTime;
+ total += tmp.QuadPart;
+
+ /* total in 100-nanosecond intervals (1e7 / CLOCKS_PER_SEC) */
+ clocks_per_sec = INT64_LITERAL(10000000U) / (ULONGLONG)CLOCKS_PER_SEC;
+ return (clock_t)(total / clocks_per_sec);
+}
-stdlib__arg.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__printf.cmi \
- stdlib__list.cmi \
- stdlib__buffer.cmi \
- stdlib__array.cmi \
- stdlib__arg.cmi
-stdlib__arg.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__printf.cmx \
- stdlib__list.cmx \
- stdlib__buffer.cmx \
- stdlib__array.cmx \
- stdlib__arg.cmi
-stdlib__arg.cmi :
-stdlib__array.cmo : \
- stdlib__seq.cmi \
- stdlib__array.cmi
-stdlib__array.cmx : \
- stdlib__seq.cmx \
- stdlib__array.cmi
-stdlib__array.cmi : \
- stdlib__seq.cmi
-stdlib__arrayLabels.cmo : \
- stdlib__array.cmi \
- stdlib__arrayLabels.cmi
-stdlib__arrayLabels.cmx : \
- stdlib__array.cmx \
- stdlib__arrayLabels.cmi
-stdlib__arrayLabels.cmi : \
- stdlib__seq.cmi
-stdlib__atomic.cmo : \
+stdlib__Arg.cmo : arg.ml \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Printf.cmi \
+ stdlib__List.cmi \
+ stdlib__Int.cmi \
+ stdlib__Buffer.cmi \
+ stdlib__Array.cmi \
+ stdlib__Arg.cmi
+stdlib__Arg.cmx : arg.ml \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Printf.cmx \
+ stdlib__List.cmx \
+ stdlib__Int.cmx \
+ stdlib__Buffer.cmx \
+ stdlib__Array.cmx \
+ stdlib__Arg.cmi
+stdlib__Arg.cmi : arg.mli
+stdlib__Array.cmo : array.ml \
+ stdlib__Seq.cmi \
+ stdlib__Array.cmi
+stdlib__Array.cmx : array.ml \
+ stdlib__Seq.cmx \
+ stdlib__Array.cmi
+stdlib__Array.cmi : array.mli \
+ stdlib__Seq.cmi
+stdlib__ArrayLabels.cmo : arrayLabels.ml \
+ stdlib__Array.cmi \
+ stdlib__ArrayLabels.cmi
+stdlib__ArrayLabels.cmx : arrayLabels.ml \
+ stdlib__Array.cmx \
+ stdlib__ArrayLabels.cmi
+stdlib__ArrayLabels.cmi : arrayLabels.mli \
+ stdlib__Seq.cmi
+stdlib__Atomic.cmo : atomic.ml \
camlinternalAtomic.cmi \
- stdlib__atomic.cmi
-stdlib__atomic.cmx : \
+ stdlib__Atomic.cmi
+stdlib__Atomic.cmx : atomic.ml \
camlinternalAtomic.cmx \
- stdlib__atomic.cmi
-stdlib__atomic.cmi :
-stdlib__bigarray.cmo : \
- stdlib__sys.cmi \
- stdlib__complex.cmi \
- stdlib__array.cmi \
- stdlib__bigarray.cmi
-stdlib__bigarray.cmx : \
- stdlib__sys.cmx \
- stdlib__complex.cmx \
- stdlib__array.cmx \
- stdlib__bigarray.cmi
-stdlib__bigarray.cmi : \
- stdlib__complex.cmi
-stdlib__bool.cmo : \
+ stdlib__Atomic.cmi
+stdlib__Atomic.cmi : atomic.mli
+stdlib__Bigarray.cmo : bigarray.ml \
+ stdlib__Sys.cmi \
+ stdlib__Complex.cmi \
+ stdlib__Array.cmi \
+ stdlib__Bigarray.cmi
+stdlib__Bigarray.cmx : bigarray.ml \
+ stdlib__Sys.cmx \
+ stdlib__Complex.cmx \
+ stdlib__Array.cmx \
+ stdlib__Bigarray.cmi
+stdlib__Bigarray.cmi : bigarray.mli \
+ stdlib__Complex.cmi
+stdlib__Bool.cmo : bool.ml \
stdlib.cmi \
- stdlib__bool.cmi
-stdlib__bool.cmx : \
+ stdlib__Bool.cmi
+stdlib__Bool.cmx : bool.ml \
stdlib.cmx \
- stdlib__bool.cmi
-stdlib__bool.cmi :
-stdlib__buffer.cmo : \
- stdlib__uchar.cmi \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__seq.cmi \
- stdlib__char.cmi \
- stdlib__bytes.cmi \
- stdlib__buffer.cmi
-stdlib__buffer.cmx : \
- stdlib__uchar.cmx \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__seq.cmx \
- stdlib__char.cmx \
- stdlib__bytes.cmx \
- stdlib__buffer.cmi
-stdlib__buffer.cmi : \
- stdlib__uchar.cmi \
- stdlib__seq.cmi
-stdlib__bytes.cmo : \
- stdlib__sys.cmi \
+ stdlib__Bool.cmi
+stdlib__Bool.cmi : bool.mli
+stdlib__Buffer.cmo : buffer.ml \
+ stdlib__Uchar.cmi \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Char.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Buffer.cmi
+stdlib__Buffer.cmx : buffer.ml \
+ stdlib__Uchar.cmx \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Seq.cmx \
+ stdlib__Char.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Buffer.cmi
+stdlib__Buffer.cmi : buffer.mli \
+ stdlib__Uchar.cmi \
+ stdlib__Seq.cmi
+stdlib__Bytes.cmo : bytes.ml \
+ stdlib__Sys.cmi \
stdlib.cmi \
- stdlib__seq.cmi \
- stdlib__char.cmi \
- stdlib__bytes.cmi
-stdlib__bytes.cmx : \
- stdlib__sys.cmx \
+ stdlib__Seq.cmi \
+ stdlib__Int.cmi \
+ stdlib__Char.cmi \
+ stdlib__Bytes.cmi
+stdlib__Bytes.cmx : bytes.ml \
+ stdlib__Sys.cmx \
stdlib.cmx \
- stdlib__seq.cmx \
- stdlib__char.cmx \
- stdlib__bytes.cmi
-stdlib__bytes.cmi : \
- stdlib__seq.cmi
-stdlib__bytesLabels.cmo : \
- stdlib__bytes.cmi \
- stdlib__bytesLabels.cmi
-stdlib__bytesLabels.cmx : \
- stdlib__bytes.cmx \
- stdlib__bytesLabels.cmi
-stdlib__bytesLabels.cmi : \
- stdlib__seq.cmi
-stdlib__callback.cmo : \
- stdlib__obj.cmi \
- stdlib__callback.cmi
-stdlib__callback.cmx : \
- stdlib__obj.cmx \
- stdlib__callback.cmi
-stdlib__callback.cmi :
+ stdlib__Seq.cmx \
+ stdlib__Int.cmx \
+ stdlib__Char.cmx \
+ stdlib__Bytes.cmi
+stdlib__Bytes.cmi : bytes.mli \
+ stdlib__Seq.cmi
+stdlib__BytesLabels.cmo : bytesLabels.ml \
+ stdlib__Bytes.cmi \
+ stdlib__BytesLabels.cmi
+stdlib__BytesLabels.cmx : bytesLabels.ml \
+ stdlib__Bytes.cmx \
+ stdlib__BytesLabels.cmi
+stdlib__BytesLabels.cmi : bytesLabels.mli \
+ stdlib__Seq.cmi
+stdlib__Callback.cmo : callback.ml \
+ stdlib__Obj.cmi \
+ stdlib__Callback.cmi
+stdlib__Callback.cmx : callback.ml \
+ stdlib__Obj.cmx \
+ stdlib__Callback.cmi
+stdlib__Callback.cmi : callback.mli
camlinternalAtomic.cmo : \
camlinternalAtomic.cmi
camlinternalAtomic.cmx : \
camlinternalAtomic.cmi
camlinternalAtomic.cmi :
camlinternalFormat.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__int.cmi \
- stdlib__char.cmi \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Int.cmi \
+ stdlib__Char.cmi \
camlinternalFormatBasics.cmi \
- stdlib__bytes.cmi \
- stdlib__buffer.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Buffer.cmi \
camlinternalFormat.cmi
camlinternalFormat.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__int.cmx \
- stdlib__char.cmx \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Int.cmx \
+ stdlib__Char.cmx \
camlinternalFormatBasics.cmx \
- stdlib__bytes.cmx \
- stdlib__buffer.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Buffer.cmx \
camlinternalFormat.cmi
camlinternalFormat.cmi : \
camlinternalFormatBasics.cmi \
- stdlib__buffer.cmi
+ stdlib__Buffer.cmi
camlinternalFormatBasics.cmo : \
camlinternalFormatBasics.cmi
camlinternalFormatBasics.cmx : \
camlinternalFormatBasics.cmi
camlinternalFormatBasics.cmi :
camlinternalLazy.cmo : \
- stdlib__sys.cmi \
- stdlib__obj.cmi \
+ stdlib__Sys.cmi \
+ stdlib__Obj.cmi \
camlinternalLazy.cmi
camlinternalLazy.cmx : \
- stdlib__sys.cmx \
- stdlib__obj.cmx \
+ stdlib__Sys.cmx \
+ stdlib__Obj.cmx \
camlinternalLazy.cmi
camlinternalLazy.cmi :
camlinternalMod.cmo : \
- stdlib__sys.cmi \
- stdlib__obj.cmi \
- stdlib__nativeint.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Lazy.cmi \
camlinternalOO.cmi \
- stdlib__array.cmi \
+ stdlib__Array.cmi \
camlinternalMod.cmi
camlinternalMod.cmx : \
- stdlib__sys.cmx \
- stdlib__obj.cmx \
- stdlib__nativeint.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Lazy.cmx \
camlinternalOO.cmx \
- stdlib__array.cmx \
+ stdlib__Array.cmx \
camlinternalMod.cmi
camlinternalMod.cmi : \
- stdlib__obj.cmi
+ stdlib__Obj.cmi
camlinternalOO.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__obj.cmi \
- stdlib__map.cmi \
- stdlib__list.cmi \
- stdlib__char.cmi \
- stdlib__array.cmi \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Map.cmi \
+ stdlib__List.cmi \
+ stdlib__Char.cmi \
+ stdlib__Array.cmi \
camlinternalOO.cmi
camlinternalOO.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__obj.cmx \
- stdlib__map.cmx \
- stdlib__list.cmx \
- stdlib__char.cmx \
- stdlib__array.cmx \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Map.cmx \
+ stdlib__List.cmx \
+ stdlib__Char.cmx \
+ stdlib__Array.cmx \
camlinternalOO.cmi
camlinternalOO.cmi : \
- stdlib__obj.cmi
-stdlib__char.cmo : \
- stdlib__char.cmi
-stdlib__char.cmx : \
- stdlib__char.cmi
-stdlib__char.cmi :
-stdlib__complex.cmo : \
- stdlib__complex.cmi
-stdlib__complex.cmx : \
- stdlib__complex.cmi
-stdlib__complex.cmi :
-stdlib__digest.cmo : \
- stdlib__string.cmi \
- stdlib__char.cmi \
- stdlib__bytes.cmi \
- stdlib__digest.cmi
-stdlib__digest.cmx : \
- stdlib__string.cmx \
- stdlib__char.cmx \
- stdlib__bytes.cmx \
- stdlib__digest.cmi
-stdlib__digest.cmi :
-stdlib__either.cmo : \
- stdlib__either.cmi
-stdlib__either.cmx : \
- stdlib__either.cmi
-stdlib__either.cmi :
-stdlib__ephemeron.cmo : \
- stdlib__sys.cmi \
- stdlib__seq.cmi \
- stdlib__random.cmi \
- stdlib__obj.cmi \
- stdlib__lazy.cmi \
- stdlib__hashtbl.cmi \
- stdlib__array.cmi \
- stdlib__ephemeron.cmi
-stdlib__ephemeron.cmx : \
- stdlib__sys.cmx \
- stdlib__seq.cmx \
- stdlib__random.cmx \
- stdlib__obj.cmx \
- stdlib__lazy.cmx \
- stdlib__hashtbl.cmx \
- stdlib__array.cmx \
- stdlib__ephemeron.cmi
-stdlib__ephemeron.cmi : \
- stdlib__hashtbl.cmi
-stdlib__filename.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__random.cmi \
- stdlib__printf.cmi \
- stdlib__list.cmi \
- stdlib__lazy.cmi \
- stdlib__buffer.cmi \
- stdlib__filename.cmi
-stdlib__filename.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__random.cmx \
- stdlib__printf.cmx \
- stdlib__list.cmx \
- stdlib__lazy.cmx \
- stdlib__buffer.cmx \
- stdlib__filename.cmi
-stdlib__filename.cmi :
-stdlib__float.cmo : \
+ stdlib__Obj.cmi
+stdlib__Char.cmo : char.ml \
+ stdlib__Char.cmi
+stdlib__Char.cmx : char.ml \
+ stdlib__Char.cmi
+stdlib__Char.cmi : char.mli
+stdlib__Complex.cmo : complex.ml \
+ stdlib__Complex.cmi
+stdlib__Complex.cmx : complex.ml \
+ stdlib__Complex.cmi
+stdlib__Complex.cmi : complex.mli
+stdlib__Digest.cmo : digest.ml \
+ stdlib__String.cmi \
+ stdlib__Char.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Digest.cmi
+stdlib__Digest.cmx : digest.ml \
+ stdlib__String.cmx \
+ stdlib__Char.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Digest.cmi
+stdlib__Digest.cmi : digest.mli
+stdlib__Either.cmo : either.ml \
+ stdlib__Either.cmi
+stdlib__Either.cmx : either.ml \
+ stdlib__Either.cmi
+stdlib__Either.cmi : either.mli
+stdlib__Ephemeron.cmo : ephemeron.ml \
+ stdlib__Sys.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Random.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Lazy.cmi \
+ stdlib__Int.cmi \
+ stdlib__Hashtbl.cmi \
+ stdlib__Array.cmi \
+ stdlib__Ephemeron.cmi
+stdlib__Ephemeron.cmx : ephemeron.ml \
+ stdlib__Sys.cmx \
+ stdlib__Seq.cmx \
+ stdlib__Random.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Lazy.cmx \
+ stdlib__Int.cmx \
+ stdlib__Hashtbl.cmx \
+ stdlib__Array.cmx \
+ stdlib__Ephemeron.cmi
+stdlib__Ephemeron.cmi : ephemeron.mli \
+ stdlib__Hashtbl.cmi
+stdlib__Filename.cmo : filename.ml \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Random.cmi \
+ stdlib__Printf.cmi \
+ stdlib__List.cmi \
+ stdlib__Lazy.cmi \
+ stdlib__Buffer.cmi \
+ stdlib__Filename.cmi
+stdlib__Filename.cmx : filename.ml \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Random.cmx \
+ stdlib__Printf.cmx \
+ stdlib__List.cmx \
+ stdlib__Lazy.cmx \
+ stdlib__Buffer.cmx \
+ stdlib__Filename.cmi
+stdlib__Filename.cmi : filename.mli
+stdlib__Float.cmo : float.ml \
stdlib.cmi \
- stdlib__seq.cmi \
- stdlib__list.cmi \
- stdlib__array.cmi \
- stdlib__float.cmi
-stdlib__float.cmx : \
+ stdlib__Seq.cmi \
+ stdlib__List.cmi \
+ stdlib__Array.cmi \
+ stdlib__Float.cmi
+stdlib__Float.cmx : float.ml \
stdlib.cmx \
- stdlib__seq.cmx \
- stdlib__list.cmx \
- stdlib__array.cmx \
- stdlib__float.cmi
-stdlib__float.cmi : \
+ stdlib__Seq.cmx \
+ stdlib__List.cmx \
+ stdlib__Array.cmx \
+ stdlib__Float.cmi
+stdlib__Float.cmi : float.mli \
stdlib.cmi \
- stdlib__seq.cmi
-stdlib__format.cmo : \
- stdlib__string.cmi \
+ stdlib__Seq.cmi
+stdlib__Format.cmo : format.ml \
+ stdlib__String.cmi \
stdlib.cmi \
- stdlib__stack.cmi \
- stdlib__seq.cmi \
- stdlib__queue.cmi \
- stdlib__list.cmi \
- stdlib__int.cmi \
+ stdlib__Stack.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Queue.cmi \
+ stdlib__List.cmi \
+ stdlib__Int.cmi \
+ stdlib__Either.cmi \
camlinternalFormatBasics.cmi \
camlinternalFormat.cmi \
- stdlib__buffer.cmi \
- stdlib__format.cmi
-stdlib__format.cmx : \
- stdlib__string.cmx \
+ stdlib__Bytes.cmi \
+ stdlib__Buffer.cmi \
+ stdlib__Format.cmi
+stdlib__Format.cmx : format.ml \
+ stdlib__String.cmx \
stdlib.cmx \
- stdlib__stack.cmx \
- stdlib__seq.cmx \
- stdlib__queue.cmx \
- stdlib__list.cmx \
- stdlib__int.cmx \
+ stdlib__Stack.cmx \
+ stdlib__Seq.cmx \
+ stdlib__Queue.cmx \
+ stdlib__List.cmx \
+ stdlib__Int.cmx \
+ stdlib__Either.cmx \
camlinternalFormatBasics.cmx \
camlinternalFormat.cmx \
- stdlib__buffer.cmx \
- stdlib__format.cmi
-stdlib__format.cmi : \
+ stdlib__Bytes.cmx \
+ stdlib__Buffer.cmx \
+ stdlib__Format.cmi
+stdlib__Format.cmi : format.mli \
stdlib.cmi \
- stdlib__seq.cmi \
- stdlib__buffer.cmi
-stdlib__fun.cmo : \
- stdlib__printexc.cmi \
- stdlib__fun.cmi
-stdlib__fun.cmx : \
- stdlib__printexc.cmx \
- stdlib__fun.cmi
-stdlib__fun.cmi :
-stdlib__gc.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__printf.cmi \
- stdlib__printexc.cmi \
- stdlib__gc.cmi
-stdlib__gc.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__printf.cmx \
- stdlib__printexc.cmx \
- stdlib__gc.cmi
-stdlib__gc.cmi : \
- stdlib__printexc.cmi
-stdlib__genlex.cmo : \
- stdlib__string.cmi \
- stdlib__stream.cmi \
- stdlib__list.cmi \
- stdlib__hashtbl.cmi \
- stdlib__char.cmi \
- stdlib__bytes.cmi \
- stdlib__genlex.cmi
-stdlib__genlex.cmx : \
- stdlib__string.cmx \
- stdlib__stream.cmx \
- stdlib__list.cmx \
- stdlib__hashtbl.cmx \
- stdlib__char.cmx \
- stdlib__bytes.cmx \
- stdlib__genlex.cmi
-stdlib__genlex.cmi : \
- stdlib__stream.cmi
-stdlib__hashtbl.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__seq.cmi \
- stdlib__random.cmi \
- stdlib__obj.cmi \
- stdlib__lazy.cmi \
- stdlib__array.cmi \
- stdlib__hashtbl.cmi
-stdlib__hashtbl.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__seq.cmx \
- stdlib__random.cmx \
- stdlib__obj.cmx \
- stdlib__lazy.cmx \
- stdlib__array.cmx \
- stdlib__hashtbl.cmi
-stdlib__hashtbl.cmi : \
- stdlib__seq.cmi
-stdlib__int.cmo : \
+ stdlib__Seq.cmi \
+ stdlib__Either.cmi \
+ stdlib__Buffer.cmi
+stdlib__Fun.cmo : fun.ml \
+ stdlib__Printexc.cmi \
+ stdlib__Fun.cmi
+stdlib__Fun.cmx : fun.ml \
+ stdlib__Printexc.cmx \
+ stdlib__Fun.cmi
+stdlib__Fun.cmi : fun.mli
+stdlib__Gc.cmo : gc.ml \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Printf.cmi \
+ stdlib__Printexc.cmi \
+ stdlib__Gc.cmi
+stdlib__Gc.cmx : gc.ml \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Printf.cmx \
+ stdlib__Printexc.cmx \
+ stdlib__Gc.cmi
+stdlib__Gc.cmi : gc.mli \
+ stdlib__Printexc.cmi
+stdlib__Genlex.cmo : genlex.ml \
+ stdlib__String.cmi \
+ stdlib__Stream.cmi \
+ stdlib__List.cmi \
+ stdlib__Hashtbl.cmi \
+ stdlib__Char.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Genlex.cmi
+stdlib__Genlex.cmx : genlex.ml \
+ stdlib__String.cmx \
+ stdlib__Stream.cmx \
+ stdlib__List.cmx \
+ stdlib__Hashtbl.cmx \
+ stdlib__Char.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Genlex.cmi
+stdlib__Genlex.cmi : genlex.mli \
+ stdlib__Stream.cmi
+stdlib__Hashtbl.cmo : hashtbl.ml \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Random.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Lazy.cmi \
+ stdlib__Int.cmi \
+ stdlib__Array.cmi \
+ stdlib__Hashtbl.cmi
+stdlib__Hashtbl.cmx : hashtbl.ml \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Seq.cmx \
+ stdlib__Random.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Lazy.cmx \
+ stdlib__Int.cmx \
+ stdlib__Array.cmx \
+ stdlib__Hashtbl.cmi
+stdlib__Hashtbl.cmi : hashtbl.mli \
+ stdlib__Seq.cmi
+stdlib__Int.cmo : int.ml \
stdlib.cmi \
- stdlib__int.cmi
-stdlib__int.cmx : \
+ stdlib__Int.cmi
+stdlib__Int.cmx : int.ml \
stdlib.cmx \
- stdlib__int.cmi
-stdlib__int.cmi :
-stdlib__int32.cmo : \
- stdlib__sys.cmi \
+ stdlib__Int.cmi
+stdlib__Int.cmi : int.mli
+stdlib__Int32.cmo : int32.ml \
+ stdlib__Sys.cmi \
stdlib.cmi \
- stdlib__int32.cmi
-stdlib__int32.cmx : \
- stdlib__sys.cmx \
+ stdlib__Int32.cmi
+stdlib__Int32.cmx : int32.ml \
+ stdlib__Sys.cmx \
stdlib.cmx \
- stdlib__int32.cmi
-stdlib__int32.cmi :
-stdlib__int64.cmo : \
+ stdlib__Int32.cmi
+stdlib__Int32.cmi : int32.mli
+stdlib__Int64.cmo : int64.ml \
stdlib.cmi \
- stdlib__int64.cmi
-stdlib__int64.cmx : \
+ stdlib__Int64.cmi
+stdlib__Int64.cmx : int64.ml \
stdlib.cmx \
- stdlib__int64.cmi
-stdlib__int64.cmi :
-stdlib__lazy.cmo : \
- stdlib__obj.cmi \
+ stdlib__Int64.cmi
+stdlib__Int64.cmi : int64.mli
+stdlib__Lazy.cmo : lazy.ml \
+ stdlib__Obj.cmi \
camlinternalLazy.cmi \
- stdlib__lazy.cmi
-stdlib__lazy.cmx : \
- stdlib__obj.cmx \
+ stdlib__Lazy.cmi
+stdlib__Lazy.cmx : lazy.ml \
+ stdlib__Obj.cmx \
camlinternalLazy.cmx \
- stdlib__lazy.cmi
-stdlib__lazy.cmi : \
+ stdlib__Lazy.cmi
+stdlib__Lazy.cmi : lazy.mli \
camlinternalLazy.cmi
-stdlib__lexing.cmo : \
- stdlib__sys.cmi \
- stdlib__string.cmi \
- stdlib__bytes.cmi \
- stdlib__array.cmi \
- stdlib__lexing.cmi
-stdlib__lexing.cmx : \
- stdlib__sys.cmx \
- stdlib__string.cmx \
- stdlib__bytes.cmx \
- stdlib__array.cmx \
- stdlib__lexing.cmi
-stdlib__lexing.cmi :
-stdlib__list.cmo : \
- stdlib__sys.cmi \
- stdlib__seq.cmi \
- stdlib__either.cmi \
- stdlib__list.cmi
-stdlib__list.cmx : \
- stdlib__sys.cmx \
- stdlib__seq.cmx \
- stdlib__either.cmx \
- stdlib__list.cmi
-stdlib__list.cmi : \
- stdlib__seq.cmi \
- stdlib__either.cmi
-stdlib__listLabels.cmo : \
- stdlib__list.cmi \
- stdlib__listLabels.cmi
-stdlib__listLabels.cmx : \
- stdlib__list.cmx \
- stdlib__listLabels.cmi
-stdlib__listLabels.cmi : \
- stdlib__seq.cmi \
- stdlib__either.cmi
-stdlib__map.cmo : \
- stdlib__seq.cmi \
- stdlib__map.cmi
-stdlib__map.cmx : \
- stdlib__seq.cmx \
- stdlib__map.cmi
-stdlib__map.cmi : \
- stdlib__seq.cmi
-stdlib__marshal.cmo : \
- stdlib__bytes.cmi \
- stdlib__marshal.cmi
-stdlib__marshal.cmx : \
- stdlib__bytes.cmx \
- stdlib__marshal.cmi
-stdlib__marshal.cmi :
-stdlib__moreLabels.cmo : \
- stdlib__set.cmi \
- stdlib__map.cmi \
- stdlib__hashtbl.cmi \
- stdlib__moreLabels.cmi
-stdlib__moreLabels.cmx : \
- stdlib__set.cmx \
- stdlib__map.cmx \
- stdlib__hashtbl.cmx \
- stdlib__moreLabels.cmi
-stdlib__moreLabels.cmi : \
- stdlib__set.cmi \
- stdlib__seq.cmi \
- stdlib__map.cmi \
- stdlib__hashtbl.cmi
-stdlib__nativeint.cmo : \
- stdlib__sys.cmi \
+stdlib__Lexing.cmo : lexing.ml \
+ stdlib__Sys.cmi \
+ stdlib__String.cmi \
+ stdlib__Int.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Array.cmi \
+ stdlib__Lexing.cmi
+stdlib__Lexing.cmx : lexing.ml \
+ stdlib__Sys.cmx \
+ stdlib__String.cmx \
+ stdlib__Int.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Array.cmx \
+ stdlib__Lexing.cmi
+stdlib__Lexing.cmi : lexing.mli
+stdlib__List.cmo : list.ml \
+ stdlib__Sys.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Either.cmi \
+ stdlib__List.cmi
+stdlib__List.cmx : list.ml \
+ stdlib__Sys.cmx \
+ stdlib__Seq.cmx \
+ stdlib__Either.cmx \
+ stdlib__List.cmi
+stdlib__List.cmi : list.mli \
+ stdlib__Seq.cmi \
+ stdlib__Either.cmi
+stdlib__ListLabels.cmo : listLabels.ml \
+ stdlib__List.cmi \
+ stdlib__ListLabels.cmi
+stdlib__ListLabels.cmx : listLabels.ml \
+ stdlib__List.cmx \
+ stdlib__ListLabels.cmi
+stdlib__ListLabels.cmi : listLabels.mli \
+ stdlib__Seq.cmi \
+ stdlib__Either.cmi
+stdlib__Map.cmo : map.ml \
+ stdlib__Seq.cmi \
+ stdlib__Map.cmi
+stdlib__Map.cmx : map.ml \
+ stdlib__Seq.cmx \
+ stdlib__Map.cmi
+stdlib__Map.cmi : map.mli \
+ stdlib__Seq.cmi
+stdlib__Marshal.cmo : marshal.ml \
+ stdlib__Bytes.cmi \
+ stdlib__Marshal.cmi
+stdlib__Marshal.cmx : marshal.ml \
+ stdlib__Bytes.cmx \
+ stdlib__Marshal.cmi
+stdlib__Marshal.cmi : marshal.mli
+stdlib__MoreLabels.cmo : moreLabels.ml \
+ stdlib__Set.cmi \
+ stdlib__Map.cmi \
+ stdlib__Hashtbl.cmi \
+ stdlib__MoreLabels.cmi
+stdlib__MoreLabels.cmx : moreLabels.ml \
+ stdlib__Set.cmx \
+ stdlib__Map.cmx \
+ stdlib__Hashtbl.cmx \
+ stdlib__MoreLabels.cmi
+stdlib__MoreLabels.cmi : moreLabels.mli \
+ stdlib__Set.cmi \
+ stdlib__Seq.cmi \
+ stdlib__Map.cmi \
+ stdlib__Hashtbl.cmi
+stdlib__Nativeint.cmo : nativeint.ml \
+ stdlib__Sys.cmi \
stdlib.cmi \
- stdlib__nativeint.cmi
-stdlib__nativeint.cmx : \
- stdlib__sys.cmx \
+ stdlib__Nativeint.cmi
+stdlib__Nativeint.cmx : nativeint.ml \
+ stdlib__Sys.cmx \
stdlib.cmx \
- stdlib__nativeint.cmi
-stdlib__nativeint.cmi :
-stdlib__obj.cmo : \
- stdlib__sys.cmi \
- stdlib__nativeint.cmi \
- stdlib__marshal.cmi \
- stdlib__int32.cmi \
- stdlib__obj.cmi
-stdlib__obj.cmx : \
- stdlib__sys.cmx \
- stdlib__nativeint.cmx \
- stdlib__marshal.cmx \
- stdlib__int32.cmx \
- stdlib__obj.cmi
-stdlib__obj.cmi : \
- stdlib__int32.cmi
-stdlib__oo.cmo : \
+ stdlib__Nativeint.cmi
+stdlib__Nativeint.cmi : nativeint.mli
+stdlib__Obj.cmo : obj.ml \
+ stdlib__Sys.cmi \
+ stdlib__Nativeint.cmi \
+ stdlib__Marshal.cmi \
+ stdlib__Int32.cmi \
+ stdlib__Obj.cmi
+stdlib__Obj.cmx : obj.ml \
+ stdlib__Sys.cmx \
+ stdlib__Nativeint.cmx \
+ stdlib__Marshal.cmx \
+ stdlib__Int32.cmx \
+ stdlib__Obj.cmi
+stdlib__Obj.cmi : obj.mli \
+ stdlib__Int32.cmi
+stdlib__Oo.cmo : oo.ml \
camlinternalOO.cmi \
- stdlib__oo.cmi
-stdlib__oo.cmx : \
+ stdlib__Oo.cmi
+stdlib__Oo.cmx : oo.ml \
camlinternalOO.cmx \
- stdlib__oo.cmi
-stdlib__oo.cmi : \
+ stdlib__Oo.cmi
+stdlib__Oo.cmi : oo.mli \
camlinternalOO.cmi
-stdlib__option.cmo : \
- stdlib__seq.cmi \
- stdlib__option.cmi
-stdlib__option.cmx : \
- stdlib__seq.cmx \
- stdlib__option.cmi
-stdlib__option.cmi : \
- stdlib__seq.cmi
-stdlib__parsing.cmo : \
- stdlib__obj.cmi \
- stdlib__lexing.cmi \
- stdlib__array.cmi \
- stdlib__parsing.cmi
-stdlib__parsing.cmx : \
- stdlib__obj.cmx \
- stdlib__lexing.cmx \
- stdlib__array.cmx \
- stdlib__parsing.cmi
-stdlib__parsing.cmi : \
- stdlib__obj.cmi \
- stdlib__lexing.cmi
-stdlib__pervasives.cmo : \
+stdlib__Option.cmo : option.ml \
+ stdlib__Seq.cmi \
+ stdlib__Option.cmi
+stdlib__Option.cmx : option.ml \
+ stdlib__Seq.cmx \
+ stdlib__Option.cmi
+stdlib__Option.cmi : option.mli \
+ stdlib__Seq.cmi
+stdlib__Parsing.cmo : parsing.ml \
+ stdlib__Obj.cmi \
+ stdlib__Lexing.cmi \
+ stdlib__Array.cmi \
+ stdlib__Parsing.cmi
+stdlib__Parsing.cmx : parsing.ml \
+ stdlib__Obj.cmx \
+ stdlib__Lexing.cmx \
+ stdlib__Array.cmx \
+ stdlib__Parsing.cmi
+stdlib__Parsing.cmi : parsing.mli \
+ stdlib__Obj.cmi \
+ stdlib__Lexing.cmi
+stdlib__Pervasives.cmo : pervasives.ml \
camlinternalFormatBasics.cmi
-stdlib__pervasives.cmx : \
+stdlib__Pervasives.cmx : pervasives.ml \
camlinternalFormatBasics.cmx
-stdlib__printexc.cmo : \
+stdlib__Printexc.cmo : printexc.ml \
stdlib.cmi \
- stdlib__printf.cmi \
- stdlib__obj.cmi \
- stdlib__buffer.cmi \
- stdlib__atomic.cmi \
- stdlib__array.cmi \
- stdlib__printexc.cmi
-stdlib__printexc.cmx : \
+ stdlib__Printf.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Buffer.cmi \
+ stdlib__Atomic.cmi \
+ stdlib__Array.cmi \
+ stdlib__Printexc.cmi
+stdlib__Printexc.cmx : printexc.ml \
stdlib.cmx \
- stdlib__printf.cmx \
- stdlib__obj.cmx \
- stdlib__buffer.cmx \
- stdlib__atomic.cmx \
- stdlib__array.cmx \
- stdlib__printexc.cmi
-stdlib__printexc.cmi :
-stdlib__printf.cmo : \
+ stdlib__Printf.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Buffer.cmx \
+ stdlib__Atomic.cmx \
+ stdlib__Array.cmx \
+ stdlib__Printexc.cmi
+stdlib__Printexc.cmi : printexc.mli
+stdlib__Printf.cmo : printf.ml \
camlinternalFormatBasics.cmi \
camlinternalFormat.cmi \
- stdlib__buffer.cmi \
- stdlib__printf.cmi
-stdlib__printf.cmx : \
+ stdlib__Buffer.cmi \
+ stdlib__Printf.cmi
+stdlib__Printf.cmx : printf.ml \
camlinternalFormatBasics.cmx \
camlinternalFormat.cmx \
- stdlib__buffer.cmx \
- stdlib__printf.cmi
-stdlib__printf.cmi : \
- stdlib__buffer.cmi
-stdlib__queue.cmo : \
- stdlib__seq.cmi \
- stdlib__queue.cmi
-stdlib__queue.cmx : \
- stdlib__seq.cmx \
- stdlib__queue.cmi
-stdlib__queue.cmi : \
- stdlib__seq.cmi
-stdlib__random.cmo : \
- stdlib__string.cmi \
+ stdlib__Buffer.cmx \
+ stdlib__Printf.cmi
+stdlib__Printf.cmi : printf.mli \
+ stdlib__Buffer.cmi
+stdlib__Queue.cmo : queue.ml \
+ stdlib__Seq.cmi \
+ stdlib__Queue.cmi
+stdlib__Queue.cmx : queue.ml \
+ stdlib__Seq.cmx \
+ stdlib__Queue.cmi
+stdlib__Queue.cmi : queue.mli \
+ stdlib__Seq.cmi
+stdlib__Random.cmo : random.ml \
+ stdlib__String.cmi \
stdlib.cmi \
- stdlib__nativeint.cmi \
- stdlib__int64.cmi \
- stdlib__int32.cmi \
- stdlib__int.cmi \
- stdlib__digest.cmi \
- stdlib__char.cmi \
- stdlib__array.cmi \
- stdlib__random.cmi
-stdlib__random.cmx : \
- stdlib__string.cmx \
+ stdlib__Nativeint.cmi \
+ stdlib__Int64.cmi \
+ stdlib__Int32.cmi \
+ stdlib__Int.cmi \
+ stdlib__Digest.cmi \
+ stdlib__Char.cmi \
+ stdlib__Array.cmi \
+ stdlib__Random.cmi
+stdlib__Random.cmx : random.ml \
+ stdlib__String.cmx \
stdlib.cmx \
- stdlib__nativeint.cmx \
- stdlib__int64.cmx \
- stdlib__int32.cmx \
- stdlib__int.cmx \
- stdlib__digest.cmx \
- stdlib__char.cmx \
- stdlib__array.cmx \
- stdlib__random.cmi
-stdlib__random.cmi : \
- stdlib__nativeint.cmi \
- stdlib__int64.cmi \
- stdlib__int32.cmi
-stdlib__result.cmo : \
- stdlib__seq.cmi \
- stdlib__result.cmi
-stdlib__result.cmx : \
- stdlib__seq.cmx \
- stdlib__result.cmi
-stdlib__result.cmi : \
- stdlib__seq.cmi
-stdlib__scanf.cmo : \
- stdlib__string.cmi \
+ stdlib__Nativeint.cmx \
+ stdlib__Int64.cmx \
+ stdlib__Int32.cmx \
+ stdlib__Int.cmx \
+ stdlib__Digest.cmx \
+ stdlib__Char.cmx \
+ stdlib__Array.cmx \
+ stdlib__Random.cmi
+stdlib__Random.cmi : random.mli \
+ stdlib__Nativeint.cmi \
+ stdlib__Int64.cmi \
+ stdlib__Int32.cmi
+stdlib__Result.cmo : result.ml \
+ stdlib__Seq.cmi \
+ stdlib__Result.cmi
+stdlib__Result.cmx : result.ml \
+ stdlib__Seq.cmx \
+ stdlib__Result.cmi
+stdlib__Result.cmi : result.mli \
+ stdlib__Seq.cmi
+stdlib__Scanf.cmo : scanf.ml \
+ stdlib__String.cmi \
stdlib.cmi \
- stdlib__printf.cmi \
- stdlib__list.cmi \
+ stdlib__Printf.cmi \
+ stdlib__List.cmi \
+ stdlib__Int.cmi \
camlinternalFormatBasics.cmi \
camlinternalFormat.cmi \
- stdlib__bytes.cmi \
- stdlib__buffer.cmi \
- stdlib__scanf.cmi
-stdlib__scanf.cmx : \
- stdlib__string.cmx \
+ stdlib__Bytes.cmi \
+ stdlib__Buffer.cmi \
+ stdlib__Scanf.cmi
+stdlib__Scanf.cmx : scanf.ml \
+ stdlib__String.cmx \
stdlib.cmx \
- stdlib__printf.cmx \
- stdlib__list.cmx \
+ stdlib__Printf.cmx \
+ stdlib__List.cmx \
+ stdlib__Int.cmx \
camlinternalFormatBasics.cmx \
camlinternalFormat.cmx \
- stdlib__bytes.cmx \
- stdlib__buffer.cmx \
- stdlib__scanf.cmi
-stdlib__scanf.cmi : \
+ stdlib__Bytes.cmx \
+ stdlib__Buffer.cmx \
+ stdlib__Scanf.cmi
+stdlib__Scanf.cmi : scanf.mli \
stdlib.cmi
-stdlib__seq.cmo : \
- stdlib__seq.cmi
-stdlib__seq.cmx : \
- stdlib__seq.cmi
-stdlib__seq.cmi :
-stdlib__set.cmo : \
- stdlib__seq.cmi \
- stdlib__list.cmi \
- stdlib__set.cmi
-stdlib__set.cmx : \
- stdlib__seq.cmx \
- stdlib__list.cmx \
- stdlib__set.cmi
-stdlib__set.cmi : \
- stdlib__seq.cmi
-stdlib__stack.cmo : \
- stdlib__seq.cmi \
- stdlib__list.cmi \
- stdlib__stack.cmi
-stdlib__stack.cmx : \
- stdlib__seq.cmx \
- stdlib__list.cmx \
- stdlib__stack.cmi
-stdlib__stack.cmi : \
- stdlib__seq.cmi
-stdlib__stdLabels.cmo : \
- stdlib__stringLabels.cmi \
- stdlib__listLabels.cmi \
- stdlib__bytesLabels.cmi \
- stdlib__arrayLabels.cmi \
- stdlib__stdLabels.cmi
-stdlib__stdLabels.cmx : \
- stdlib__stringLabels.cmx \
- stdlib__listLabels.cmx \
- stdlib__bytesLabels.cmx \
- stdlib__arrayLabels.cmx \
- stdlib__stdLabels.cmi
-stdlib__stdLabels.cmi : \
- stdlib__stringLabels.cmi \
- stdlib__listLabels.cmi \
- stdlib__bytesLabels.cmi \
- stdlib__arrayLabels.cmi
+stdlib__Seq.cmo : seq.ml \
+ stdlib__Seq.cmi
+stdlib__Seq.cmx : seq.ml \
+ stdlib__Seq.cmi
+stdlib__Seq.cmi : seq.mli
+stdlib__Set.cmo : set.ml \
+ stdlib__Seq.cmi \
+ stdlib__List.cmi \
+ stdlib__Set.cmi
+stdlib__Set.cmx : set.ml \
+ stdlib__Seq.cmx \
+ stdlib__List.cmx \
+ stdlib__Set.cmi
+stdlib__Set.cmi : set.mli \
+ stdlib__Seq.cmi
+stdlib__Stack.cmo : stack.ml \
+ stdlib__Seq.cmi \
+ stdlib__List.cmi \
+ stdlib__Stack.cmi
+stdlib__Stack.cmx : stack.ml \
+ stdlib__Seq.cmx \
+ stdlib__List.cmx \
+ stdlib__Stack.cmi
+stdlib__Stack.cmi : stack.mli \
+ stdlib__Seq.cmi
+stdlib__StdLabels.cmo : stdLabels.ml \
+ stdlib__StringLabels.cmi \
+ stdlib__ListLabels.cmi \
+ stdlib__BytesLabels.cmi \
+ stdlib__ArrayLabels.cmi \
+ stdlib__StdLabels.cmi
+stdlib__StdLabels.cmx : stdLabels.ml \
+ stdlib__StringLabels.cmx \
+ stdlib__ListLabels.cmx \
+ stdlib__BytesLabels.cmx \
+ stdlib__ArrayLabels.cmx \
+ stdlib__StdLabels.cmi
+stdlib__StdLabels.cmi : stdLabels.mli \
+ stdlib__StringLabels.cmi \
+ stdlib__ListLabels.cmi \
+ stdlib__BytesLabels.cmi \
+ stdlib__ArrayLabels.cmi
std_exit.cmo :
std_exit.cmx :
-stdlib__stream.cmo : \
- stdlib__string.cmi \
- stdlib__list.cmi \
- stdlib__lazy.cmi \
- stdlib__bytes.cmi \
- stdlib__stream.cmi
-stdlib__stream.cmx : \
- stdlib__string.cmx \
- stdlib__list.cmx \
- stdlib__lazy.cmx \
- stdlib__bytes.cmx \
- stdlib__stream.cmi
-stdlib__stream.cmi :
-stdlib__string.cmo : \
+stdlib__Stream.cmo : stream.ml \
+ stdlib__String.cmi \
+ stdlib__List.cmi \
+ stdlib__Lazy.cmi \
+ stdlib__Bytes.cmi \
+ stdlib__Stream.cmi
+stdlib__Stream.cmx : stream.ml \
+ stdlib__String.cmx \
+ stdlib__List.cmx \
+ stdlib__Lazy.cmx \
+ stdlib__Bytes.cmx \
+ stdlib__Stream.cmi
+stdlib__Stream.cmi : stream.mli
+stdlib__String.cmo : string.ml \
stdlib.cmi \
- stdlib__bytes.cmi \
- stdlib__string.cmi
-stdlib__string.cmx : \
+ stdlib__Bytes.cmi \
+ stdlib__String.cmi
+stdlib__String.cmx : string.ml \
stdlib.cmx \
- stdlib__bytes.cmx \
- stdlib__string.cmi
-stdlib__string.cmi : \
- stdlib__seq.cmi
-stdlib__stringLabels.cmo : \
- stdlib__string.cmi \
- stdlib__stringLabels.cmi
-stdlib__stringLabels.cmx : \
- stdlib__string.cmx \
- stdlib__stringLabels.cmi
-stdlib__stringLabels.cmi : \
- stdlib__seq.cmi
-stdlib__sys.cmo : \
- stdlib__sys.cmi
-stdlib__sys.cmx : \
- stdlib__sys.cmi
-stdlib__sys.cmi :
-stdlib__uchar.cmo : \
+ stdlib__Bytes.cmx \
+ stdlib__String.cmi
+stdlib__String.cmi : string.mli \
+ stdlib__Seq.cmi
+stdlib__StringLabels.cmo : stringLabels.ml \
+ stdlib__String.cmi \
+ stdlib__StringLabels.cmi
+stdlib__StringLabels.cmx : stringLabels.ml \
+ stdlib__String.cmx \
+ stdlib__StringLabels.cmi
+stdlib__StringLabels.cmi : stringLabels.mli \
+ stdlib__Seq.cmi
+stdlib__Sys.cmo : sys.ml \
+ stdlib__Sys.cmi
+stdlib__Sys.cmx : sys.ml \
+ stdlib__Sys.cmi
+stdlib__Sys.cmi : sys.mli
+stdlib__Uchar.cmo : uchar.ml \
stdlib.cmi \
- stdlib__char.cmi \
- stdlib__uchar.cmi
-stdlib__uchar.cmx : \
+ stdlib__Char.cmi \
+ stdlib__Uchar.cmi
+stdlib__Uchar.cmx : uchar.ml \
stdlib.cmx \
- stdlib__char.cmx \
- stdlib__uchar.cmi
-stdlib__uchar.cmi :
-stdlib__unit.cmo : \
- stdlib__unit.cmi
-stdlib__unit.cmx : \
- stdlib__unit.cmi
-stdlib__unit.cmi :
-stdlib__weak.cmo : \
- stdlib__sys.cmi \
- stdlib__obj.cmi \
- stdlib__hashtbl.cmi \
- stdlib__array.cmi \
- stdlib__weak.cmi
-stdlib__weak.cmx : \
- stdlib__sys.cmx \
- stdlib__obj.cmx \
- stdlib__hashtbl.cmx \
- stdlib__array.cmx \
- stdlib__weak.cmi
-stdlib__weak.cmi : \
- stdlib__hashtbl.cmi
+ stdlib__Char.cmx \
+ stdlib__Uchar.cmi
+stdlib__Uchar.cmi : uchar.mli
+stdlib__Unit.cmo : unit.ml \
+ stdlib__Unit.cmi
+stdlib__Unit.cmx : unit.ml \
+ stdlib__Unit.cmi
+stdlib__Unit.cmi : unit.mli
+stdlib__Weak.cmo : weak.ml \
+ stdlib__Sys.cmi \
+ stdlib__Obj.cmi \
+ stdlib__Int.cmi \
+ stdlib__Hashtbl.cmi \
+ stdlib__Array.cmi \
+ stdlib__Weak.cmi
+stdlib__Weak.cmx : weak.ml \
+ stdlib__Sys.cmx \
+ stdlib__Obj.cmx \
+ stdlib__Int.cmx \
+ stdlib__Hashtbl.cmx \
+ stdlib__Array.cmx \
+ stdlib__Weak.cmi
+stdlib__Weak.cmi : weak.mli \
+ stdlib__Hashtbl.cmi
stdlib.cmo : \
camlinternalFormatBasics.cmi \
camlinternalAtomic.cmi \
--- /dev/null
+# How to contribute changes
+
+Contributions to the standard library are very welcome. There is some
+widespread belief in the community than the stdlib is somehow "frozen"
+and that its evolutions are mostly driven by the need of the OCaml
+compiler itself. Let's be clear: this is just plain wrong. The
+compiler is happy with its own local utility functions, and many
+recent additions to the stdlib are not used by the compiler.
+
+Another common and wrong idea is that core OCaml maintainers don't
+really care about the standard library. This is not true, and won't
+be unless one of the "alternative standard" libraries really gains
+enough "market share" in the community.
+
+So: please contribute!
+
+Obviously, the proposals to evolve the standard library will be
+evaluated with very high standards, similar to those applied to the
+evolution of the surface langage, and much higher than those for
+internal compiler changes (optimizations, etc).
+
+A key property of the standard library is its stability. Backward
+compatibility is not an absolute technical requirement (any addition
+to/of a module can break existing code, formally), but breakage should
+be limited as much as possible (and assessed, when relevant). A
+corollary is that any addition creates a long-term support commitment.
+For instance, once a concrete type or function is made public,
+changing the exposed definition cannot be done easily.
+
+There is no plan to extend dramatically the functional domain covered
+by the standard library. For instance, proposals to include support
+for XML, JSON, or network protocols are very likely to be rejected. Such
+domains are better treated by external libraries. Small additions to
+existing modules are much simpler to get in, even more so (but not
+necessarily) when:
+
+ - they cannot easily be implemented externally, or when
+ - they facilitate communication between independent external
+ libraries, or when
+ - they fill obvious gaps.
+
+Of course, standard guidelines apply as well: proper documentation,
+proper tests, portability (yes, also Windows!), good justification for
+why the change is desirable and why it should go into stdlib.
+
+So: be prepared for some serious review process! But yes, yes,
+contributions are welcome and appreciated. Promised.
+
+## Naming functions and API
+
+Naming functions or finding the a suitable argument order is a
+notoriously hard task. In general the name of a function should
+be descriptive and already make the usage clear. In case a similar
+function already exists in another module of the standard library
+one should use the same name and argument order.
+
+If the function takes several arguments with the same type it is okay to
+use labels for some of the arguments in order to avoid confusion about
+argument order.
+
+A good starting point for function names and API
+is checking if these functions are already contained in some of the
+popular alternative standard library function such as
+(Base)[https://github.com/janestreet/base],
+(OCaml Batteries)[https://github.com/ocaml-batteries-team/batteries-included],
+(ExtLib)[https://github.com/ygrek/ocaml-extlib] or
+(OCaml-containers)[https://github.com/c-cube/ocaml-containers].
+One can also take a look at the standard libraries from other
+programming languages for inspiration regarding names and API.
camlinternalOO.cmx) echo ' -inline 0 -afl-inst-ratio 0';;
camlinternalLazy.cmx) echo ' -afl-inst-ratio 0';;
# never instrument camlinternalOO or camlinternalLazy (PR#7725)
- stdlib__buffer.cmx) echo ' -inline 3';;
+ stdlib__Buffer.cmx) echo ' -inline 3';;
# make sure add_char is inlined (PR#5872)
- stdlib__buffer.cm[io]) echo ' -w A';;
- camlinternalFormat.cm[io]) echo ' -w Ae';;
- stdlib__printf.cm[io]|stdlib__format.cm[io]|stdlib__scanf.cm[io])
- echo ' -w Ae';;
- stdlib__scanf.cmx) echo ' -inline 9';;
+ stdlib__Buffer.cm[io]) echo ' -w +A';;
+ camlinternalFormat.cm[io]) echo ' -w +A -w -fragile-match';;
+ stdlib__Printf.cm[io]|stdlib__Format.cm[io]|stdlib__Scanf.cm[io])
+ echo ' -w +A -w -fragile-match';;
+ stdlib__Scanf.cmx) echo ' -inline 9';;
*Labels.cmi) echo ' -pp "$AWK -f ./expand_module_aliases.awk"';;
*Labels.cm[ox]) echo ' -nolabels -no-alias-deps';;
- stdlib__float.cm[ox]) echo ' -nolabels -no-alias-deps';;
- stdlib__oo.cmi) echo ' -no-principal';;
+ stdlib__Float.cm[ox]) echo ' -nolabels -no-alias-deps';;
+ stdlib__Oo.cmi) echo ' -no-principal';;
# preserve structure sharing in Oo.copy (PR#9767)
*) echo ' ';;
esac
= Contributing to the standard library
For guidelines about standard library content, see
-link:../CONTRIBUTING.md#contributing-to-the-standard-library[].
+link:CONTRIBUTING.md[].
Note: All paths are given relative to the root of the repository.
the same style as the rest of the code, in particular the
alphabetical ordering and whitespace alignment of module aliases.
-* Add `module_name` to the definition of `STDLIB_MODS` in
+* Add `module_name` to the definition of `STDLIB_MODULE_BASENAMES` in
`stdlib/StdlibModules`. You must keep the list sorted in dependency order.
* Run `make alldepend` to update all the `.depend` files. These files are not
TARGET_BINDIR ?= $(BINDIR)
COMPILER=$(ROOTDIR)/ocamlc$(EXE)
-CAMLC=$(CAMLRUN) $(COMPILER)
-COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48 \
- -g -warn-error A -bin-annot -nostdlib -principal \
+CAMLC=$(OCAMLRUN) $(COMPILER)
+COMPFLAGS=-strict-sequence -absname -w +a-4-9-41-42-44-45-48-70 \
+ -g -warn-error +A -bin-annot -nostdlib -principal \
-safe-string -strict-formats
ifeq "$(FLAMBDA)" "true"
OPTCOMPFLAGS += -O3
endif
-OPTCOMPILER=$(ROOTDIR)/ocamlopt$(EXE)
-CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
+OPTCOMPILER=$(ROOTDIR)/ocamlopt
+CAMLOPT=$(OCAMLRUN) $(OPTCOMPILER)
CAMLDEP=$(BOOT_OCAMLC) -depend
DEPFLAGS=-slash
NOSTDLIB= camlinternalFormatBasics.cmo camlinternalAtomic.cmo stdlib.cmo
OTHERS=$(filter-out $(NOSTDLIB),$(OBJS))
-PREFIXED_OBJS=$(filter stdlib__%.cmo,$(OBJS))
-UNPREFIXED_OBJS=$(PREFIXED_OBJS:stdlib__%.cmo=%)
-
.PHONY: all
all: stdlib.cma std_exit.cmo camlheader target_camlheader camlheader_ur
all: camlheaderd target_camlheaderd
endif
-ifeq "$(RUNTIMEI)" "true"
+ifeq "$(INSTRUMENTED_RUNTIME)" "true"
all: camlheaderi target_camlheaderi
endif
opt.opt: allopt
.PHONY: install
+# Ensure any pre-4.13 lowercased artefacts are removed on macOS and Windows
+install::
+ stale="$(filter-out $(notdir $(wildcard stdlib__*.cmi)), \
+ $(notdir $(wildcard $(INSTALL_LIBDIR)/stdlib__*.cmi)))"; \
+ if test -n "$$stale" ; then \
+ echo "$(INSTALL_LIBDIR) contains stale stdlib artefacts"; \
+ echo "Please rm $(INSTALL_LIBDIR)/stdlib__*.cm* and re-run make install"; \
+ exit 1; \
+ fi
+
install::
$(INSTALL_DATA) \
stdlib.cma std_exit.cmo *.cmi camlheader_ur \
$(INSTALL_DATA) target_camlheaderd "$(INSTALL_LIBDIR)/camlheaderd"
endif
-ifeq "$(RUNTIMEI)" "true"
+ifeq "$(INSTRUMENTED_RUNTIME)" "true"
install::
$(INSTALL_DATA) target_camlheaderi "$(INSTALL_LIBDIR)/camlheaderi"
endif
installopt: installopt-default
.PHONY: installopt-default
-installopt-default:
+# Ensure any pre-4.13 lowercased artefacts are removed on macOS and Windows
+installopt-default::
+ stale="$(filter-out $(notdir $(wildcard stdlib__*.cmx)), \
+ $(notdir $(wildcard $(INSTALL_LIBDIR)/stdlib__*.cmx)))"; \
+ if test -n "$$stale" ; then \
+ echo "$(INSTALL_LIBDIR) contains stale stdlib artefacts"; \
+ echo "Please rm $(INSTALL_LIBDIR)/stdlib__*.cmx and re-run make install"; \
+ exit 1; \
+ fi
+
+installopt-default::
$(INSTALL_DATA) \
stdlib.cmxa stdlib.$(A) std_exit.$(O) *.cmx \
"$(INSTALL_LIBDIR)"
# Again, pattern weirdness here means that the dot is always present so that
# tmpheader.exe matches.
tmpheader%exe: $(HEADERPROGRAM)%$(O)
- $(call MKEXE_BOOT,$@,$^ $(EXTRALIBS))
+ $(call MKEXE_USING_COMPILER,$@,$^ $(EXTRALIBS))
# FIXME This is wrong - mingw could invoke strip; MSVC equivalent?
ifneq "$(UNIX_OR_WIN32)" "win32"
strip $@
ifeq "$(UNIX_OR_WIN32)" "unix"
tmptargetcamlheader%exe: $(TARGETHEADERPROGRAM)%$(O)
- $(call MKEXE_BOOT,$@,$^ $(EXTRALIBS))
+ $(call MKEXE_USING_COMPILER,$@,$^ $(EXTRALIBS))
strip $@
$(TARGETHEADERPROGRAM)%$(O): $(HEADERPROGRAM).c
clean::
rm -f $(CAMLHEADERS)
-.SUFFIXES: .mli .ml .cmi .cmo .cmx
-
export AWK
%.cmi: %.mli
$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
-stdlib__%.cmi: %.mli
- $(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
+# The dependency on the .mli file is in .depend (since stdlib__Foo.cmi
+# depends on stdlib__foo.mli)
+stdlib__%.cmi:
+ $(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) \
+ -o $@ -c $(filter %.mli, $^)
%.cmo: %.ml
$(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -c $<
-stdlib__%.cmo: %.ml
- $(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) -o $@ -c $<
+# The dependency on the .ml file is in .depend (since stdlib__Foo.cmo
+# depends on stdlib__foo.ml)
+stdlib__%.cmo:
+ $(CAMLC) $(COMPFLAGS) $(shell ./Compflags $@) \
+ -o $@ -c $(filter %.ml, $^)
%.cmx: %.ml
$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) $(shell ./Compflags $@) -c $<
-stdlib__%.cmx: %.ml
+# The dependency on the .ml file is in .depend (since stdlib__Foo.cmx
+# depends on stdlib__foo.ml)
+stdlib__%.cmx:
$(CAMLOPT) $(COMPFLAGS) $(OPTCOMPFLAGS) $(shell ./Compflags $@) \
- -o $@ -c $<
+ -o $@ -c $(filter %.ml, $^)
# Dependencies on the compiler
-COMPILER_DEPS=$(filter-out -use-prims $(CAMLRUN), $(CAMLC))
+COMPILER_DEPS=$(filter-out -use-prims $(OCAMLRUN), $(CAMLC))
$(OBJS) std_exit.cmo: $(COMPILER_DEPS)
$(OBJS:.cmo=.cmi) std_exit.cmi: $(COMPILER_DEPS)
$(OBJS:.cmo=.cmx) std_exit.cmx: $(OPTCOMPILER)
clean::
rm -f *.cm* *.o *.obj *.a *.lib *.odoc
+ rm -rf flexdll
include .depend
-EMPTY :=
-SPACE := $(EMPTY) $(EMPTY)
+STDLIB_NAMESPACE_MODULES = $(subst $(SPACE),|,$(STDLIB_PREFIXED_MODULES))
.PHONY: depend
depend:
> .depend.tmp
$(CAMLDEP) $(DEPFLAGS) -pp "$(AWK) -f ./remove_module_aliases.awk" \
stdlib.ml stdlib.mli >> .depend.tmp
- sed -Ee \
- 's#(^| )(${subst ${SPACE},|,${UNPREFIXED_OBJS}})[.]#\1stdlib__\2.#g' \
+ sed -E \
+ -e 's/^(${STDLIB_NAMESPACE_MODULES})(\.[^i]*)(i?) :/\1\2\3 : \1.ml\3/' \
+ -e 's#(^| )(${STDLIB_NAMESPACE_MODULES})[.]#\1stdlib__\u\2.#' \
.depend.tmp > .depend
rm -f .depend.tmp
#* *
#**************************************************************************
-# This file lists all standard library modules.
-# It is used by:
+# This file should be included after Makefile.common
+
+# This file lists all standard library modules. It is used by:
# 1. stdlib/Makefile when building stdlib.cma
# 2. Makefile to expunge the toplevels
-# 3. ocamldoc/Makefile.docfiles to compute all documentation files
-# which need to be generated for the stdlib
+# 3. api_docgen/Makefile.docfiles to compute all documentation files which need
+# need to be generated for the stdlib
-# add stdlib__ as prefix to a module except for internal modules
-# and the stdlib module itself
-define add_stdlib_prefix
- $(or $(filter stdlib camlinternal%,$1), stdlib__$1)
-endef
+# Three variables are exported:
+# $(STDLIB_MODULE_BASENAMES) - basenames, in dependency order, of the modules in
+# the stdlib
+# $(STDLIB_PREFIXED_MODULES) - just the namespaced modules of
+# $(STDLIB_MODULE_BASENAMES), i.e. without camlinternal* and stdlib. Used in
+# stdlib/Makefile to munge the dependencies.
+# $(STDLIB_MODULES) - full list, in prefixed form as appropriate.
-# Modules should be listed in dependency order.
-STDLIB_MODS=\
+# Basenames of the source files for the standard library (i.e. unprefixed and
+# with lowercase first letters). These must be listed in dependency order.
+STDLIB_MODULE_BASENAMES = \
camlinternalFormatBasics camlinternalAtomic \
stdlib pervasives seq option either result bool char uchar \
- sys list bytes string unit marshal obj array float int int32 int64 nativeint \
+ sys list int bytes string unit marshal obj array float int32 int64 nativeint \
lexing parsing set map stack queue camlinternalLazy lazy stream buffer \
camlinternalFormat printf arg atomic \
printexc fun gc digest random hashtbl weak \
filename complex arrayLabels listLabels bytesLabels stringLabels moreLabels \
stdLabels bigarray
-STDLIB_MODULES=\
- $(foreach module, $(STDLIB_MODS), $(call add_stdlib_prefix,$(module)))
+STDLIB_PREFIXED_MODULES = \
+ $(filter-out stdlib camlinternal%, $(STDLIB_MODULE_BASENAMES))
+
+# The pattern FOO = $(eval FOO := $$(shell <cmd>)$(FOO) ensures that <cmd> is
+# executed either once or not at all, giving us GNU make's equivalent of a
+# string lazy_t.
+STDLIB_MODULES = \
+ $(eval STDLIB_MODULES := $$(shell \
+ $(SAK) add-stdlib-prefix $(STDLIB_MODULE_BASENAMES)))$(STDLIB_MODULES)
let max_arg_len cur (kwd, spec, doc) =
match spec with
- | Symbol _ -> max cur (String.length kwd)
- | _ -> max cur (String.length kwd + second_word doc)
+ | Symbol _ -> Int.max cur (String.length kwd)
+ | _ -> Int.max cur (String.length kwd + second_word doc)
let replace_leading_tab s =
ksd
| (kwd, (Symbol _ as spec), msg) ->
let cutcol = second_word msg in
- let spaces = String.make ((max 0 (len - cutcol)) + 3) ' ' in
+ let spaces = String.make ((Int.max 0 (len - cutcol)) + 3) ' ' in
(kwd, spec, "\n" ^ spaces ^ replace_leading_tab msg)
| (kwd, spec, msg) ->
let cutcol = second_word msg in
let align ?(limit=max_int) speclist =
let completed = add_help speclist in
let len = List.fold_left max_arg_len 0 completed in
- let len = min len limit in
+ let len = Int.min len limit in
List.map (add_padding len) completed
let trim_cr s =
done;
!r
+let fold_left_map f acc input_array =
+ let len = length input_array in
+ if len = 0 then (acc, [||]) else begin
+ let acc, elt = f acc (unsafe_get input_array 0) in
+ let output_array = create len elt in
+ let acc = ref acc in
+ for i = 1 to len - 1 do
+ let acc', elt = f !acc (unsafe_get input_array i) in
+ acc := acc';
+ unsafe_set output_array i elt;
+ done;
+ !acc, output_array
+ end
+
let fold_right f a x =
let r = ref x in
for i = length a - 1 downto 0 do
else loop (succ i) in
loop 0
+let find_opt p a =
+ let n = length a in
+ let rec loop i =
+ if i = n then None
+ else
+ let x = unsafe_get a i in
+ if p x then Some x
+ else loop (succ i)
+ in
+ loop 0
+
+let find_map f a =
+ let n = length a in
+ let rec loop i =
+ if i = n then None
+ else
+ match f (unsafe_get a i) with
+ | None -> loop (succ i)
+ | Some _ as r -> r
+ in
+ loop 0
+
+let split x =
+ if x = [||] then [||], [||]
+ else begin
+ let a0, b0 = unsafe_get x 0 in
+ let n = length x in
+ let a = create n a0 in
+ let b = create n b0 in
+ for i = 1 to n - 1 do
+ let ai, bi = unsafe_get x i in
+ unsafe_set a i ai;
+ unsafe_set b i bi
+ done;
+ a, b
+ end
+
+let combine a b =
+ let na = length a in
+ let nb = length b in
+ if na <> nb then invalid_arg "Array.combine";
+ if na = 0 then [||]
+ else begin
+ let x = create na (unsafe_get a 0, unsafe_get b 0) in
+ for i = 1 to na - 1 do
+ unsafe_set x i (unsafe_get a i, unsafe_get b i)
+ done;
+ x
+ end
+
exception Bottom of int
let sort cmp a =
let maxson l i =
[f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
+val fold_left_map :
+ ('a -> 'b -> 'a * 'c) -> 'a -> 'b array -> 'a * 'c array
+(** [fold_left_map] is a combination of {!fold_left} and {!map} that threads an
+ accumulator through calls to [f].
+ @since 4.13.0 *)
+
val fold_right : ('b -> 'a -> 'a) -> 'b array -> 'a -> 'a
(** [fold_right f a init] computes
[f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
instead of structural equality to compare list elements.
@since 4.03.0 *)
+val find_opt : ('a -> bool) -> 'a array -> 'a option
+(** [find_opt f a] returns the first element of the array [a] that satisfies
+ the predicate [f], or [None] if there is no value that satisfies [f] in the
+ array [a].
+
+ @since 4.13.0 *)
+
+val find_map : ('a -> 'b option) -> 'a array -> 'b option
+(** [find_map f a] applies [f] to the elements of [a] in order, and returns the
+ first result of the form [Some v], or [None] if none exist.
+
+ @since 4.13.0 *)
+
+(** {1 Arrays of pairs} *)
+
+val split : ('a * 'b) array -> 'a array * 'b array
+(** [split [|(a1,b1); ...; (an,bn)|]] is [([|a1; ...; an|], [|b1; ...; bn|])].
+
+ @since 4.13.0 *)
+
+val combine : 'a array -> 'b array -> ('a * 'b) array
+(** [combine [|a1; ...; an|] [|b1; ...; bn|]] is [[|(a1,b1); ...; (an,bn)|]].
+ Raise [Invalid_argument] if the two arrays have different lengths.
+
+ @since 4.13.0 *)
(** {1 Sorting} *)
faster on typical input. *)
-(** {1 Iterators} *)
+(** {1 Arrays and Sequences} *)
val to_seq : 'a array -> 'a Seq.t
(** Iterate on the array, in increasing order. Modifications of the
- array during iteration will be reflected in the iterator.
+ array during iteration will be reflected in the sequence.
@since 4.07 *)
val to_seqi : 'a array -> (int * 'a) Seq.t
(** Iterate on the array, in increasing order, yielding indices along elements.
Modifications of the array during iteration will be reflected in the
- iterator.
+ sequence.
@since 4.07 *)
val of_seq : 'a Seq.t -> 'a array
[f (... (f (f init a.(0)) a.(1)) ...) a.(n-1)],
where [n] is the length of the array [a]. *)
+val fold_left_map :
+ f:('a -> 'b -> 'a * 'c) -> init:'a -> 'b array -> 'a * 'c array
+(** [fold_left_map] is a combination of {!fold_left} and {!map} that threads an
+ accumulator through calls to [f].
+ @since 4.13.0 *)
+
val fold_right : f:('b -> 'a -> 'a) -> 'b array -> init:'a -> 'a
(** [fold_right ~f a ~init] computes
[f a.(0) (f a.(1) ( ... (f a.(n-1) init) ...))],
instead of structural equality to compare list elements.
@since 4.03.0 *)
+val find_opt : f:('a -> bool) -> 'a array -> 'a option
+(** [find_opt ~f a] returns the first element of the array [a] that satisfies
+ the predicate [f], or [None] if there is no value that satisfies [f] in the
+ array [a].
+
+ @since 4.13.0 *)
+
+val find_map : f:('a -> 'b option) -> 'a array -> 'b option
+(** [find_map ~f a] applies [f] to the elements of [a] in order, and returns the
+ first result of the form [Some v], or [None] if none exist.
+
+ @since 4.13.0 *)
+
+(** {1 Arrays of pairs} *)
+
+val split : ('a * 'b) array -> 'a array * 'b array
+(** [split [|(a1,b1); ...; (an,bn)|]] is [([|a1; ...; an|], [|b1; ...; bn|])].
+
+ @since 4.13.0 *)
+
+val combine : 'a array -> 'b array -> ('a * 'b) array
+(** [combine [|a1; ...; an|] [|b1; ...; bn|]] is [[|(a1,b1); ...; (an,bn)|]].
+ Raise [Invalid_argument] if the two arrays have different lengths.
+
+ @since 4.13.0 *)
(** {1 Sorting} *)
faster on typical input. *)
-(** {1 Iterators} *)
+(** {1 Arrays and Sequences} *)
val to_seq : 'a array -> 'a Seq.t
(** Iterate on the array, in increasing order. Modifications of the
- array during iteration will be reflected in the iterator.
+ array during iteration will be reflected in the sequence.
@since 4.07 *)
val to_seqi : 'a array -> (int * 'a) Seq.t
(** Iterate on the array, in increasing order, yielding indices along elements.
Modifications of the array during iteration will be reflected in the
- iterator.
+ sequence.
@since 4.07 *)
val of_seq : 'a Seq.t -> 'a array
val sub : t -> int -> int -> string
(** [Buffer.sub b off len] returns a copy of [len] bytes from the
current contents of the buffer [b], starting at offset [off].
- @raise Invalid_argument if [srcoff] and [len] do not designate a valid
+ @raise Invalid_argument if [off] and [len] do not designate a valid
range of [b]. *)
val blit : t -> int -> bytes -> int -> int -> unit
For long-lived buffers that may have grown a lot, [reset] allows
faster reclamation of the space used by the buffer. *)
+val output_buffer : out_channel -> t -> unit
+(** [output_buffer oc b] writes the current contents of buffer [b]
+ on the output channel [oc]. *)
+
+val truncate : t -> int -> unit
+(** [truncate b len] truncates the length of [b] to [len]
+ Note: the internal byte sequence is not shortened.
+ @raise Invalid_argument if [len < 0] or [len > length b].
+ @since 4.05.0 *)
+
+(** {1 Appending} *)
+
+(** Note: all [add_*] operations can raise [Failure] if the internal byte
+ sequence of the buffer would need to grow beyond {!Sys.max_string_length}.
+*)
+
val add_char : t -> char -> unit
(** [add_char b c] appends the character [c] at the end of buffer [b]. *)
val add_substring : t -> string -> int -> int -> unit
(** [add_substring b s ofs len] takes [len] characters from offset
- [ofs] in string [s] and appends them at the end of buffer [b]. *)
+ [ofs] in string [s] and appends them at the end of buffer [b].
+
+ @raise Invalid_argument if [ofs] and [len] do not designate a valid
+ range of [s]. *)
val add_subbytes : t -> bytes -> int -> int -> unit
(** [add_subbytes b s ofs len] takes [len] characters from offset
[ofs] in byte sequence [s] and appends them at the end of buffer [b].
+
+ @raise Invalid_argument if [ofs] and [len] do not designate a valid
+ range of [s].
+
@since 4.02 *)
val add_substitute : t -> (string -> string) -> string -> unit
input channel [ic] and stores them at the end of buffer [b].
@raise End_of_file if the channel contains fewer than [n]
characters. In this case, the characters are still added to
- the buffer, so as to avoid loss of data. *)
-
-val output_buffer : out_channel -> t -> unit
-(** [output_buffer oc b] writes the current contents of buffer [b]
- on the output channel [oc]. *)
+ the buffer, so as to avoid loss of data.
-val truncate : t -> int -> unit
-(** [truncate b len] truncates the length of [b] to [len]
- Note: the internal byte sequence is not shortened.
- @raise Invalid_argument if [len < 0] or [len > length b].
- @since 4.05.0 *)
+ @raise Invalid_argument if [len < 0] or [len > Sys.max_string_length].
+ *)
-(** {1 Iterators} *)
+(** {1 Buffers and Sequences} *)
val to_seq : t -> char Seq.t
(** Iterate on the buffer, in increasing order.
let len = length s ++ left ++ right in
let r = create len in
let (srcoff, dstoff) = if left < 0 then -left, 0 else 0, left in
- let cpylen = min (length s - srcoff) (len - dstoff) in
+ let cpylen = Int.min (length s - srcoff) (len - dstoff) in
if cpylen > 0 then unsafe_blit s srcoff r dstoff cpylen;
r
r
end
+let fold_left f x a =
+ let r = ref x in
+ for i = 0 to length a - 1 do
+ r := f !r (unsafe_get a i)
+ done;
+ !r
+
+let fold_right f a x =
+ let r = ref x in
+ for i = length a - 1 downto 0 do
+ r := f (unsafe_get a i) !r
+ done;
+ !r
+
+let exists p s =
+ let n = length s in
+ let rec loop i =
+ if i = n then false
+ else if p (unsafe_get s i) then true
+ else loop (succ i) in
+ loop 0
+
+let for_all p s =
+ let n = length s in
+ let rec loop i =
+ if i = n then true
+ else if p (unsafe_get s i) then loop (succ i)
+ else false in
+ loop 0
+
let uppercase_ascii s = map Char.uppercase_ascii s
let lowercase_ascii s = map Char.lowercase_ascii s
let capitalize_ascii s = apply1 Char.uppercase_ascii s
let uncapitalize_ascii s = apply1 Char.lowercase_ascii s
+(* duplicated in string.ml *)
+let starts_with ~prefix s =
+ let len_s = length s
+ and len_pre = length prefix in
+ let rec aux i =
+ if i = len_pre then true
+ else if unsafe_get s i <> unsafe_get prefix i then false
+ else aux (i + 1)
+ in len_s >= len_pre && aux 0
+
+(* duplicated in string.ml *)
+let ends_with ~suffix s =
+ let len_s = length s
+ and len_suf = length suffix in
+ let diff = len_s - len_suf in
+ let rec aux i =
+ if i = len_suf then true
+ else if unsafe_get s (diff + i) <> unsafe_get suffix i then false
+ else aux (i + 1)
+ in diff >= 0 && aux 0
+
(* duplicated in string.ml *)
let rec index_rec s lim i c =
if i >= lim then raise Not_found else
let compare (x: t) (y: t) = Stdlib.compare x y
external equal : t -> t -> bool = "caml_bytes_equal" [@@noalloc]
+(* duplicated in string.ml *)
+let split_on_char sep s =
+ let r = ref [] in
+ let j = ref (length s) in
+ for i = length s - 1 downto 0 do
+ if unsafe_get s i = sep then begin
+ r := sub s (i + 1) (!j - i - 1) :: !r;
+ j := i
+ end
+ done;
+ sub s 0 !j :: !r
+
(* Deprecated functions implemented via other deprecated functions *)
[@@@ocaml.warning "-3"]
let uppercase s = map Char.uppercase s
let buf = ref (make 256 '\000') in
let resize () =
(* resize *)
- let new_len = min (2 * length !buf) Sys.max_string_length in
+ let new_len = Int.min (2 * length !buf) Sys.max_string_length in
if length !buf = new_len then failwith "Bytes.of_seq: cannot grow bytes";
let new_buf = make new_len '\000' in
blit !buf 0 new_buf 0 !n;
(** {6 Binary encoding/decoding of integers} *)
+(* The get_ functions are all duplicated in string.ml *)
+
external get_uint8 : bytes -> int -> int = "%bytes_safe_get"
external get_uint16_ne : bytes -> int -> int = "%caml_bytes_get16"
external get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32"
index (in increasing index order) and stores the resulting bytes
in a new sequence that is returned as the result. *)
+val fold_left : ('a -> char -> 'a) -> 'a -> bytes -> 'a
+(** [fold_left f x s] computes
+ [f (... (f (f x (get s 0)) (get s 1)) ...) (get s (n-1))],
+ where [n] is the length of [s].
+ @since 4.13.0 *)
+
+val fold_right : (char -> 'a -> 'a) -> bytes -> 'a -> 'a
+(** [fold_right f s x] computes
+ [f (get s 0) (f (get s 1) ( ... (f (get s (n-1)) x) ...))],
+ where [n] is the length of [s].
+ @since 4.13.0 *)
+
+val for_all : (char -> bool) -> bytes -> bool
+(** [for_all p s] checks if all characters in [s] satisfy the predicate [p].
+ @since 4.13.0 *)
+
+val exists : (char -> bool) -> bytes -> bool
+(** [exists p s] checks if at least one character of [s] satisfies the predicate
+ [p].
+ @since 4.13.0 *)
+
val trim : bytes -> bytes
(** Return a copy of the argument, without leading and trailing
whitespace. The bytes regarded as whitespace are the ASCII
(** The equality function for byte sequences.
@since 4.03.0 (4.05.0 in BytesLabels) *)
+val starts_with :
+ prefix (* comment thwarts tools/sync_stdlib_docs *) :bytes -> bytes -> bool
+(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+ [prefix].
+
+ @since 4.13.0 *)
+
+val ends_with :
+ suffix (* comment thwarts tools/sync_stdlib_docs *) :bytes -> bytes -> bool
+(** [ends_with suffix s] is [true] if and only if [s] ends with [suffix].
+
+ @since 4.13.0 *)
+
(** {1:unsafe Unsafe conversions (for advanced users)}
This section describes unsafe, low-level conversion functions
*)
+val split_on_char: char -> bytes -> bytes list
+(** [split_on_char sep s] returns the list of all (possibly empty)
+ subsequences of [s] that are delimited by the [sep] character.
+
+ The function's output is specified by the following invariants:
+
+ - The list is not empty.
+ - Concatenating its elements using [sep] as a separator returns a
+ byte sequence equal to the input ([Bytes.concat (Bytes.make 1 sep)
+ (Bytes.split_on_char sep s) = s]).
+ - No byte sequence in the result contains the [sep] character.
+
+ @since 4.13.0
+*)
+
(** {1 Iterators} *)
val to_seq : t -> char Seq.t
(** Iterate on the string, in increasing index order. Modifications of the
- string during iteration will be reflected in the iterator.
+ string during iteration will be reflected in the sequence.
@since 4.07 *)
val to_seqi : t -> (int * char) Seq.t
index (in increasing index order) and stores the resulting bytes
in a new sequence that is returned as the result. *)
+val fold_left : f:('a -> char -> 'a) -> init:'a -> bytes -> 'a
+(** [fold_left f x s] computes
+ [f (... (f (f x (get s 0)) (get s 1)) ...) (get s (n-1))],
+ where [n] is the length of [s].
+ @since 4.13.0 *)
+
+val fold_right : f:(char -> 'a -> 'a) -> bytes -> init:'a -> 'a
+(** [fold_right f s x] computes
+ [f (get s 0) (f (get s 1) ( ... (f (get s (n-1)) x) ...))],
+ where [n] is the length of [s].
+ @since 4.13.0 *)
+
+val for_all : f:(char -> bool) -> bytes -> bool
+(** [for_all p s] checks if all characters in [s] satisfy the predicate [p].
+ @since 4.13.0 *)
+
+val exists : f:(char -> bool) -> bytes -> bool
+(** [exists p s] checks if at least one character of [s] satisfies the predicate
+ [p].
+ @since 4.13.0 *)
+
val trim : bytes -> bytes
(** Return a copy of the argument, without leading and trailing
whitespace. The bytes regarded as whitespace are the ASCII
(** The equality function for byte sequences.
@since 4.03.0 (4.05.0 in BytesLabels) *)
+val starts_with :
+ prefix (* comment thwarts tools/sync_stdlib_docs *) :bytes -> bytes -> bool
+(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+ [prefix].
+
+ @since 4.13.0 *)
+
+val ends_with :
+ suffix (* comment thwarts tools/sync_stdlib_docs *) :bytes -> bytes -> bool
+(** [ends_with suffix s] is [true] if and only if [s] ends with [suffix].
+
+ @since 4.13.0 *)
+
(** {1:unsafe Unsafe conversions (for advanced users)}
This section describes unsafe, low-level conversion functions
*)
+val split_on_char: sep:char -> bytes -> bytes list
+(** [split_on_char sep s] returns the list of all (possibly empty)
+ subsequences of [s] that are delimited by the [sep] character.
+
+ The function's output is specified by the following invariants:
+
+ - The list is not empty.
+ - Concatenating its elements using [sep] as a separator returns a
+ byte sequence equal to the input ([Bytes.concat (Bytes.make 1 sep)
+ (Bytes.split_on_char sep s) = s]).
+ - No byte sequence in the result contains the [sep] character.
+
+ @since 4.13.0
+*)
+
(** {1 Iterators} *)
val to_seq : t -> char Seq.t
(** Iterate on the string, in increasing index order. Modifications of the
- string during iteration will be reflected in the iterator.
+ string during iteration will be reflected in the sequence.
@since 4.07 *)
val to_seqi : t -> (int * char) Seq.t
let len = Bytes.length buf.bytes in
let min_len = buf.ind + overhead in
if min_len > len then (
- let new_len = max (len * 2) min_len in
+ let new_len = Int.max (len * 2) min_len in
let new_str = Bytes.create new_len in
Bytes.blit buf.bytes 0 new_str 0 len;
buf.bytes <- new_str;
(* *)
(**************************************************************************)
-external make_forward : Obj.t -> Obj.t -> unit = "caml_obj_make_forward"
-
type shape =
| Function
| Lazy
| Module of shape array
| Value of Obj.t
-let overwrite o n =
- assert (Obj.size o >= Obj.size n);
- for i = 0 to Obj.size n - 1 do
- Obj.set_field o i (Obj.field n i)
- done
+let rec init_mod_field modu i loc shape =
+ let init =
+ match shape with
+ | Function ->
+ let rec fn (x : 'a) =
+ let fn' : 'a -> 'b = Obj.obj (Obj.field modu i) in
+ if fn == fn' then
+ raise (Undefined_recursive_module loc)
+ else
+ fn' x in
+ Obj.repr fn
+ | Lazy ->
+ let rec l =
+ lazy (
+ let l' = Obj.obj (Obj.field modu i) in
+ if l == l' then
+ raise (Undefined_recursive_module loc)
+ else
+ Lazy.force l') in
+ Obj.repr l
+ | Class ->
+ Obj.repr (CamlinternalOO.dummy_class loc)
+ | Module comps ->
+ Obj.repr (init_mod_block loc comps)
+ | Value v -> v
+ in
+ Obj.set_field modu i init
-let overwrite_closure o n =
- (* We need to use the [raw_field] functions at least on the code
- pointer, which is not a valid value in -no-naked-pointers
- mode. *)
- assert (Obj.tag n = Obj.closure_tag);
- assert (Obj.size o >= Obj.size n);
- let n_start_env = Obj.Closure.((info n).start_env) in
- let o_start_env = Obj.Closure.((info o).start_env) in
- (* if the environment of n starts before the one of o,
- clear the raw fields in between. *)
- for i = n_start_env to o_start_env - 1 do
- Obj.set_raw_field o i Nativeint.one
- done;
- (* if the environment of o starts before the one of n,
- clear the environment fields in between. *)
- for i = o_start_env to n_start_env - 1 do
- Obj.set_field o i (Obj.repr ())
- done;
- for i = 0 to n_start_env - 1 do
- (* code pointers, closure info fields, infix headers *)
- Obj.set_raw_field o i (Obj.raw_field n i)
- done;
- for i = n_start_env to Obj.size n - 1 do
- (* environment fields *)
- Obj.set_field o i (Obj.field n i)
- done;
- for i = Obj.size n to Obj.size o - 1 do
- (* clear the leftover space *)
- Obj.set_field o i (Obj.repr ())
+and init_mod_block loc comps =
+ let length = Array.length comps in
+ let modu = Obj.new_block 0 length in
+ for i = 0 to length - 1 do
+ init_mod_field modu i loc comps.(i)
done;
- ()
+ modu
-let rec init_mod loc shape =
+let init_mod loc shape =
match shape with
- | Function ->
- (* Two code pointer words (curried and full application), arity
- and eight environment entries makes 11 words. *)
- let closure = Obj.new_block Obj.closure_tag 11 in
- let template =
- Obj.repr (fun _ -> raise (Undefined_recursive_module loc))
- in
- overwrite_closure closure template;
- closure
- | Lazy ->
- Obj.repr (lazy (raise (Undefined_recursive_module loc)))
- | Class ->
- Obj.repr (CamlinternalOO.dummy_class loc)
| Module comps ->
- Obj.repr (Array.map (init_mod loc) comps)
- | Value v ->
- v
+ Obj.repr (init_mod_block loc comps)
+ | _ -> failwith "CamlinternalMod.init_mod: not a module"
-let rec update_mod shape o n =
+let rec update_mod_field modu i shape n =
match shape with
- | Function ->
- (* In bytecode, the RESTART instruction checks the size of closures.
- Hence, the optimized case [overwrite o n] is valid only if [o] and
- [n] have the same size. (See PR#4008.)
- In native code, the size of closures does not matter, so overwriting
- is possible so long as the size of [n] is no greater than that of [o].
- *)
- if Obj.tag n = Obj.closure_tag
- && (Obj.size n = Obj.size o
- || (Sys.backend_type = Sys.Native
- && Obj.size n <= Obj.size o))
- then begin overwrite_closure o n end
- else overwrite_closure o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
- | Lazy ->
- if Obj.tag n = Obj.lazy_tag then
- Obj.set_field o 0 (Obj.field n 0)
- else if Obj.tag n = Obj.forward_tag then begin (* PR#4316 *)
- make_forward o (Obj.field n 0)
- end else begin
- (* forwarding pointer was shortcut by GC *)
- make_forward o n
- end
+ | Function | Lazy ->
+ Obj.set_field modu i n
+ | Value _ ->
+ () (* the value is already there *)
| Class ->
- assert (Obj.tag n = 0 && Obj.size n = 4);
- overwrite o n
+ assert (Obj.tag n = 0 && Obj.size n = 4);
+ let cl = Obj.field modu i in
+ for j = 0 to 3 do
+ Obj.set_field cl j (Obj.field n j)
+ done
+ | Module comps ->
+ update_mod_block comps (Obj.field modu i) n
+
+and update_mod_block comps o n =
+ assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
+ for i = 0 to Array.length comps - 1 do
+ update_mod_field o i comps.(i) (Obj.field n i)
+ done
+
+let update_mod shape o n =
+ match shape with
| Module comps ->
- assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
- for i = 0 to Array.length comps - 1 do
- update_mod comps.(i) (Obj.field o i) (Obj.field n i)
- done
- | Value _ -> () (* the value is already there *)
+ update_mod_block comps o n
+ | _ -> failwith "CamlinternalMod.update_mod: not a module"
(env_init (Obj.repr 0), class_init, env_init, Obj.repr 0)
type init_table = { mutable env_init: t; mutable class_init: table -> t }
+[@@warning "-unused-field"]
let make_class_store pub_meths class_init init_table =
let table = create_table pub_meths in
(preprocess
(per_module
((action
- (progn
- ; FIXME: remove after 4.12
- (run sed -i s/loc_FUNCTION/loc_POS/ %{input-file})
- (run awk -v dune_wrapped=true
- -f %{dep:expand_module_aliases.awk} %{input-file})))
+ (run awk -f %{dep:expand_module_aliases.awk} %{input-file}))
stdlib)
- (; FIXME: remove after 4.12 (this erases injectivity annotations)
- (action (run sed "s/\\!\\([-+]*'\\)/\\1/g" %{input-file}))
- atomic bigarray camlinternalAtomic camlinternalOO ephemeron hashtbl map
- moreLabels queue stack stream weak))))
+ )))
(rule
(targets sys.ml)
type 'a t =
{ mutable size: int; (* number of entries *)
mutable data: 'a bucketlist array; (* the buckets *)
- mutable seed: int; (* for randomization *)
+ seed: int; (* for randomization *)
initial_size: int; (* initial array size *)
}
let stats h =
let mbl =
- Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+ Array.fold_left (fun m b -> Int.max m (bucket_length 0 b)) 0 h.data in
let histo = Array.make (mbl + 1) 0 in
Array.iter
(fun b ->
let stats_alive h =
let size = ref 0 in
let mbl =
- Array.fold_left (fun m b -> max m (bucket_length_alive 0 b)) 0 h.data in
+ Array.fold_left
+ (fun m b -> Int.max m (bucket_length_alive 0 b)) 0 h.data
+ in
let histo = Array.make (mbl + 1) 0 in
Array.iter
(fun b ->
state=2;
else if ($1 == "module")
{ if (ocamldoc!="true") printf("\n(** @canonical %s *)", $2);
- first_letter=substr($4,1,1);
- if (dune_wrapped!="true")
- first_letter=tolower(first_letter);
- printf("\nmodule %s = Stdlib__%s%s\n", $2, first_letter, substr($4,2));
+ printf("\nmodule %s = Stdlib__%s\n", $2, $4);
}
else
print
&& (String.length n < 2 || String.sub n 0 2 <> "./")
&& (String.length n < 3 || String.sub n 0 3 <> "../")
let check_suffix name suff =
- String.length name >= String.length suff &&
- String.sub name (String.length name - String.length suff)
- (String.length suff) = suff
+ String.ends_with ~suffix:suff name
let chop_suffix_opt ~suffix filename =
let len_s = String.length suffix and len_f = String.length filename in
[@@unboxed] [@@noalloc]
external sqrt : float -> float = "caml_sqrt_float" "sqrt"
[@@unboxed] [@@noalloc]
+external cbrt : float -> float = "caml_cbrt_float" "caml_cbrt"
+ [@@unboxed] [@@noalloc]
external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
+external exp2 : float -> float = "caml_exp2_float" "caml_exp2"
+ [@@unboxed] [@@noalloc]
external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
external log10 : float -> float = "caml_log10_float" "log10"
[@@unboxed] [@@noalloc]
+external log2 : float -> float = "caml_log2_float" "caml_log2"
+ [@@unboxed] [@@noalloc]
external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
[@@unboxed] [@@noalloc]
external log1p : float -> float = "caml_log1p_float" "caml_log1p"
[@@unboxed] [@@noalloc]
external tanh : float -> float = "caml_tanh_float" "tanh"
[@@unboxed] [@@noalloc]
+external acosh : float -> float = "caml_acosh_float" "caml_acosh"
+ [@@unboxed] [@@noalloc]
+external asinh : float -> float = "caml_asinh_float" "caml_asinh"
+ [@@unboxed] [@@noalloc]
+external atanh : float -> float = "caml_atanh_float" "caml_atanh"
+ [@@unboxed] [@@noalloc]
+external erf : float -> float = "caml_erf_float" "caml_erf"
+ [@@unboxed] [@@noalloc]
+external erfc : float -> float = "caml_erfc_float" "caml_erfc"
+ [@@unboxed] [@@noalloc]
external trunc : float -> float = "caml_trunc_float" "caml_trunc"
[@@unboxed] [@@noalloc]
external round : float -> float = "caml_round_float" "caml_round"
(** [fma x y z] returns [x * y + z], with a best effort for computing
this expression with a single rounding, using either hardware
instructions (providing full IEEE compliance) or a software
- emulation. Note: since software emulation of the fma is costly,
- make sure that you are using hardware fma support if performance
- matters. @since 4.08.0 *)
+ emulation.
+
+ On 64-bit Cygwin, 64-bit mingw-w64 and MSVC 2017 and earlier, this function
+ may be emulated owing to known bugs on limitations on these platforms.
+ Note: since software emulation of the fma is costly, make sure that you are
+ using hardware fma support if performance matters.
+
+ @since 4.08.0 *)
external rem : float -> float -> float = "caml_fmod_float" "fmod"
[@@unboxed] [@@noalloc]
[@@unboxed] [@@noalloc]
(** Square root. *)
+external cbrt : float -> float = "caml_cbrt_float" "caml_cbrt"
+ [@@unboxed] [@@noalloc]
+(** Cube root.
+
+ @since 4.13.0
+*)
+
external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
(** Exponential. *)
+external exp2 : float -> float = "caml_exp2_float" "caml_exp2"
+ [@@unboxed] [@@noalloc]
+(** Base 2 exponential function.
+
+ @since 4.13.0
+*)
+
external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
(** Natural logarithm. *)
[@@unboxed] [@@noalloc]
(** Base 10 logarithm. *)
+external log2 : float -> float = "caml_log2_float" "caml_log2"
+ [@@unboxed] [@@noalloc]
+(** Base 2 logarithm.
+
+ @since 4.13.0
+*)
+
external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
[@@unboxed] [@@noalloc]
(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results
[@@unboxed] [@@noalloc]
(** Hyperbolic tangent. Argument is in radians. *)
+external acosh : float -> float = "caml_acosh_float" "caml_acosh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc cosine. The argument must fall within the range
+ [[1.0, inf]].
+ Result is in radians and is between [0.0] and [inf].
+
+ @since 4.13.0
+*)
+
+external asinh : float -> float = "caml_asinh_float" "caml_asinh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc sine. The argument and result range over the entire
+ real line.
+ Result is in radians.
+
+ @since 4.13.0
+*)
+
+external atanh : float -> float = "caml_atanh_float" "caml_atanh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc tangent. The argument must fall within the range
+ [[-1.0, 1.0]].
+ Result is in radians and ranges over the entire real line.
+
+ @since 4.13.0
+*)
+
+external erf : float -> float = "caml_erf_float" "caml_erf"
+ [@@unboxed] [@@noalloc]
+(** Error function. The argument ranges over the entire real line.
+ The result is always within [[-1.0, 1.0]].
+
+ @since 4.13.0
+*)
+
+external erfc : float -> float = "caml_erfc_float" "caml_erfc"
+ [@@unboxed] [@@noalloc]
+(** Complementary error function ([erfc x = 1 - erf x]).
+ The argument ranges over the entire real line.
+ The result is always within [[-1.0, 1.0]].
+
+ @since 4.13.0
+*)
+
external trunc : float -> float = "caml_trunc_float" "caml_trunc"
[@@unboxed] [@@noalloc]
(** [trunc x] rounds [x] to the nearest integer whose absolute value is
rounding direction. If [x] is an integer, [+0.], [-0.], [nan], or
infinite, [x] itself is returned.
+ On 64-bit mingw-w64, this function may be emulated owing to a bug in the
+ C runtime library (CRT) on this platform.
+
@since 4.08.0 *)
external ceil : float -> float = "caml_ceil_float" "ceil"
(** Same as {!sort} or {!stable_sort}, whichever is faster
on typical input. *)
- (** {2 Iterators} *)
+ (** {2 Float arrays and Sequences} *)
val to_seq : t -> float Seq.t
(** Iterate on the floatarray, in increasing order. Modifications of the
- floatarray during iteration will be reflected in the iterator. *)
+ floatarray during iteration will be reflected in the sequence. *)
val to_seqi : t -> (int * float) Seq.t
(** Iterate on the floatarray, in increasing order, yielding indices along
elements. Modifications of the floatarray during iteration will be
- reflected in the iterator. *)
+ reflected in the sequence. *)
val of_seq : float Seq.t -> t
(** Create an array from the generator. *)
(** Same as {!sort} or {!stable_sort}, whichever is faster
on typical input. *)
- (** {2 Iterators} *)
+ (** {2 Float arrays and Sequences} *)
val to_seq : t -> float Seq.t
(** Iterate on the floatarray, in increasing order. Modifications of the
- floatarray during iteration will be reflected in the iterator. *)
+ floatarray during iteration will be reflected in the sequence. *)
val to_seqi : t -> (int * float) Seq.t
(** Iterate on the floatarray, in increasing order, yielding indices along
elements. Modifications of the floatarray during iteration will be
- reflected in the iterator. *)
+ reflected in the sequence. *)
val of_seq : float Seq.t -> t
(** Create an array from the generator. *)
state.pp_is_new_line <- true;
let indent = state.pp_margin - width + offset in
(* Don't indent more than pp_max_indent. *)
- let real_indent = min state.pp_max_indent indent in
+ let real_indent = Int.min state.pp_max_indent indent in
state.pp_current_indent <- real_indent;
state.pp_space_left <- state.pp_margin - state.pp_current_indent;
pp_output_indent state state.pp_current_indent;
let pp_print_string state s =
pp_print_as state (String.length s) s
+let pp_print_bytes state s =
+ pp_print_as state (Bytes.length s) (Bytes.to_string s)
(* To format an integer. *)
let pp_print_int state i = pp_print_string state (Int.to_string i)
(* If possible maintain pp_min_space_left to its actual value,
if this leads to a too small max_indent, take half of the
new margin, if it is greater than 1. *)
- max (max (state.pp_margin - state.pp_min_space_left)
+ Int.max (Int.max (state.pp_margin - state.pp_min_space_left)
(state.pp_margin / 2)) 1 in
(* Rebuild invariants. *)
pp_set_max_indent state new_max_indent
and close_stag = pp_close_stag std_formatter
and print_as = pp_print_as std_formatter
and print_string = pp_print_string std_formatter
+and print_bytes = pp_print_bytes std_formatter
and print_int = pp_print_int std_formatter
and print_float = pp_print_float std_formatter
and print_char = pp_print_char std_formatter
| Ok v -> ok ppf v
| Error e -> error ppf e
+let pp_print_either ~left ~right ppf = function
+| Either.Left l -> left ppf l
+| Either.Right r -> right ppf r
+
(**************************************************************)
let compute_tag output tag_acc =
*)
(** {1 Introduction}
- For a gentle introduction to the basics of pretty-printing using
- [Format], read
- {{:http://caml.inria.fr/resources/doc/guides/format.en.html}
- http://caml.inria.fr/resources/doc/guides/format.en.html}.
You may consider this module as providing an extension to the
[printf] facility to provide automatic line splitting. The addition of
Format.print_string "TEXT";
]
leads to output [<>PRETTYTEXT].
-
*)
+(* A tutorial to the Format module is provided at {!Format_tutorial}. *)
+
+(** {1 Formatters} *)
+
type formatter
(** Abstract data corresponding to a pretty-printer (also called a
formatter) and all its machinery. See also {!section:formatter}. *)
val print_string : string -> unit
(** [pp_print_string ppf s] prints [s] in the current pretty-printing box. *)
+val pp_print_bytes : formatter -> bytes -> unit
+val print_bytes : bytes -> unit
+(** [pp_print_bytes ppf b] prints [b] in the current pretty-printing box.
+ @since 4.13.0
+*)
+
val pp_print_as : formatter -> int -> string -> unit
val print_as : int -> string -> unit
(** [pp_print_as ppf len s] prints [s] in the current pretty-printing box.
Semantic tag operations may be set on or off with {!set_tags}.
Tag-marking operations may be set on or off with {!set_mark_tags}.
Tag-printing operations may be set on or off with {!set_print_tags}.
+
+ @since 4.08.0
*)
type tag = string
(** [String_tag s] is a string tag [s]. String tags can be inserted either
by explicitly using the constructor [String_tag] or by using the dedicated
format syntax ["@{<s> ... @}"].
+
+ @since 4.08.0
*)
val pp_open_stag : formatter -> stag -> unit
The [print_open_stag] tag-printing function of the formatter is called with
[t] as argument; then the opening tag marker for [t], as given by
[mark_open_stag t], is written into the output device of the formatter.
+
+ @since 4.08.0
*)
val pp_close_stag : formatter -> unit -> unit
The closing tag marker, as given by [mark_close_stag t], is written into the
output device of the formatter; then the [print_close_stag] tag-printing
function of the formatter is called with [t] as argument.
+
+ @since 4.08.0
*)
val pp_set_tags : formatter -> bool -> unit
those markers as 0 length tokens in the output device of the formatter.
[print] versions are the 'tag-printing' functions that can perform
regular printing when a tag is closed or opened.
+
+ @since 4.08.0
*)
val pp_set_formatter_stag_functions :
The [print_] field of the record contains the tag-printing functions that
are called at tag opening and tag closing time, to output regular material
in the pretty-printer queue.
+
+ @since 4.08.0
*)
val pp_get_formatter_stag_functions :
formatter -> unit -> formatter_stag_functions
val get_formatter_stag_functions : unit -> formatter_stag_functions
(** Return the current semantic tag operation functions of the standard
- pretty-printer. *)
+ pretty-printer.
+
+ @since 4.08.0 *)
(** {1:formatter Defining formatters}
@since 4.08 *)
+val pp_print_either :
+ left:(formatter -> 'a -> unit) ->
+ right:(formatter -> 'b -> unit) -> formatter -> ('a, 'b) Either.t -> unit
+(** [pp_print_either ~left ~right ppf e] prints [e] on [ppf] using
+ [left] if [e] is [Either.Left _] and [right] if [e] is [Either.Right _].
+
+ @since 4.13 *)
+
(** {1:fpp Formatted pretty-printing} *)
(**
percentage of the memory used for live data.
The GC will work more (use more CPU time and collect
blocks more eagerly) if [space_overhead] is smaller.
- Default: 80. *)
+ Default: 120. *)
mutable verbose : int;
[@ocaml.deprecated_mutable "Use {(Gc.get()) with Gc.verbose = ...}"]
memory than both next-fit and first-fit.
(since OCaml 4.10)
- The current default is next-fit, as the best-fit policy is new
- and not yet widely tested. We expect best-fit to become the
- default in the future.
+ The default is best-fit.
On one example that was known to be bad for next-fit and first-fit,
next-fit takes 28s using 855Mio of memory,
first-fit takes 47s using 566Mio of memory,
best-fit takes 27s using 545Mio of memory.
- Note: When changing to a low-fragmentation policy, you may
- need to augment the [space_overhead] setting, for example
- using [100] instead of the default [80] which is tuned for
- next-fit. Indeed, the difference in fragmentation behavior
- means that different policies will have different proportion
- of "wasted space" for a given program. Less fragmentation
- means a smaller heap so, for the same amount of wasted space,
- a higher proportion of wasted space. This makes the GC work
- harder, unless you relax it by increasing [space_overhead].
+ Note: If you change to next-fit, you may need to reduce
+ the [space_overhead] setting, for example using [80] instead
+ of the default [120] which is tuned for best-fit. Otherwise,
+ your program will need more memory.
Note: changing the allocation policy at run-time forces
a heap compaction, which is a lengthy operation unless the
heap is small (e.g. at the start of the program).
- Default: 0.
+ Default: 2.
@since 3.11.0 *)
type ('a, 'b) t =
{ mutable size: int; (* number of entries *)
mutable data: ('a, 'b) bucketlist array; (* the buckets *)
- mutable seed: int; (* for randomization *)
+ seed: int; (* for randomization *)
mutable initial_size: int; (* initial array size *)
}
let stats h =
let mbl =
- Array.fold_left (fun m b -> max m (bucket_length 0 b)) 0 h.data in
+ Array.fold_left (fun m b -> Int.max m (bucket_length 0 b)) 0 h.data in
let histo = Array.make (mbl + 1) 0 in
Array.iter
(fun b ->
buckets by size.
@since 4.00.0 *)
-(** {1 Iterators} *)
+(** {1 Hash tables and Sequences} *)
val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
(** Iterate on the whole table. The order in which the bindings
external shift_right_logical : int -> int -> int = "%lsrint"
let equal : int -> int -> bool = ( = )
let compare : int -> int -> int = Stdlib.compare
+let min x y : t = if x <= y then x else y
+let max x y : t = if x >= y then x else y
external to_float : int -> float = "%floatofint"
external of_float : float -> int = "%intoffloat"
val compare : int -> int -> int
(** [compare x y] is {!Stdlib.compare}[ x y] but more efficient. *)
+val min : int -> int -> int
+(** Return the smaller of the two arguments.
+ @since 4.13.0
+*)
+
+val max : int -> int -> int
+(** Return the greater of the two arguments.
+ @since 4.13.0
+ *)
+
(** {1:convert Converting} *)
external to_float : int -> float = "%floatofint"
None
| 64 ->
(* So that it compiles in 32-bit *)
- let move = int_of_string "0x1_0000_0000" in
- fun n -> let i = to_int n in Some (if i < 0 then i + move else i)
+ let mask = 0xFFFF lsl 16 lor 0xFFFF in
+ fun n -> Some (to_int n land mask)
| _ ->
assert false
let unsigned_compare n m =
compare (sub n min_int) (sub m min_int)
+let min x y : t = if x <= y then x else y
+let max x y : t = if x >= y then x else y
+
(* Unsigned division from signed division of the same
bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
*)
(** The equal function for int32s.
@since 4.03.0 *)
+val min: t -> t -> t
+(** Return the smaller of the two arguments.
+ @since 4.13.0
+*)
+
+val max: t -> t -> t
+(** Return the greater of the two arguments.
+ @since 4.13.0
+ *)
+
+
(**/**)
(** {1 Deprecated functions} *)
let unsigned_compare n m =
compare (sub n min_int) (sub m min_int)
+let min x y : t = if x <= y then x else y
+let max x y : t = if x >= y then x else y
+
(* Unsigned division from signed division of the same
bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
*)
(** The equal function for int64s.
@since 4.03.0 *)
+val min: t -> t -> t
+(** Return the smaller of the two arguments.
+ @since 4.13.0
+*)
+
+val max: t -> t -> t
+(** Return the greater of the two arguments.
+ @since 4.13.0
+ *)
+
(**/**)
(** {1 Deprecated functions} *)
external force : 'a t -> 'a = "%lazy_force"
-(* let force = force *)
let force_val = CamlinternalLazy.force_val
Obj.set_field x 0 (Obj.repr f);
(Obj.obj x : 'arg t)
-
let from_val (v : 'arg) =
let t = Obj.tag (Obj.repr v) in
if t = Obj.forward_tag || t = Obj.lazy_tag || t = Obj.double_tag then begin
let lazy_from_val = from_val
let lazy_is_val = is_val
+
+
+let map f x =
+ lazy (f (force x))
+
+let map_val f x =
+ if is_val x
+ then lazy_from_val (f (force x))
+ else lazy (f (force x))
exception Undefined
-(* val force : 'a t -> 'a *)
external force : 'a t -> 'a = "%lazy_force"
(** [force x] forces the suspension [x] and returns its result.
If [x] has already been forced, [Lazy.force x] returns the
recursively.
*)
-val force_val : 'a t -> 'a
-(** [force_val x] forces the suspension [x] and returns its
- result. If [x] has already been forced, [force_val x]
- returns the same value again without recomputing it.
+(** {1 Iterators} *)
- If the computation of [x] raises an exception, it is unspecified
- whether [force_val x] raises the same exception or {!Undefined}.
- @raise Undefined if the forcing of [x] tries to force [x] itself
- recursively.
+val map : ('a -> 'b) -> 'a t -> 'b t
+(** [map f x] returns a suspension that, when forced,
+ forces [x] and applies [f] to its value.
+
+ It is equivalent to [lazy (f (Lazy.force x))].
+
+ @since 4.13.0
*)
+(** {1 Reasoning on already-forced suspensions} *)
+
+val is_val : 'a t -> bool
+(** [is_val x] returns [true] if [x] has already been forced and
+ did not raise an exception.
+ @since 4.00.0 *)
+
+val from_val : 'a -> 'a t
+(** [from_val v] evaluates [v] first (as any function would) and returns
+ an already-forced suspension of its result.
+ It is the same as [let x = v in lazy x], but uses dynamic tests
+ to optimize suspension creation in some cases.
+ @since 4.00.0 *)
+
+val map_val : ('a -> 'b) -> 'a t -> 'b t
+(** [map_val f x] applies [f] directly if [x] is already forced,
+ otherwise it behaves as [map f x].
+
+ When [x] is already forced, this behavior saves the construction of
+ a suspension, but on the other hand it performs more work eagerly
+ that may not be useful if you never force the function result.
+
+ If [f] raises an exception, it will be raised immediately when
+ [is_val x], or raised only when forcing the thunk otherwise.
+
+ If [map_val f x] does not raise an exception, then
+ [is_val (map_val f x)] is equal to [is_val x].
+
+ @since 4.13.0 *)
+
+
+(** {1 Advanced}
+
+ The following definitions are for advanced uses only; they require
+ familiary with the lazy compilation scheme to be used appropriately. *)
+
val from_fun : (unit -> 'a) -> 'a t
(** [from_fun f] is the same as [lazy (f ())] but slightly more efficient.
- [from_fun] should only be used if the function [f] is already defined.
+ It should only be used if the function [f] is already defined.
In particular it is always less efficient to write
[from_fun (fun () -> expr)] than [lazy expr].
@since 4.00.0 *)
-val from_val : 'a -> 'a t
-(** [from_val v] returns an already-forced suspension of [v].
- This is for special purposes only and should not be confused with
- [lazy (v)].
- @since 4.00.0 *)
+val force_val : 'a t -> 'a
+(** [force_val x] forces the suspension [x] and returns its
+ result. If [x] has already been forced, [force_val x]
+ returns the same value again without recomputing it.
-val is_val : 'a t -> bool
-(** [is_val x] returns [true] if [x] has already been forced and
- did not raise an exception.
- @since 4.00.0 *)
+ If the computation of [x] raises an exception, it is unspecified
+ whether [force_val x] raises the same exception or {!Undefined}.
+ @raise Undefined if the forcing of [x] tries to force [x] itself
+ recursively.
+*)
+
+
+(** {1 Deprecated} *)
val lazy_from_fun : (unit -> 'a) -> 'a t
[@@ocaml.deprecated "Use Lazy.from_fun instead."]
end;
result
-
let lex_refill read_fun aux_buffer lexbuf =
let read =
read_fun aux_buffer (Bytes.length aux_buffer) in
space since n <= String.length aux_buffer <= String.length buffer.
Watch out for string length overflow, though. *)
let newlen =
- min (2 * Bytes.length lexbuf.lex_buffer) Sys.max_string_length in
+ Int.min (2 * Bytes.length lexbuf.lex_buffer) Sys.max_string_length in
if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
then failwith "Lexing.lex_refill: cannot grow buffer";
let newbuf = Bytes.create newlen in
Not tail-recursive (sum of the lengths of the arguments).
*)
-(** {1 Iterators} *)
+(** {1 Lists and Sequences} *)
val to_seq : 'a list -> 'a Seq.t
(** Iterate on the list.
*)
val of_seq : 'a Seq.t -> 'a list
-(** Create a list from the iterator.
+(** Create a list from a sequence.
@since 4.07
*)
Not tail-recursive (sum of the lengths of the arguments).
*)
-(** {1 Iterators} *)
+(** {1 Lists and Sequences} *)
val to_seq : 'a list -> 'a Seq.t
(** Iterate on the list.
*)
val of_seq : 'a Seq.t -> 'a list
-(** Create a list from the iterator.
+(** Create a list from a sequence.
@since 4.07
*)
(** Same as {!S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
- (** {1 Iterators} *)
+ (** {1 Maps and Sequences} *)
val to_seq : 'a t -> (key * 'a) Seq.t
(** Iterate on the whole map, in ascending order of keys
when read back on a 32-bit platform. The [Mashal.Compat_32] flag
only matters when marshaling is performed on a 64-bit platform;
it has no effect if marshaling is performed on a 32-bit platform.
+ @raise Failure if [chan] is not in binary mode.
*)
external to_bytes :
one of the [Marshal.to_*] functions, and reconstructs and
returns the corresponding value.
- It raises [End_of_file] if the function has already reached the
- end of file when starting to read from the channel, and raises
- [Failure "input_value: truncated object"] if it reaches the end
- of file later during the unmarshalling. *)
+ @raise End_of_file if [chan] is already at the end of the file.
+
+ @raise Failure if the end of the file is reached during
+ unmarshalling itself or if [chan] is not in binary mode.*)
val from_bytes : bytes -> int -> 'a
(** [Marshal.from_bytes buff ofs] unmarshals a structured value
buckets by size.
@since 4.00.0 *)
- (** {1 Iterators} *)
+ (** {1 Hash tables and Sequences} *)
val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
(** Iterate on the whole table. The order in which the bindings
(** Same as {!S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
- (** {1 Iterators} *)
+ (** {1 Maps and Sequences} *)
val to_seq : 'a t -> (key * 'a) Seq.t
(** Iterate on the whole map, in ascending order of keys
let unsigned_compare n m =
compare (sub n min_int) (sub m min_int)
+let min x y : t = if x <= y then x else y
+let max x y : t = if x >= y then x else y
+
(* Unsigned division from signed division of the same
bitness. See Warren Jr., Henry S. (2013). Hacker's Delight (2 ed.), Sec 9-3.
*)
(** The equal function for native ints.
@since 4.03.0 *)
+val min: t -> t -> t
+(** Return the smaller of the two arguments.
+ @since 4.13.0
+*)
+
+val max: t -> t -> t
+(** Return the greater of the two arguments.
+ @since 4.13.0
+ *)
+
+
(**/**)
(** {1 Deprecated functions} *)
+++ /dev/null
-Precedence level and associativity of operators
-
-The following table lists the precedence level of all operator classes
-from the highest to the lowest precedence. A few other syntactic constructions
-are also listed as references.
-
-{%latex:
-%
-% Note: the tables below should be kept in sync with the one in
-% manual/manual/refman/expr.etex .
-%
-\begin{tabular}{cc}
-\hline
-Operator class & Associativity \\
-\hline
-$!\ldots$ $\tilde{}\ldots$ & -- \\
-$.\cdots()$ $.\cdots[]$ $.\cdots\\{\\}$ & -- \\
-\#\ldots & left \\
-function application & left \\
-- -. & -- \\
-$**\ldots$ lsl lsr asr & right \\
-$*\ldots$ /\ldots \%\ldots mod land lor lxor & left \\
-+\ldots -\ldots & left \\
-:: & right \\
-@\ldots \textasciicircum\ldots & right \\
-=\ldots <\ldots >\ldots |\ldots \&\ldots \$\ldots != & left \\
-\& \&\& & right \\
-or || & right \\
-, & -- \\
-<- := & right \\
-if & -- \\
-; & right \\
-\hline
-\end{tabular}
-%}
-
-{%html:
-<table align=center border=1>
-<thead><tr><th>Operator class</th><th>Associativity </th></tr></thead>
-<tr><td><code class=code>!… ~…</code> </td><td>–</td></tr>
-<tr><td><code class=code>.…() .…[] .…{} </code>
- </td><td>–</td></tr>
-<tr><td><code class=code>#…</code> </td><td> left </td></tr>
-<tr><td><code class=code>function application</code> </td><td> left </td></tr>
-<tr><td><code class=code>- -.</code> </td><td>–</td></tr>
-<tr><td><code class=code>**… lsl lsr asr </code></td><td> right </td></tr>
-<tr><td><code class=code>*… /… %… mod land lor lxor</code>
- </td><td> left </td></tr>
-<tr><td><code class=code>+… -…</code> </td><td> left </td></tr>
-<tr><td><code class=code>::</code> </td><td> right </td></tr>
-<tr><td><code class=code>@… ^… </td><td> right </td></tr>
-<tr><td><code class=code>=… <…
->… |… &… $… !=</code> </td><td> left </td></tr>
-<tr><td><code class=code>& &&</code> </td><td> right </td></tr>
-<tr><td><code class=code>or || </code> </td><td> right </td></tr>
-<tr><td><code class=code>,</code> </td><td>–</td></tr>
-<tr><td><code class=code><- :=</code> </td><td> right </td></tr>
-<tr><td><code class=code>if</code> </td><td>–</td></tr>
-<tr><td><code class=code>;</code> </td><td> right </td></tr>
-</table>
-%}
-
-{%man:
-.IP Associativity
-Operator class
-.IP -
-!.. ~..
-.IP -
-\&.() .[] .{}
-.IP left
-#..
-.IP left
-function application
-.IP -
-- -.
-.IP right
-**.. lsl lsr asr
-.IP left
-*.. /.. %.. mod land lor lxor
-.IP left
-+.. -..
-.IP right
-::
-.IP right
-@.. ^..
-.IP left
-=.. <.. >.. |.. &.. $.. !=
-.IP right
-& &&
-.IP right
-or ||
-.IP -
-,
-.IP right
-<- :=
-.IP -
-if
-.IP right
-;
-%}
mutable sp : int; (* Saved sp for parse_engine *)
mutable state : int; (* Saved state for parse_engine *)
mutable errflag : int } (* Saved error flag for parse_engine *)
+[@@warning "-unused-field"]
type parse_tables =
{ actions : (parser_env -> Obj.t) array;
@since 4.07 *)
val add_seq : 'a t -> 'a Seq.t -> unit
-(** Add the elements from the generator to the end of the queue
+(** Add the elements from a sequence to the end of the queue.
@since 4.07 *)
val of_seq : 'a Seq.t -> 'a t
-(** Create a queue from the generator
+(** Create a queue from a sequence.
@since 4.07 *)
s.st.(i) <- i;
done;
let accu = ref "x" in
- for i = 0 to 54 + max 55 l do
+ for i = 0 to 54 + Int.max 55 l do
let j = i mod 55 in
let k = i mod l in
accu := combine !accu seed.(k);
then invalid_arg "Random.int"
else intaux s bound
+ let rec int63aux s n =
+ let max_int_32 = (1 lsl 30) + 0x3FFFFFFF in (* 0x7FFFFFFF *)
+ let b1 = bits s in
+ let b2 = bits s in
+ let (r, max_int) =
+ if n <= max_int_32 then
+ (* 31 random bits on both 64-bit OCaml and JavaScript.
+ Use upper 15 bits of b1 and 16 bits of b2. *)
+ let bpos =
+ (((b2 land 0x3FFFC000) lsl 1) lor (b1 lsr 15))
+ in
+ (bpos, max_int_32)
+ else
+ let b3 = bits s in
+ (* 62 random bits on 64-bit OCaml; unreachable on JavaScript.
+ Use upper 20 bits of b1 and 21 bits of b2 and b3. *)
+ let bpos =
+ ((((b3 land 0x3FFFFE00) lsl 12) lor (b2 lsr 9)) lsl 20)
+ lor (b1 lsr 10)
+ in
+ (bpos, max_int)
+ in
+ let v = r mod n in
+ if r - v > max_int - n + 1 then int63aux s n else v
+
+ let full_int s bound =
+ if bound <= 0 then
+ invalid_arg "Random.full_int"
+ else if bound > 0x3FFFFFFF then
+ int63aux s bound
+ else
+ intaux s bound
+
let rec int32aux s n =
let b1 = Int32.of_int (bits s) in
let bits () = State.bits default
let int bound = State.int default bound
+let full_int bound = State.full_int default bound
let int32 bound = State.int32 default bound
let nativeint bound = State.nativeint default bound
let int64 bound = State.int64 default bound
and [bound] (exclusive). [bound] must be greater than 0 and less
than 2{^30}. *)
+val full_int : int -> int
+(** [Random.full_int bound] returns a random integer between 0 (inclusive)
+ and [bound] (exclusive). [bound] may be any positive integer.
+
+ If [bound] is less than 2{^30}, [Random.full_int bound] is equal to
+ {!Random.int}[ bound]. If [bound] is greater than 2{^30} (on 64-bit systems
+ or non-standard environments, such as JavaScript), [Random.full_int]
+ returns a value, where {!Random.int} raises {!Invalid_argument}.
+
+ @since 4.13.0 *)
+
val int32 : Int32.t -> Int32.t
(** [Random.int32 bound] returns a random integer between 0 (inclusive)
and [bound] (exclusive). [bound] must be greater than 0. *)
val bits : t -> int
val int : t -> int -> int
+ val full_int : t -> int -> int
val int32 : t -> Int32.t -> Int32.t
val nativeint : t -> Nativeint.t -> Nativeint.t
val int64 : t -> Int64.t -> Int64.t
mutable ic_char_count : int;
mutable ic_line_count : int;
mutable ic_token_count : int;
- mutable ic_get_next_char : unit -> char;
+ ic_get_next_char : unit -> char;
ic_token_buffer : Buffer.t;
ic_input_name : in_channel_name;
}
match c with
| '.' ->
let width = Scanning.store_char width ib c in
- let precision = min width precision in
+ let precision = Int.min width precision in
let width = width - (precision - scan_fractional_part precision ib) in
scan_exponent_part width ib, precision
| _ ->
match Scanning.peek_char ib with
| 'p' | 'P' -> width
| _ ->
- let precision = min width precision in
+ let precision = Int.min width precision in
width - (precision - scan_hexadecimal_int precision ib)
)
| _ -> width in
let width = Scanning.store_char width ib c in
(* The effective width available for scanning the fractional part is
the minimum of declared precision and width left. *)
- let precision = min width precision in
+ let precision = Int.min width precision in
(* After scanning the fractional part with [precision] provisional width,
[width_precision] is left. *)
let width_precision = scan_fractional_part precision ib in
match Scanning.peek_char ib with
| 'p' | 'P' -> width
| _ ->
- let precision = min width precision in
+ let precision = Int.min width precision in
width - (precision - scan_hexadecimal_int precision ib)
)
| 'p' | 'P' -> width
then Cons (x, filter f next)
else filter f next ()
-let rec flat_map f seq () = match seq () with
+let rec concat seq () = match seq () with
| Nil -> Nil
| Cons (x, next) ->
- flat_map_app f (f x) next ()
+ append x (concat next) ()
-(* this is [append seq (flat_map f tail)] *)
-and flat_map_app f seq tail () = match seq () with
- | Nil -> flat_map f tail ()
+let rec flat_map f seq () = match seq () with
+ | Nil -> Nil
| Cons (x, next) ->
- Cons (x, flat_map_app f next tail)
+ append (f x) (flat_map f next) ()
+
+let concat_map = flat_map
let fold_left f acc seq =
let rec aux f acc seq = match seq () with
(* *)
(**************************************************************************)
-(** Functional iterators.
+(** Sequences (functional iterators).
The type ['a Seq.t] is a {b delayed list}, i.e. a list where some
evaluation is needed to access the next element. This makes it possible
This transformation is lazy, it only applies when the result is
traversed. *)
+val concat : 'a t t -> 'a t
+(** concatenate a sequence of sequences.
+
+ @since 4.13
+ *)
+
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Map each element to a subsequence, then return each element of this
sub-sequence in turn.
This transformation is lazy, it only applies when the result is
traversed. *)
+val concat_map : ('a -> 'b t) -> 'a t -> 'b t
+(** Alias for {!flat_map}.
+
+ @since 4.13
+*)
+
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Traverse the sequence from left to right, combining each element with the
accumulator using the given function.
and [xn] the bottom element. The stack is unchanged.
@since 4.03 *)
-(** {1 Iterators} *)
+(** {1 Stacks and Sequences} *)
val to_seq : 'a t -> 'a Seq.t
(** Iterate on the stack, top to bottom.
@since 4.07 *)
val add_seq : 'a t -> 'a Seq.t -> unit
-(** Add the elements from the iterator on the top of the stack.
+(** Add the elements from the sequence on the top of the stack.
@since 4.07 *)
val of_seq : 'a Seq.t -> 'a t
-(** Create a stack from the iterator
+(** Create a stack from the sequence.
@since 4.07 *)
external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc]
external cosh : float -> float = "caml_cosh_float" "cosh"
[@@unboxed] [@@noalloc]
+external acosh : float -> float = "caml_acosh_float" "caml_acosh"
+ [@@unboxed] [@@noalloc]
external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
external log10 : float -> float = "caml_log10_float" "log10"
[@@unboxed] [@@noalloc]
external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
external sinh : float -> float = "caml_sinh_float" "sinh"
[@@unboxed] [@@noalloc]
+external asinh : float -> float = "caml_asinh_float" "caml_asinh"
+ [@@unboxed] [@@noalloc]
external sqrt : float -> float = "caml_sqrt_float" "sqrt"
[@@unboxed] [@@noalloc]
external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
external tanh : float -> float = "caml_tanh_float" "tanh"
[@@unboxed] [@@noalloc]
+external atanh : float -> float = "caml_atanh_float" "caml_atanh"
+ [@@unboxed] [@@noalloc]
external ceil : float -> float = "caml_ceil_float" "ceil"
[@@unboxed] [@@noalloc]
external floor : float -> float = "caml_floor_float" "floor"
[@@unboxed] [@@noalloc]
(** Hyperbolic tangent. Argument is in radians. *)
+external acosh : float -> float = "caml_acosh_float" "caml_acosh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc cosine. The argument must fall within the range
+ [[1.0, inf]].
+ Result is in radians and is between [0.0] and [inf].
+
+ @since 4.13.0
+*)
+
+external asinh : float -> float = "caml_asinh_float" "caml_asinh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc sine. The argument and result range over the entire
+ real line.
+ Result is in radians.
+
+ @since 4.13.0
+*)
+
+external atanh : float -> float = "caml_atanh_float" "caml_atanh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc tangent. The argument must fall within the range
+ [[-1.0, 1.0]].
+ Result is in radians and ranges over the entire real line.
+
+ @since 4.13.0
+*)
+
external ceil : float -> float = "caml_ceil_float" "ceil"
[@@unboxed] [@@noalloc]
(** Round above to an integer value.
val ( ^ ) : string -> string -> string
(** String concatenation.
Right-associative operator, see {!Ocaml_operators} for more information.
+
+ @raise Invalid_argument if the result is longer then
+ than {!Sys.max_string_length} bytes.
*)
(** {1 Character operations}
B.make n c |> bts
let init n f =
B.init n f |> bts
+let empty = ""
let copy s =
B.copy (bos s) |> bts
+let of_bytes = B.to_string
+let to_bytes = B.of_string
let sub s ofs len =
B.sub (bos s) ofs len |> bts
let fill =
(B.create (sum_lengths 0 seplen l))
0 sep seplen l
+let cat = ( ^ )
+
(* duplicated in bytes.ml *)
let iter f s =
for i = 0 to length s - 1 do f (unsafe_get s i) done
B.map f (bos s) |> bts
let mapi f s =
B.mapi f (bos s) |> bts
+let fold_right f x a =
+ B.fold_right f (bos x) a
+let fold_left f a x =
+ B.fold_left f a (bos x)
+let exists f s =
+ B.exists f (bos s)
+let for_all f s =
+ B.for_all f (bos s)
(* Beware: we cannot use B.trim or B.escape because they always make a
copy, but String.mli spells out some cases where we are not allowed
let uncapitalize_ascii s =
B.uncapitalize_ascii (bos s) |> bts
+(* duplicated in bytes.ml *)
+let starts_with ~prefix s =
+ let len_s = length s
+ and len_pre = length prefix in
+ let rec aux i =
+ if i = len_pre then true
+ else if unsafe_get s i <> unsafe_get prefix i then false
+ else aux (i + 1)
+ in len_s >= len_pre && aux 0
+
+(* duplicated in bytes.ml *)
+let ends_with ~suffix s =
+ let len_s = length s
+ and len_suf = length suffix in
+ let diff = len_s - len_suf in
+ let rec aux i =
+ if i = len_suf then true
+ else if unsafe_get s (diff + i) <> unsafe_get suffix i then false
+ else aux (i + 1)
+ in diff >= 0 && aux 0
+
+(* duplicated in bytes.ml *)
let split_on_char sep s =
let r = ref [] in
let j = ref (length s) in
let to_seqi s = bos s |> B.to_seqi
let of_seq g = B.of_seq g |> bts
+
+(** {6 Binary encoding/decoding of integers} *)
+
+external get_uint8 : string -> int -> int = "%string_safe_get"
+external get_uint16_ne : string -> int -> int = "%caml_string_get16"
+external get_int32_ne : string -> int -> int32 = "%caml_string_get32"
+external get_int64_ne : string -> int -> int64 = "%caml_string_get64"
+
+let get_int8 s i = B.get_int8 (bos s) i
+let get_uint16_le s i = B.get_uint16_le (bos s) i
+let get_uint16_be s i = B.get_uint16_be (bos s) i
+let get_int16_ne s i = B.get_int16_ne (bos s) i
+let get_int16_le s i = B.get_int16_le (bos s) i
+let get_int16_be s i = B.get_int16_be (bos s) i
+let get_int32_le s i = B.get_int32_le (bos s) i
+let get_int32_be s i = B.get_int32_be (bos s) i
+let get_int64_le s i = B.get_int64_le (bos s) i
+let get_int64_be s i = B.get_int64_be (bos s) i
@raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
@since 4.02.0 *)
+val empty : string
+(** The empty string.
+
+ @since 4.13.0
+*)
+
+val of_bytes : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+ sequence.
+
+ @since 4.13.0
+*)
+
+val to_bytes : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the given
+ string.
+
+ @since 4.13.0
+*)
+
external length : string -> int = "%string_length"
(** [length s] is the length (number of bytes/characters) of [s]. *)
@raise Invalid_argument if the result is longer than
{!Sys.max_string_length} bytes. *)
+val cat : string -> string -> string
+(** [cat s1 s2] concatenates s1 and s2 ([s1 ^ s2]).
+
+ @raise Invalid_argument if the result is longer then
+ than {!Sys.max_string_length} bytes.
+
+ @since 4.13.0
+*)
+
(** {1:predicates Predicates and comparisons} *)
val equal : t -> t -> bool
(** [compare s0 s1] sorts [s0] and [s1] in lexicographical order. [compare]
behaves like {!Stdlib.compare} on strings but may be more efficient. *)
+val starts_with :
+ prefix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
+(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+ [prefix].
+
+ @since 4.13.0 *)
+
+val ends_with :
+ suffix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
+(** [ends_with suffix s] is [true] if and only if [s] ends with [suffix].
+
+ @since 4.13.0 *)
+
val contains_from : string -> int -> char -> bool
(** [contains_from s start c] is [true] if and only if [c] appears in [s]
after position [start].
@since 4.02.0 *)
+val fold_left : ('a -> char -> 'a) -> 'a -> string -> 'a
+(** [fold_left f x s] computes [f (... (f (f x s.[0]) s.[1]) ...) s.[n-1]],
+ where [n] is the length of the string [s].
+ @since 4.13.0 *)
+
+val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a
+(** [fold_right f s x] computes [f s.[0] (f s.[1] ( ... (f s.[n-1] x) ...))],
+ where [n] is the length of the string [s].
+ @since 4.13.0 *)
+
+val for_all : (char -> bool) -> string -> bool
+(** [for_all p s] checks if all characters in [s] satisfy the predicate [p].
+ @since 4.13.0 *)
+
+val exists : (char -> bool) -> string -> bool
+(** [exists p s] checks if at least one character of [s] satisfies the predicate
+ [p].
+ @since 4.13.0 *)
+
val trim : string -> string
(** [trim s] is [s] without leading and trailing whitespace. Whitespace
characters are: [' '], ['\x0C'] (form feed), ['\n'], ['\r'], and ['\t'].
@since 4.05 *)
-(** {1:converting Converting} *)
+(** {1 Strings and Sequences} *)
val to_seq : t -> char Seq.t
(** [to_seq s] is a sequence made of the string's characters in
increasing order. In ["unsafe-string"] mode, modifications of the string
- during iteration will be reflected in the iterator.
+ during iteration will be reflected in the sequence.
@since 4.07 *)
@deprecated Functions operating on Latin-1 character set are deprecated. *)
+(** {1 Binary decoding of integers} *)
+
+(** The functions in this section binary decode integers from strings.
+
+ All following functions raise [Invalid_argument] if the characters
+ needed at index [i] to decode the integer are not available.
+
+ Little-endian (resp. big-endian) encoding means that least
+ (resp. most) significant bytes are stored first. Big-endian is
+ also known as network byte order. Native-endian encoding is
+ either little-endian or big-endian depending on {!Sys.big_endian}.
+
+ 32-bit and 64-bit integers are represented by the [int32] and
+ [int64] types, which can be interpreted either as signed or
+ unsigned numbers.
+
+ 8-bit and 16-bit integers are represented by the [int] type,
+ which has more bits than the binary encoding. These extra bits
+ are sign-extended (or zero-extended) for functions which decode 8-bit
+ or 16-bit integers and represented them with [int] values.
+*)
+
+val get_uint8 : string -> int -> int
+(** [get_uint8 b i] is [b]'s unsigned 8-bit integer starting at character
+ index [i].
+
+ @since 4.13.0
+*)
+
+val get_int8 : string -> int -> int
+(** [get_int8 b i] is [b]'s signed 8-bit integer starting at character
+ index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_ne : string -> int -> int
+(** [get_uint16_ne b i] is [b]'s native-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_be : string -> int -> int
+(** [get_uint16_be b i] is [b]'s big-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_le : string -> int -> int
+(** [get_uint16_le b i] is [b]'s little-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_ne : string -> int -> int
+(** [get_int16_ne b i] is [b]'s native-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_be : string -> int -> int
+(** [get_int16_be b i] is [b]'s big-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_le : string -> int -> int
+(** [get_int16_le b i] is [b]'s little-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_ne : string -> int -> int32
+(** [get_int32_ne b i] is [b]'s native-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_be : string -> int -> int32
+(** [get_int32_be b i] is [b]'s big-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_le : string -> int -> int32
+(** [get_int32_le b i] is [b]'s little-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_ne : string -> int -> int64
+(** [get_int64_ne b i] is [b]'s native-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_be : string -> int -> int64
+(** [get_int64_be b i] is [b]'s big-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_le : string -> int -> int64
+(** [get_int64_le b i] is [b]'s little-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
(**/**)
(* The following is for system use only. Do not call directly. *)
@raise Invalid_argument if [n < 0] or [n > ]{!Sys.max_string_length}.
@since 4.02.0 *)
+val empty : string
+(** The empty string.
+
+ @since 4.13.0
+*)
+
+val of_bytes : bytes -> string
+(** Return a new string that contains the same bytes as the given byte
+ sequence.
+
+ @since 4.13.0
+*)
+
+val to_bytes : string -> bytes
+(** Return a new byte sequence that contains the same bytes as the given
+ string.
+
+ @since 4.13.0
+*)
+
external length : string -> int = "%string_length"
(** [length s] is the length (number of bytes/characters) of [s]. *)
@raise Invalid_argument if the result is longer than
{!Sys.max_string_length} bytes. *)
+val cat : string -> string -> string
+(** [cat s1 s2] concatenates s1 and s2 ([s1 ^ s2]).
+
+ @raise Invalid_argument if the result is longer then
+ than {!Sys.max_string_length} bytes.
+
+ @since 4.13.0
+*)
+
(** {1:predicates Predicates and comparisons} *)
val equal : t -> t -> bool
(** [compare s0 s1] sorts [s0] and [s1] in lexicographical order. [compare]
behaves like {!Stdlib.compare} on strings but may be more efficient. *)
+val starts_with :
+ prefix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
+(** [starts_with ][~][prefix s] is [true] if and only if [s] starts with
+ [prefix].
+
+ @since 4.13.0 *)
+
+val ends_with :
+ suffix (* comment thwarts tools/sync_stdlib_docs *) :string -> string -> bool
+(** [ends_with ~suffix s] is [true] if and only if [s] ends with [suffix].
+
+ @since 4.13.0 *)
+
val contains_from : string -> int -> char -> bool
(** [contains_from s start c] is [true] if and only if [c] appears in [s]
after position [start].
@since 4.02.0 *)
+val fold_left : f:('a -> char -> 'a) -> init:'a -> string -> 'a
+(** [fold_left f x s] computes [f (... (f (f x s.[0]) s.[1]) ...) s.[n-1]],
+ where [n] is the length of the string [s].
+ @since 4.13.0 *)
+
+val fold_right : f:(char -> 'a -> 'a) -> string -> init:'a -> 'a
+(** [fold_right f s x] computes [f s.[0] (f s.[1] ( ... (f s.[n-1] x) ...))],
+ where [n] is the length of the string [s].
+ @since 4.13.0 *)
+
+val for_all : f:(char -> bool) -> string -> bool
+(** [for_all p s] checks if all characters in [s] satisfy the predicate [p].
+ @since 4.13.0 *)
+
+val exists : f:(char -> bool) -> string -> bool
+(** [exists p s] checks if at least one character of [s] satisfies the predicate
+ [p].
+ @since 4.13.0 *)
+
val trim : string -> string
(** [trim s] is [s] without leading and trailing whitespace. Whitespace
characters are: [' '], ['\x0C'] (form feed), ['\n'], ['\r'], and ['\t'].
@since 4.05 *)
-(** {1:converting Converting} *)
+(** {1 Strings and Sequences} *)
val to_seq : t -> char Seq.t
(** [to_seq s] is a sequence made of the string's characters in
increasing order. In ["unsafe-string"] mode, modifications of the string
- during iteration will be reflected in the iterator.
+ during iteration will be reflected in the sequence.
@since 4.07 *)
@deprecated Functions operating on Latin-1 character set are deprecated. *)
+(** {1 Binary decoding of integers} *)
+
+(** The functions in this section binary decode integers from strings.
+
+ All following functions raise [Invalid_argument] if the characters
+ needed at index [i] to decode the integer are not available.
+
+ Little-endian (resp. big-endian) encoding means that least
+ (resp. most) significant bytes are stored first. Big-endian is
+ also known as network byte order. Native-endian encoding is
+ either little-endian or big-endian depending on {!Sys.big_endian}.
+
+ 32-bit and 64-bit integers are represented by the [int32] and
+ [int64] types, which can be interpreted either as signed or
+ unsigned numbers.
+
+ 8-bit and 16-bit integers are represented by the [int] type,
+ which has more bits than the binary encoding. These extra bits
+ are sign-extended (or zero-extended) for functions which decode 8-bit
+ or 16-bit integers and represented them with [int] values.
+*)
+
+val get_uint8 : string -> int -> int
+(** [get_uint8 b i] is [b]'s unsigned 8-bit integer starting at character
+ index [i].
+
+ @since 4.13.0
+*)
+
+val get_int8 : string -> int -> int
+(** [get_int8 b i] is [b]'s signed 8-bit integer starting at character
+ index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_ne : string -> int -> int
+(** [get_uint16_ne b i] is [b]'s native-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_be : string -> int -> int
+(** [get_uint16_be b i] is [b]'s big-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_uint16_le : string -> int -> int
+(** [get_uint16_le b i] is [b]'s little-endian unsigned 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_ne : string -> int -> int
+(** [get_int16_ne b i] is [b]'s native-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_be : string -> int -> int
+(** [get_int16_be b i] is [b]'s big-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int16_le : string -> int -> int
+(** [get_int16_le b i] is [b]'s little-endian signed 16-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_ne : string -> int -> int32
+(** [get_int32_ne b i] is [b]'s native-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_be : string -> int -> int32
+(** [get_int32_be b i] is [b]'s big-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int32_le : string -> int -> int32
+(** [get_int32_le b i] is [b]'s little-endian 32-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_ne : string -> int -> int64
+(** [get_int64_ne b i] is [b]'s native-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_be : string -> int -> int64
+(** [get_int64_be b i] is [b]'s big-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
+val get_int64_le : string -> int -> int64
+(** [get_int64_le b i] is [b]'s little-endian 64-bit integer
+ starting at character index [i].
+
+ @since 4.13.0
+*)
+
(**/**)
(* The following is for system use only. Do not call directly. *)
(** [fma x y z] returns [x * y + z], with a best effort for computing
this expression with a single rounding, using either hardware
instructions (providing full IEEE compliance) or a software
- emulation. Note: since software emulation of the fma is costly,
- make sure that you are using hardware fma support if performance
- matters. @since 4.08.0 *)
+ emulation.
+
+ On 64-bit Cygwin, 64-bit mingw-w64 and MSVC 2017 and earlier, this function
+ may be emulated owing to known bugs on limitations on these platforms.
+ Note: since software emulation of the fma is costly, make sure that you are
+ using hardware fma support if performance matters.
+
+ @since 4.08.0 *)
external rem : float -> float -> float = "caml_fmod_float" "fmod"
[@@unboxed] [@@noalloc]
[@@unboxed] [@@noalloc]
(** Square root. *)
+external cbrt : float -> float = "caml_cbrt_float" "caml_cbrt"
+ [@@unboxed] [@@noalloc]
+(** Cube root.
+
+ @since 4.13.0
+*)
+
external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc]
(** Exponential. *)
+external exp2 : float -> float = "caml_exp2_float" "caml_exp2"
+ [@@unboxed] [@@noalloc]
+(** Base 2 exponential function.
+
+ @since 4.13.0
+*)
+
external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc]
(** Natural logarithm. *)
[@@unboxed] [@@noalloc]
(** Base 10 logarithm. *)
+external log2 : float -> float = "caml_log2_float" "caml_log2"
+ [@@unboxed] [@@noalloc]
+(** Base 2 logarithm.
+
+ @since 4.13.0
+*)
+
external expm1 : float -> float = "caml_expm1_float" "caml_expm1"
[@@unboxed] [@@noalloc]
(** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results
[@@unboxed] [@@noalloc]
(** Hyperbolic tangent. Argument is in radians. *)
+external acosh : float -> float = "caml_acosh_float" "caml_acosh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc cosine. The argument must fall within the range
+ [[1.0, inf]].
+ Result is in radians and is between [0.0] and [inf].
+
+ @since 4.13.0
+*)
+
+external asinh : float -> float = "caml_asinh_float" "caml_asinh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc sine. The argument and result range over the entire
+ real line.
+ Result is in radians.
+
+ @since 4.13.0
+*)
+
+external atanh : float -> float = "caml_atanh_float" "caml_atanh"
+ [@@unboxed] [@@noalloc]
+(** Hyperbolic arc tangent. The argument must fall within the range
+ [[-1.0, 1.0]].
+ Result is in radians and ranges over the entire real line.
+
+ @since 4.13.0
+*)
+
+external erf : float -> float = "caml_erf_float" "caml_erf"
+ [@@unboxed] [@@noalloc]
+(** Error function. The argument ranges over the entire real line.
+ The result is always within [[-1.0, 1.0]].
+
+ @since 4.13.0
+*)
+
+external erfc : float -> float = "caml_erfc_float" "caml_erfc"
+ [@@unboxed] [@@noalloc]
+(** Complementary error function ([erfc x = 1 - erf x]).
+ The argument ranges over the entire real line.
+ The result is always within [[-1.0, 1.0]].
+
+ @since 4.13.0
+*)
+
external trunc : float -> float = "caml_trunc_float" "caml_trunc"
[@@unboxed] [@@noalloc]
(** [trunc x] rounds [x] to the nearest integer whose absolute value is
rounding direction. If [x] is an integer, [+0.], [-0.], [nan], or
infinite, [x] itself is returned.
+ On 64-bit mingw-w64, this function may be emulated owing to a bug in the
+ C runtime library (CRT) on this platform.
+
@since 4.08.0 *)
external ceil : float -> float = "caml_ceil_float" "ceil"
(** Same as {!sort} or {!stable_sort}, whichever is faster
on typical input. *)
-(** {2 Iterators} *)
+(** {2 Float arrays and Sequences} *)
val to_seq : t -> float Seq.t
(** Iterate on the floatarray, in increasing order. Modifications of the
- floatarray during iteration will be reflected in the iterator. *)
+ floatarray during iteration will be reflected in the sequence. *)
val to_seqi : t -> (int * float) Seq.t
(** Iterate on the floatarray, in increasing order, yielding indices along
elements. Modifications of the floatarray during iteration will be
- reflected in the iterator. *)
+ reflected in the sequence. *)
val of_seq : float Seq.t -> t
(** Create an array from the generator. *)
buckets by size.
@since 4.00.0 *)
-(** {1 Iterators} *)
+(** {1 Hash tables and Sequences} *)
val to_seq : ('a,'b) t -> ('a * 'b) Seq.t
(** Iterate on the whole table. The order in which the bindings
(** Same as {!S.map}, but the function receives as arguments both the
key and the associated value for each binding of the map. *)
- (** {1 Iterators} *)
+ (** {1 Maps and Sequences} *)
val to_seq : 'a t -> (key * 'a) Seq.t
(** Iterate on the whole map, in ascending order of keys
Array.fold_right (count_bucket 0) t.table 0
- let next_sz n = min (3 * n / 2 + 3) Sys.max_array_length
+ let next_sz n = Int.min (3 * n / 2 + 3) Sys.max_array_length
let prev_sz n = ((n - 3) * 2 + 2) / 3
let test_shrink_bucket t =
let rec loop i =
if i >= sz then begin
let newsz =
- min (3 * sz / 2 + 3) (Sys.max_array_length - additional_values)
+ Int.min (3 * sz / 2 + 3) (Sys.max_array_length - additional_values)
in
if newsz <= sz then failwith "Weak.Make: hash bucket cannot grow more";
let newbucket = weak_create newsz in
BASEDIR := $(shell pwd)
FIND=find
-TOPDIR := ..
-include $(TOPDIR)/Makefile.tools
+ROOTDIR = ..
+include $(ROOTDIR)/Makefile.common
-OCAMLTESTDIR_CYGPATH=$(shell $(CYGPATH) $(BASEDIR)/$(DIR)/_ocamltest)
+BASEDIR_HOST := $(shell $(CYGPATH) "$(BASEDIR)")
+ROOTDIR_HOST := $(BASEDIR_HOST)/$(ROOTDIR)
+
+OCAMLTESTDIR = $(BASEDIR_HOST)/$(DIR)/_ocamltest
failstamp := failure.stamp
else # Non-cygwin Unix
find := find
endif
- FLEXLINK_ENV =
else # Windows
find := /usr/bin/find
- FLEXDLL_SUBMODULE_PRESENT := $(wildcard ../flexdll/Makefile)
- ifeq "$(FLEXDLL_SUBMODULE_PRESENT)" ""
- FLEXLINK_ENV =
- else
- ROOT := $(shell cd .. && pwd| cygpath -m -f -)
- FLEXLINK_ENV = \
- OCAML_FLEXLINK="$(ROOT)/boot/ocamlrun $(ROOT)/flexdll/flexlink.exe"
- endif
endif
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+ FLEXLINK_ENV =
+else
+ # The testsuite needs an absolute path to the runtime, so override the
+ # definition in Makefile.common
+ FLEXLINK_DLL_LDFLAGS=$(if $(OC_DLL_LDFLAGS), -link "$(OC_DLL_LDFLAGS)")
+ FLEXLINK_EXE_LDFLAGS=$(if $(OC_LDFLAGS), -link "$(OC_LDFLAGS)")
+ifeq "$(wildcard $(ROOTDIR_HOST)/flexlink.opt$(EXE))" ""
+ FLEXLINK_ENV = \
+ OCAML_FLEXLINK="$(ROOTDIR_HOST)/boot/ocamlrun$(EXE) \
+ $(ROOTDIR_HOST)/boot/flexlink.byte$(EXE)"
+ MKDLL=$(ROOTDIR_HOST)/boot/ocamlrun$(EXE) \
+ $(ROOTDIR_HOST)/boot/flexlink.byte$(EXE) \
+ $(FLEXLINK_FLAGS) $(FLEXLINK_DLL_LDFLAGS)
+ MKEXE=$(ROOTDIR_HOST)/boot/ocamlrun$(EXE) \
+ $(ROOTDIR_HOST)/boot/flexlink.byte$(EXE) \
+ $(FLEXLINK_FLAGS) -exe $(FLEXLINK_EXE_LDFLAGS)
+else
+ FLEXLINK_ENV = \
+ OCAML_FLEXLINK="$(ROOTDIR_HOST)/flexlink.opt$(EXE) \
+ -I $(ROOTDIR_HOST)/stdlib/flexdll"
+ MKDLL=$(ROOTDIR_HOST)/flexlink.opt$(EXE) -I $(ROOTDIR_HOST)/stdlib/flexdll \
+ $(FLEXLINK_FLAGS) $(FLEXLINK_DLL_LDFLAGS)
+ MKEXE=$(ROOTDIR_HOST)/flexlink.opt$(EXE) -I $(ROOTDIR_HOST)/stdlib/flexdll \
+ $(FLEXLINK_FLAGS) -exe $(FLEXLINK_EXE_LDFLAGS)
+endif # ifeq "$(wildcard $(ROOTDIR_HOST)/flexlink.opt$(EXE))" ""
+endif # ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
+
ifeq "$(ocamltest_program)" ""
ocamltest = $(error ocamltest not found in $(ocamltest_directory))
else
- ifeq "$(FLEXLINK_ENV)" ""
- ocamltest := MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) $(ocamltest_program)
- else
- FLEXLINK_DLL_LDFLAGS=$(if $(OC_DLL_LDFLAGS), -link "$(OC_DLL_LDFLAGS)")
- MKDLL=$(WINTOPDIR)/boot/ocamlrun $(WINTOPDIR)/flexdll/flexlink.exe \
- $(FLEXLINK_FLAGS) $(FLEXLINK_DLL_LDFLAGS)
-
- ocamltest := $(FLEXLINK_ENV) MKDLL="$(MKDLL)" SORT=$(SORT) MAKE=$(MAKE) \
- $(ocamltest_program)
- endif
+ ocamltest := $(FLEXLINK_ENV) MKEXE="$(MKEXE)" MKDLL="$(MKDLL)" SORT=$(SORT) \
+ MAKE=$(MAKE) $(ocamltest_program)
endif
# PROMOTE is only meant to be used internally in recursive calls;
OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG := -keep-test-dir-on-success
endif
+TIMEOUT ?= 600 # 10 minutes
+
OCAMLTESTFLAGS := \
+ -timeout $(TIMEOUT) \
$(OCAMLTEST_PROMOTE_FLAG) \
$(OCAMLTEST_KEEP_TEST_DIR_ON_SUCCESS_FLAG)
+# Make sure USE_RUNTIME is defined
+USE_RUNTIME ?=
+
+ifneq ($(USE_RUNTIME),)
+# Check USE_RUNTIME value
+ifeq ($(findstring $(USE_RUNTIME),d i),)
+$(error If set, USE_RUNTIME must be equal to "d" (debug runtime) \
+ or "i" (instrumented runtime))
+endif
+# When using the debug or instrumented runtime,
+# set the runtime's verbosity to 0 by default
+export OCAMLRUNPARAM?=v=0
+endif
+
.PHONY: default
default:
@echo "Available targets:"
.PHONY: all
all:
- @rm -f $(TESTLOG)
@$(MAKE) --no-print-directory new-without-report
@$(MAKE) --no-print-directory report
echo Running tests from \'$$dir\' ... ; \
$(MAKE) exec-ocamltest DIR=$$dir \
OCAMLTESTENV=""; \
- done || echo outer loop >> $(failstamp)) 2>&1 | tee -a $(TESTLOG)
+ done || echo outer loop >> $(failstamp)) 2>&1 | tee $(TESTLOG)
@$(MAKE) check-failstamp
.PHONY: check-failstamp
echo "File '$(LIST)' does not exist."; exit 1; \
fi
@if [ -n '$(DIR)' ] ; then \
- $(MAKE) --no-print-directory exec-one DIR=$(DIR); fi
+ $(MAKE) --no-print-directory exec-one DIR=$(DIR) \
+ 2>&1 | tee $(TESTLOG).one ; \
+ fi
@if [ -n '$(TEST)' ] ; then \
- TERM=dumb $(OCAMLTESTENV) $(ocamltest) $(OCAMLTESTFLAGS) $(TEST); fi
- @$(MAKE) check-failstamp
+ TERM=dumb $(OCAMLTESTENV) $(ocamltest) $(OCAMLTESTFLAGS) $(TEST) \
+ 2>&1 | tee $(TESTLOG).one; fi
@if [ -n '$(LIST)' ] ; then \
while IFS='' read -r LINE; do \
$(MAKE) --no-print-directory exec-one DIR=$$LINE ; \
- done < $$LIST 2>&1 | tee $(TESTLOG) ; \
- $(MAKE) report ; fi
+ done < $$LIST 2>&1 | tee $(TESTLOG).one ; \
+ fi
+ @$(MAKE) check-failstamp
+ @$(MAKE) TESTLOG=$(TESTLOG).one report
.PHONY: exec-one
exec-one:
@if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
echo "Running tests from '$$DIR' ..."; \
$(MAKE) exec-ocamltest DIR=$(DIR) \
- OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)"; \
+ OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR)"; \
else \
for dir in $(DIR)/*; do \
if [ -d $$dir ]; then \
fi
@if $(ocamltest) -list-tests $(DIR) >/dev/null 2>&1; then \
$(MAKE) exec-ocamltest DIR=$(DIR) \
- OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR_CYGPATH)" \
+ OCAMLTESTENV="OCAMLTESTDIR=$(OCAMLTESTDIR)" \
PROMOTE="true"; \
else \
cd $(DIR) && $(MAKE) TERM=dumb BASEDIR=$(BASEDIR) promote; \
.NOTPARALLEL:
-TOPDIR = ../..
+ROOTDIR = ../..
COMPFLAGS ?=
RUNTIME_VARIANT ?=
-include $(TOPDIR)/Makefile.tools
+include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC ?= $(BEST_OCAMLC) $(STDLIBFLAGS)
+OCAMLOPT ?= $(BEST_OCAMLOPT) $(STDLIBFLAGS)
libraries := testing.cmi testing.cma lib.cmo
* native-compiler
** script
script = "sh ${test_source_directory}/has-afl-showmap.sh"
- files = "harness.ml test.ml"
+ readonly_files = "harness.ml test.ml"
*** setup-ocamlopt.byte-build-env
**** ocamlopt.byte
module = "test.ml"
--- /dev/null
+#define CAML_NAME_SPACE
+#define CAML_INTERNALS
+
+#include <caml/domain_state.h>
+#include <caml/signals.h>
+
+CAMLprim value request_minor_gc(value v) {
+ Caml_state->requested_minor_gc = 1;
+ Caml_state->requested_major_slice = 1;
+ caml_something_to_do = 1;
+ Caml_state->young_limit = Caml_state->young_alloc_end;
+
+ return Val_unit;
+}
+
+CAMLprim value minor_gcs(value v) {
+ return Val_long(Caml_state->stat_minor_collections);
+}
--- /dev/null
+(* TEST
+ modules = "polling.c"
+ compare_programs = "false"
+ * arch64
+ ** native
+*)
+
+(* This set of tests examine poll insertion behaviour. We do this by requesting
+ and checking the number of minor collections at various points to determine
+ whether a poll was correctly added. There are some subtleties because
+ [caml_empty_minor_heap] will not increment the minor_collections stat if
+ nothing has been allocated on the minor heap, so we sometimes need to
+ add an allocation before we call [request_minor_gc]. The [minor_gcs]
+ function returns the number of minor collections so far without allocating.
+
+ ignore(Sys.opaque_identity(ref 41)) is used wherever we want to do an
+ allocation in order to use some minor heap so the minor collections stat is
+ incremented.
+
+ ignore(Sys.opaque_identity(ref 42)) is used wherever we want an allocation
+ for the purposes of testing whether a poll would be elided or not.
+*)
+
+external request_minor_gc : unit -> unit = "request_minor_gc"
+external minor_gcs : unit -> int = "minor_gcs"
+
+(* This function tests that polls are added to loops *)
+let polls_added_to_loops () =
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ for a = 0 to 1 do
+ ignore (Sys.opaque_identity 42)
+ done;
+ let minors_now = minor_gcs () in
+ assert (minors_before < minors_now)
+
+
+(* This function should have no prologue poll but will have
+ one in the loop. *)
+let func_with_added_poll_because_loop () =
+ (* We do two loop iterations so that the poll is triggered whether
+ in poll-at-top or poll-at-bottom mode. *)
+ for a = 0 to Sys.opaque_identity(1) do
+ ignore (Sys.opaque_identity 42)
+ done
+ [@@inline never]
+
+let func_with_no_prologue_poll () =
+ (* this function does not have indirect or 'forward' tail call nor
+ does it call a synthesised function with suppressed polls. *)
+ ignore(Sys.opaque_identity(minor_gcs ()))
+ [@@inline never]
+
+let prologue_polls_in_functions () =
+ ignore(Sys.opaque_identity(ref 41));
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ func_with_added_poll_because_loop ();
+ let minors_now = minor_gcs () in
+ assert (minors_before < minors_now);
+
+ ignore(Sys.opaque_identity(ref 41));
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ func_with_no_prologue_poll ();
+ let minors_now = minor_gcs () in
+ assert (minors_before = minors_now)
+
+(* These next functions test that polls are not added to functions that
+ unconditionally allocate.
+ [allocating_func] allocates unconditionally
+ [allocating_func_if] allocates unconditionally but does so
+ on two separate branches *)
+let allocating_func minors_before =
+ let minors_now = minor_gcs () in
+ assert (minors_before = minors_now);
+ (* No poll yet *)
+ ignore (Sys.opaque_identity (ref 42));
+ let minors_now2 = minor_gcs () in
+ assert (minors_before + 1 = minors_now2);
+ (* Polled at alloc *)
+ [@@inline never]
+
+let allocating_func_if minors_before =
+ let minors_now = minor_gcs () in
+ assert (minors_before = minors_now);
+ (* No poll yet *)
+ if minors_before > 0 then ignore (Sys.opaque_identity (ref 42))
+ else ignore (Sys.opaque_identity (ref 42));
+ let minors_now2 = minor_gcs () in
+ assert (minors_before + 1 = minors_now2);
+ (* Polled at alloc *)
+ [@@inline never]
+
+let allocating_func_nested_ifs minors_before =
+ let minors_now = minor_gcs () in
+ assert (minors_before = minors_now);
+ (* No poll yet *)
+ if Sys.opaque_identity(minors_before) > 0 then
+ if Sys.opaque_identity(minors_before) > 1 then
+ ignore (Sys.opaque_identity (ref 42))
+ else
+ ignore (Sys.opaque_identity (ref 42))
+ else
+ if Sys.opaque_identity(minors_before) < 5 then
+ ignore (Sys.opaque_identity (ref 42))
+ else
+ ignore (Sys.opaque_identity (ref 42));
+ let minors_now2 = minor_gcs () in
+ assert (minors_before + 1 = minors_now2);
+ (* Polled at alloc *)
+ [@@inline never]
+
+let allocating_func_match minors_before =
+ let minors_now = minor_gcs () in
+ assert (minors_before = minors_now);
+ (* No poll yet *)
+ match minors_before with
+ | 0 -> ignore (Sys.opaque_identity (ref 42))
+ | _ -> ignore (Sys.opaque_identity (ref 42));
+ let minors_now2 = minor_gcs () in
+ assert (minors_before + 1 = minors_now2);
+ (* Polled at alloc *)
+ [@@inline never]
+
+let polls_not_added_unconditionally_allocating_functions () =
+ let minors_before = minor_gcs () in
+ ignore(Sys.opaque_identity(ref 41));
+ request_minor_gc ();
+ allocating_func minors_before;
+ let minors_before = minor_gcs () in
+ ignore(Sys.opaque_identity(ref 41));
+ request_minor_gc ();
+ allocating_func_if minors_before;
+ let minors_before = minor_gcs () in
+ ignore(Sys.opaque_identity(ref 41));
+ request_minor_gc ();
+ allocating_func_nested_ifs minors_before;
+ let minors_before = minor_gcs () in
+ ignore(Sys.opaque_identity(ref 41));
+ request_minor_gc ();
+ allocating_func_match minors_before
+
+(* This function tests that polls are not added to the back edge of
+ where loop bodies allocat unconditionally *)
+let polls_not_added_to_allocating_loops () =
+ let current_minors = ref (minor_gcs ()) in
+ request_minor_gc ();
+ for a = 0 to 1 do
+ (* Since the loop body allocates there should be no poll points *)
+ let minors_now = minor_gcs () in
+ assert(minors_now = !current_minors);
+ ignore(Sys.opaque_identity(ref 42));
+ let minors_now2 = minor_gcs () in
+ assert(minors_now+1 = minors_now2);
+ current_minors := minors_now2;
+ ignore(Sys.opaque_identity(ref 41));
+ request_minor_gc ()
+ done
+
+(* this next set of functions tests that self tail recursive functions
+ have polls added correctly *)
+let rec self_rec_func n =
+ match n with
+ | 0 -> 0
+ | _ ->
+ begin
+ let n1 = Sys.opaque_identity(n-1) in
+ (self_rec_func[@tailcall]) n1
+ end
+
+let polls_added_to_self_recursive_functions () =
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ ignore(self_rec_func 2);
+ let minors_after = minor_gcs () in
+ (* should be at least one minor gc from polls in self_rec_func *)
+ assert(minors_before+1 = minors_after)
+
+(* this pair of mutually recursive functions is to test that a poll is
+ correctly placed in the first one compiled *)
+let rec mut_rec_func_even d =
+ match d with
+ | 0 -> 0
+ | _ -> mut_rec_func_odd (d-1)
+and mut_rec_func_odd d =
+ mut_rec_func_even (d-1)
+and mut_rec_func d =
+ match d with
+ | n when n mod 2 == 0
+ -> mut_rec_func_even n
+ | n -> mut_rec_func_odd n
+
+let polls_added_to_mutually_recursive_functions () =
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ ignore(mut_rec_func 3);
+ let minors_after = minor_gcs () in
+ (* should be at least one minor gc from polls in mut_rec_func *)
+ assert(minors_before < minors_after)
+
+(* this is to test that indirect tail calls (which might result in a self
+ call) have polls inserted in them.
+ These correspond to Itailcall_ind at Mach *)
+let do_indirect_tail_call f n =
+ f (n-1)
+ [@@inline never]
+
+let polls_added_to_indirect_tail_calls () =
+ let f = fun n -> n+1 in
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ ignore(do_indirect_tail_call f 3);
+ let minors_after = minor_gcs () in
+ (* should be at one minor gc from the poll in do_indirect_tail_call *)
+ assert(minors_before+1 = minors_after)
+
+(* this is to test that indirect non-tail calls do not have a poll placed
+ in them. These correspond to Icall_ind at Mach *)
+let do_indirect_call f n =
+ n * f (n-1)
+ [@@inline never]
+
+let polls_not_added_to_indirect_calls () =
+ let f = fun n -> n+1 in
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ ignore(do_indirect_call f 3);
+ let minors_after = minor_gcs () in
+ (* should be at one minor gc from the poll in do_indirect_tail_call *)
+ assert(minors_before = minors_after)
+
+(* this set of functions tests that we don't poll for immediate
+ (non-tail) calls. These correspond to Icall_imm at Mach *)
+let call_func1 n =
+ Sys.opaque_identity(n-1)
+ [@@inline never]
+
+let call_func2 n =
+ n * (call_func1 (Sys.opaque_identity(n+1)))
+ [@@inline never]
+
+let polls_not_added_to_immediate_calls () =
+ let minors_before = minor_gcs () in
+ request_minor_gc ();
+ ignore(call_func1 100);
+ let minors_after = minor_gcs () in
+ (* should be no minor collections *)
+ assert(minors_before = minors_after)
+
+let[@inline never][@local never] app minors_before f x y =
+ let minors_after_prologue = minor_gcs () in
+ assert(minors_before+1 = minors_after_prologue);
+ request_minor_gc ();
+ f x y
+
+let polls_not_added_in_caml_apply () =
+ let minors_before = minor_gcs() in
+ request_minor_gc();
+ ignore(Sys.opaque_identity(app minors_before (fun x y -> x * y) 5 4));
+ let minors_after = minor_gcs() in
+ assert(minors_before+1 = minors_after)
+
+let () =
+ ignore(Sys.opaque_identity(ref 41));
+ polls_added_to_loops (); (* relies on there being some minor heap usage *)
+
+ ignore(Sys.opaque_identity(ref 41));
+ prologue_polls_in_functions ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_added_to_self_recursive_functions ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_added_to_mutually_recursive_functions ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_added_to_indirect_tail_calls ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_not_added_to_indirect_calls ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_not_added_to_immediate_calls ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_not_added_unconditionally_allocating_functions ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_not_added_to_allocating_loops ();
+
+ ignore(Sys.opaque_identity(ref 41));
+ polls_not_added_in_caml_apply ()
--- /dev/null
+(* TEST *)
+
+(* See PR#10339 *)
+
+let access (a: string array) n =
+ try
+ ignore (a.(n)); -1
+ with _ ->
+ n
+
+let _ =
+ assert (access [||] 1 = 1)
(* TEST
-files = "mainarith.c"
+readonly_files = "mainarith.c"
arguments = "mainarith.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DFLOAT_CATCH -DFUN=catch_float main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=catch_multiple main.c"
* asmgen
*)
(* TEST
flags = "-dlive"
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DUNIT_INT -DFUN=catch_rec_deadhandler main.c"
* asmgen
** run
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=catch_fact main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DFLOAT_CATCH -DFUN=catch_try_float main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=catch_exit main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DCHECKBOUND main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_FLOAT -DFUN=is_even main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=is_even main.c"
* asmgen
*)
(* TEST
-files= "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=is_even main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=fib main.c"
* asmgen
*)
(* TEST
-files = "mainimmed.c"
+readonly_files = "mainimmed.c"
arguments = "-I ${test_source_directory} mainimmed.c"
* asmgen
*)
#define T TEST
(* T
-files = "mainimmed.c"
+readonly_files = "mainimmed.c"
arguments = "-I ${test_source_directory} mainimmed.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_FLOAT -DFUN=test main.c"
* skip
reason = "This test is currently broken"
--- /dev/null
+(* TEST
+* native-compiler
+** setup-simple-build-env
+*** codegen
+codegen_exit_status = "2"
+*)
+
+(*
+This test is here to ensure that the Cmm invariant checks
+correctly catch broken Cmm programs.
+*)
+
+(function "bad_continuations" (x:int)
+ (* Bad arity *)
+ (catch
+ (exit cont 0)
+ with (cont) 1)
+ (* Multiple handler definition *)
+ (catch
+ (exit cont 0)
+ with (cont y:int) y)
+ (* Exit out of scope of its handler *)
+ (exit cont 0)
+)
#include <stdlib.h>
#include <time.h>
+/* This stub isn't needed for msvc32, since it's already in asmgen_i386nt.asm */
+#if !defined(_MSC_VER) || !defined(_M_IX86)
+void caml_call_gc()
+{
+
+}
+#endif
+
void caml_ml_array_bound_error(void)
{
fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
#include <caml/config.h>
#define FMT ARCH_INTNAT_PRINTF_FORMAT
+void caml_call_poll()
+{
+}
+
void caml_ml_array_bound_error(void)
{
fprintf(stderr, "Fatal error: out-of-bound access in array or string\n");
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=pgcd_30030 main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DSORT -DFUN=quicksort main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DSORT -DFUN=quicksort main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DUNIT_INT -DFUN=solitaire main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_INT -DFUN=fib main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DINT_FLOAT -DFUN=test main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DSORT -DFUN=quicksort main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DUNIT_INT -DFUN=takmain main.c"
* asmgen
*)
(* TEST
-files = "main.c"
+readonly_files = "main.c"
arguments = "-DUNIT_INT -DFUN=takmain main.c"
* asmgen
*)
| Interf -> Ast_invariants.signature
let check_file kind fn =
- Warnings.parse_options false "-a";
+ ignore (Warnings.parse_options false "-a");
let ic = open_in fn in
Location.input_name := fn;
let lexbuf = Lexing.from_channel ic in
-(* TEST
- flags = "-g"
- ocamlrunparam += ",b=1"
-*)
+(* TEST_BELOW *)
+
+
+
(* A test for stack backtraces *)
let _ =
ignore (g Sys.argv.(1))
+
+(* TEST
+ flags = "-g"
+ ocamlrunparam += ",b=1"
+*)
Raised by primitive operation at Backtrace2.run in file "backtrace2.ml", line 62, characters 14-22
test_Not_found
Uncaught exception Not_found
-Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
+Raised at Stdlib__Hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
Called from Backtrace2.test_Not_found in file "backtrace2.ml", line 43, characters 9-42
Re-raised at Backtrace2.test_Not_found in file "backtrace2.ml", line 43, characters 61-70
Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Re-raised at CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 36, characters 4-11
Called from Backtrace2.run in file "backtrace2.ml", line 62, characters 11-23
Uncaught exception Not_found
-Raised at Stdlib__hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
+Raised at Stdlib__Hashtbl.find in file "hashtbl.ml", line 539, characters 13-28
Called from Backtrace2.test_lazy.exception_raised_internally in file "backtrace2.ml", line 50, characters 8-41
Re-raised at CamlinternalLazy.force_lazy_block.(fun) in file "camlinternalLazy.ml", line 35, characters 56-63
Called from CamlinternalLazy.force_lazy_block in file "camlinternalLazy.ml", line 31, characters 17-27
Fatal error: exception Stdlib.Exit
-Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 399, characters 28-54
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 405, characters 28-54
Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
Fatal error: exception Stdlib.Exit
-Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 399, characters 28-54
-Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 404, characters 2-45
+Raised by primitive operation at Stdlib.open_in_gen in file "stdlib.ml", line 405, characters 28-54
+Called from Stdlib.open_in in file "stdlib.ml" (inlined), line 410, characters 2-45
Called from Pr2195 in file "pr2195.ml", line 24, characters 6-19
Re-raised at Pr2195 in file "pr2195.ml", line 29, characters 4-41
(* TEST
arguments = "io.ml"
- files = "test-file-short-lines"
+ readonly_files = "test-file-short-lines"
*)
(* Test a file copy function *)
^^^^^^^^^^^^^^^^^^^^^^
Error: Cannot safely evaluate the definition of the following cycle
of recursively-defined modules: B -> E -> D -> C -> B.
- There are no safe modules in this cycle (see manual section 8.2).
+ There are no safe modules in this cycle (see manual section 10.2).
Line 2, characters 10-20:
2 | and B:sig val x: int end = struct let x = E.y end
^^^^^^^^^^
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Cannot safely evaluate the definition of the following cycle
of recursively-defined modules: A -> B -> A.
- There are no safe modules in this cycle (see manual section 8.2).
+ There are no safe modules in this cycle (see manual section 10.2).
Line 2, characters 28-29:
2 | module rec A: sig type t += A end = struct type t += A = B.A end
^
7 | end
Error: Cannot safely evaluate the definition of the following cycle
of recursively-defined modules: A -> B -> A.
- There are no safe modules in this cycle (see manual section 8.2).
+ There are no safe modules in this cycle (see manual section 10.2).
Line 2, characters 2-41:
2 | module F: functor(X:sig end) -> sig end
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
8 | end
Error: Cannot safely evaluate the definition of the following cycle
of recursively-defined modules: A -> B -> A.
- There are no safe modules in this cycle (see manual section 8.2).
+ There are no safe modules in this cycle (see manual section 10.2).
Line 3, characters 4-17:
3 | module M: X.t
^^^^^^^^^^^^^
--- /dev/null
+(* TEST *)
+
+let check ~stub txt f =
+ let run mode f =
+ match f mode with
+ | n -> string_of_int n
+ | exception Undefined_recursive_module _ -> "__" in
+ Printf.printf "%5s[%s]: nonrec => %s, self => %s, mod => %s\n%!"
+ txt
+ (if f == stub then "stub" else "real")
+ (run `Nonrec f)
+ (run `Self f)
+ (run `Mod f)
+
+module rec M : sig
+ val f1 : [`Nonrec|`Self|`Mod] -> int
+ val f2 : [`Nonrec|`Self|`Mod] -> int
+ val f3 : [`Nonrec|`Self|`Mod] -> int
+ val f4 : unit -> [`Nonrec|`Self|`Mod] -> int
+ val f5 : unit -> [`Nonrec|`Self|`Mod] -> int
+end = struct
+ let rec f1 mode =
+ match mode with
+ | `Nonrec -> 42
+ | `Self -> f1 `Nonrec
+ | `Mod -> M.f1 `Nonrec
+ let f2 = f1
+ let f3 = M.f1
+ let f4 () = f1
+ let f5 () = M.f1
+
+ let () =
+ check ~stub:f3 "f1" f1;
+ check ~stub:f3 "f2" f2;
+ check ~stub:f3 "f3" f3;
+ check ~stub:f3 "f4" (f4 ());
+ check ~stub:f3 "f5" (f5 ())
+end
+
+let () =
+ check ~stub:M.f3 "M.f1" M.f1;
+ check ~stub:M.f3 "M.f2" M.f2;
+ check ~stub:M.f3 "M.f3" M.f3;
+ check ~stub:M.f3 "M.f4" (M.f4 ());
+ check ~stub:M.f3 "M.f5" (M.f5 ())
+
+
+module rec Foo : sig
+ class cls : object
+ method go : unit
+ end
+ module M : sig
+ val foo : unit -> cls
+ val bar : cls Lazy.t
+ end
+end = struct
+ class cls = object
+ method go = print_endline "go"
+ end
+ module M = struct
+ let foo () = new Foo.cls
+ let bar = lazy (foo ())
+ end
+end
+
+let () =
+ List.iter (fun x -> x#go)
+ [new Foo.cls; Foo.M.foo(); Lazy.force Foo.M.bar]
--- /dev/null
+ f1[real]: nonrec => 42, self => 42, mod => __
+ f2[real]: nonrec => 42, self => 42, mod => __
+ f3[stub]: nonrec => __, self => __, mod => __
+ f4[real]: nonrec => 42, self => 42, mod => __
+ f5[stub]: nonrec => __, self => __, mod => __
+ M.f1[real]: nonrec => 42, self => 42, mod => 42
+ M.f2[real]: nonrec => 42, self => 42, mod => 42
+ M.f3[stub]: nonrec => 42, self => 42, mod => 42
+ M.f4[real]: nonrec => 42, self => 42, mod => 42
+ M.f5[real]: nonrec => 42, self => 42, mod => 42
+go
+go
+go
--- /dev/null
+File "pr10338.ml", line 7, characters 21-65:
+7 | let f ?(s="hello") = function x when (print_endline s; true) -> x;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+All clauses in this pattern-matching are guarded.
--- /dev/null
+(* TEST *)
+
+(* exercise push_defaults *)
+
+let s = 42;;
+
+let f ?(s="hello") = function x when (print_endline s; true) -> x;;
+
+let () = f ();;
+
+let f ?(y = assert false) (lazy e) = () in
+ try f (lazy (print_endline "hello")) with _ -> print_endline "failed";;
+
+type empty = |;;
+let f : empty -> int = function _ -> .;;
+let f ?y : empty -> int = function _ -> .;;
+let f ?(y=1) : empty -> int = function _ -> .;;
+
+module type E = sig exception Ex end;;
+let f ((module M) : (module E)) (M.Ex | _) = "42";;
+print_endline (f (module struct exception Ex end) Exit);;
--- /dev/null
+hello
+failed
+42
val div: t -> t -> t
val unsigned_div: t -> t -> t
val rem: t -> t -> t
+ val min: t -> t -> t
+ val max: t -> t -> t
val logand: t -> t -> t
val logor: t -> t -> t
val logxor: t -> t -> t
11, 1234567, -12345678];
test 12 (rem min_int (of_int (-1))) (of_int 0);
+ testing_function "min/max";
+ test 1 (max (of_int 2) (of_int 3)) (of_int 3);
+ test 2 (min (of_int 2) (of_int 3)) (of_int 2);
+
testing_function "and";
List.iter
(fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
11, 1234567, -12345678];
test 12 (rem min_int (of_int (-1))) (of_int 0);
+ testing_function "min/max";
+ test 1 (max (of_int 2) (of_int 3)) (of_int 3);
+ test 2 (min (of_int 2) (of_int 3)) (of_int 2);
+
testing_function "and";
List.iter
(fun (n, a, b, c) -> test n (logand (of_string a) (of_string b))
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
mod
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+min/max
+ 1... 2...
and
1... 2... 3... 4... 5...
or
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
mod
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+min/max
+ 1... 2...
and
1... 2... 3... 4... 5...
or
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11...
mod
1... 2... 3... 4... 5... 6... 7... 8... 9... 10... 11... 12...
+min/max
+ 1... 2...
and
1... 2... 3... 4... 5...
or
--- /dev/null
+(* TEST *)
+
+let p i x =
+ print_int i;
+ print_newline ();
+ x
+
+let _ =
+ for i = (p 13 0) to (p 25 3) do
+ p i ()
+ done
--- /dev/null
+13
+25
+0
+1
+2
+3
--- /dev/null
+(* TEST *)
+
+(* Slightly modified version of an example from github user @Ngoguey42,
+ submitted as issue number 10283. *)
+
+let[@inline never][@local never] g () =
+ let[@local always] f a b = Printf.printf "%d %d\n" a b in
+
+ let i = ref 0 in
+ f (incr i; !i) (incr i; !i)
+
+let () = g ()
(* TEST
- flags = "-drawlambda"
+ flags = "-drawlambda -dlambda"
* expect
*)
-(* Successful flattening *)
+(* Note: the tests below contain *both* the -drawlambda and
+ the -dlambda intermediate representations:
+ -drawlambda is the Lambda code generated directly by the
+ pattern-matching compiler; it contain "alias" bindings or static
+ exits that are unused, and will be removed by simplification, or
+ that are used only once, and will be inlined by simplification.
+ -dlambda is the Lambda code resulting from simplification.
+
+ The -drawlambda output more closely matches what the
+ pattern-compiler produces, and the -dlambda output more closely
+ matches the final generated code.
+
+ In this test we decided to show both to notice that some allocations
+ are "optimized away" during simplification (see "here flattening is
+ an optimization" below).
+*)
match (3, 2, 1) with
| (_, 3, _)
| _ -> false
;;
[%%expect{|
-(let
- (*match*/88 = 3
- *match*/89 = 2
- *match*/90 = 1
- *match*/91 = *match*/88
- *match*/92 = *match*/89
- *match*/93 = *match*/90)
+(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1)
(catch
(catch
- (catch (if (!= *match*/92 3) (exit 3) (exit 1)) with (3)
- (if (!= *match*/91 1) (exit 2) (exit 1)))
+ (catch (if (!= *match*/89 3) (exit 3) (exit 1)) with (3)
+ (if (!= *match*/88 1) (exit 2) (exit 1)))
with (2) 0)
with (1) 1))
+(let (*match*/88 = 3 *match*/89 = 2 *match*/90 = 1)
+ (catch (if (!= *match*/89 3) (if (!= *match*/88 1) 0 (exit 1)) (exit 1))
+ with (1) 1))
- : bool = false
|}];;
-(* Failed flattening: we need to allocate the tuple to bind x. *)
-
+(* This tests needs to allocate the tuple to bind 'x',
+ but this is only done in the branches that use it. *)
match (3, 2, 1) with
| ((_, 3, _) as x)
| ((1, _, _) as x) -> ignore x; true
| _ -> false
;;
[%%expect{|
-(let
- (*match*/96 = 3
- *match*/97 = 2
- *match*/98 = 1
- *match*/99 = (makeblock 0 *match*/96 *match*/97 *match*/98))
+(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1)
(catch
(catch
- (let (*match*/100 =a (field 0 *match*/99))
- (catch
- (let (*match*/101 =a (field 1 *match*/99))
- (if (!= *match*/101 3) (exit 7)
- (let (*match*/102 =a (field 2 *match*/99)) (exit 5 *match*/99))))
- with (7)
- (if (!= *match*/100 1) (exit 6)
- (let
- (*match*/104 =a (field 2 *match*/99)
- *match*/103 =a (field 1 *match*/99))
- (exit 5 *match*/99)))))
- with (6) 0)
- with (5 x/94) (seq (ignore x/94) 1)))
+ (catch
+ (if (!= *match*/94 3) (exit 6)
+ (let (x/97 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
+ (exit 4 x/97)))
+ with (6)
+ (if (!= *match*/93 1) (exit 5)
+ (let (x/96 =a (makeblock 0 *match*/93 *match*/94 *match*/95))
+ (exit 4 x/96))))
+ with (5) 0)
+ with (4 x/91) (seq (ignore x/91) 1)))
+(let (*match*/93 = 3 *match*/94 = 2 *match*/95 = 1)
+ (catch
+ (if (!= *match*/94 3)
+ (if (!= *match*/93 1) 0
+ (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95)))
+ (exit 4 (makeblock 0 *match*/93 *match*/94 *match*/95)))
+ with (4 x/91) (seq (ignore x/91) 1)))
- : bool = false
|}];;
+
+(* Regression test for #3780 *)
+let _ = fun a b ->
+ match a, b with
+ | ((true, _) as _g)
+ | ((false, _) as _g) -> ()
+[%%expect{|
+(function a/98 b/99 0)
+(function a/98 b/99 0)
+- : bool -> 'a -> unit = <fun>
+|}];;
+
+(* More complete tests.
+
+ The test cases below compare the compiler output on alias patterns
+ that are outside an or-pattern (handled during half-simplification,
+ then flattened) or inside an or-pattern (handled during simplification).
+
+ We used to have a Cannot_flatten exception that would result in fairly
+ different code generated in both cases, but now the compilation strategy
+ is fairly similar.
+*)
+let _ = fun a b -> match a, b with
+| (true, _) as p -> p
+| (false, _) as p -> p
+(* outside, trivial *)
+[%%expect {|
+(function a/102 b/103 (let (p/104 =a (makeblock 0 a/102 b/103)) p/104))
+(function a/102 b/103 (makeblock 0 a/102 b/103))
+- : bool -> 'a -> bool * 'a = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| ((true, _) as p)
+| ((false, _) as p) -> p
+(* inside, trivial *)
+[%%expect{|
+(function a/106 b/107 (let (p/108 =a (makeblock 0 a/106 b/107)) p/108))
+(function a/106 b/107 (makeblock 0 a/106 b/107))
+- : bool -> 'a -> bool * 'a = <fun>
+|}];;
+
+let _ = fun a b -> match a, b with
+| (true as x, _) as p -> x, p
+| (false as x, _) as p -> x, p
+(* outside, simple *)
+[%%expect {|
+(function a/112 b/113
+ (let (x/114 =a a/112 p/115 =a (makeblock 0 a/112 b/113))
+ (makeblock 0 x/114 p/115)))
+(function a/112 b/113 (makeblock 0 a/112 (makeblock 0 a/112 b/113)))
+- : bool -> 'a -> bool * (bool * 'a) = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| ((true as x, _) as p)
+| ((false as x, _) as p) -> x, p
+(* inside, simple *)
+[%%expect {|
+(function a/118 b/119
+ (let (x/120 =a a/118 p/121 =a (makeblock 0 a/118 b/119))
+ (makeblock 0 x/120 p/121)))
+(function a/118 b/119 (makeblock 0 a/118 (makeblock 0 a/118 b/119)))
+- : bool -> 'a -> bool * (bool * 'a) = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| (true as x, _) as p -> x, p
+| (false, x) as p -> x, p
+(* outside, complex *)
+[%%expect{|
+(function a/128 b/129
+ (if a/128
+ (let (x/130 =a a/128 p/131 =a (makeblock 0 a/128 b/129))
+ (makeblock 0 x/130 p/131))
+ (let (x/132 =a b/129 p/133 =a (makeblock 0 a/128 b/129))
+ (makeblock 0 x/132 p/133))))
+(function a/128 b/129
+ (if a/128 (makeblock 0 a/128 (makeblock 0 a/128 b/129))
+ (makeblock 0 b/129 (makeblock 0 a/128 b/129))))
+- : bool -> bool -> bool * (bool * bool) = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| ((true as x, _) as p)
+| ((false, x) as p)
+ -> x, p
+(* inside, complex *)
+[%%expect{|
+(function a/134 b/135
+ (catch
+ (if a/134
+ (let (x/142 =a a/134 p/143 =a (makeblock 0 a/134 b/135))
+ (exit 10 x/142 p/143))
+ (let (x/140 =a b/135 p/141 =a (makeblock 0 a/134 b/135))
+ (exit 10 x/140 p/141)))
+ with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
+(function a/134 b/135
+ (catch
+ (if a/134 (exit 10 a/134 (makeblock 0 a/134 b/135))
+ (exit 10 b/135 (makeblock 0 a/134 b/135)))
+ with (10 x/136 p/137) (makeblock 0 x/136 p/137)))
+- : bool -> bool -> bool * (bool * bool) = <fun>
+|}]
+
+(* here flattening is an optimisation: the allocation is moved as an
+ alias within each branch, and in the first branch it is unused and
+ will be removed by simplification, so the final code
+ (see the -dlambda output) will not allocate in the first branch. *)
+let _ = fun a b -> match a, b with
+| (true as x, _) as _p -> x, (true, true)
+| (false as x, _) as p -> x, p
+(* outside, onecase *)
+[%%expect {|
+(function a/144 b/145
+ (if a/144
+ (let (x/146 =a a/144 _p/147 =a (makeblock 0 a/144 b/145))
+ (makeblock 0 x/146 [0: 1 1]))
+ (let (x/148 =a a/144 p/149 =a (makeblock 0 a/144 b/145))
+ (makeblock 0 x/148 p/149))))
+(function a/144 b/145
+ (if a/144 (makeblock 0 a/144 [0: 1 1])
+ (makeblock 0 a/144 (makeblock 0 a/144 b/145))))
+- : bool -> bool -> bool * (bool * bool) = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| ((true as x, _) as p)
+| ((false as x, _) as p) -> x, p
+(* inside, onecase *)
+[%%expect{|
+(function a/150 b/151
+ (let (x/152 =a a/150 p/153 =a (makeblock 0 a/150 b/151))
+ (makeblock 0 x/152 p/153)))
+(function a/150 b/151 (makeblock 0 a/150 (makeblock 0 a/150 b/151)))
+- : bool -> 'a -> bool * (bool * 'a) = <fun>
+|}]
+
+type 'a tuplist = Nil | Cons of ('a * 'a tuplist)
+[%%expect{|
+0
+0
+type 'a tuplist = Nil | Cons of ('a * 'a tuplist)
+|}]
+
+(* another example where we avoid an allocation in the first case *)
+let _ =fun a b -> match a, b with
+| (true, Cons p) -> p
+| (_, _) as p -> p
+(* outside, tuplist *)
+[%%expect {|
+(function a/163 b/164
+ (catch
+ (if a/163 (if b/164 (let (p/165 =a (field 0 b/164)) p/165) (exit 12))
+ (exit 12))
+ with (12) (let (p/166 =a (makeblock 0 a/163 b/164)) p/166)))
+(function a/163 b/164
+ (catch (if a/163 (if b/164 (field 0 b/164) (exit 12)) (exit 12)) with (12)
+ (makeblock 0 a/163 b/164)))
+- : bool -> bool tuplist -> bool * bool tuplist = <fun>
+|}]
+
+let _ = fun a b -> match a, b with
+| (true, Cons p)
+| ((_, _) as p) -> p
+(* inside, tuplist *)
+[%%expect{|
+(function a/167 b/168
+ (catch
+ (catch
+ (if a/167
+ (if b/168 (let (p/172 =a (field 0 b/168)) (exit 13 p/172)) (exit 14))
+ (exit 14))
+ with (14) (let (p/171 =a (makeblock 0 a/167 b/168)) (exit 13 p/171)))
+ with (13 p/169) p/169))
+(function a/167 b/168
+ (catch
+ (catch
+ (if a/167 (if b/168 (exit 13 (field 0 b/168)) (exit 14)) (exit 14))
+ with (14) (exit 13 (makeblock 0 a/167 b/168)))
+ with (13 p/169) p/169))
+- : bool -> bool tuplist -> bool * bool tuplist = <fun>
+|}]
--- /dev/null
+(* TEST
+ flags = "-I ${ocamlsrcdir}/typing \
+ -I ${ocamlsrcdir}/parsing"
+ include ocamlcommon
+ * expect
+*)
+
+let res =
+ let s = {| match None with Some (Some _) -> () | _ -> () |} in
+ let pe = Parse.expression (Lexing.from_string s) in
+ let te = Typecore.type_expression (Env.initial_safe_string) pe in
+ let ute = Untypeast.untype_expression te in
+ Format.asprintf "%a" Pprintast.expression ute
+
+[%%expect{|
+val res : string = "match None with | Some (Some _) -> () | _ -> ()"
+|}]
(* modified glibc's fma() tests *)
+let string_of_fpclass = function
+| Float.FP_normal -> "normal"
+| FP_subnormal -> "subnormal"
+| FP_zero -> "zero"
+| FP_infinite -> "infinite"
+| FP_nan -> "nan"
+
let error l x y z r c =
Printf.fprintf stdout
- "%s FAIL!\tfma (%h, %h, %h) returned %h instead of %h.\n"
- l x y z c (List.hd r)
+ "%s FAIL!\tfma (%h, %h, %h) returned %h (%s) instead of %h.\n"
+ l x y z c (string_of_fpclass (Float.classify_float c))
+ (List.hd r)
let success l =
Printf.fprintf stdout "%s OK!\n" l
(* TEST
- flags += " -w a "
+ flags += " -w -a "
modules = "globrootsprim.c"
*)
--- /dev/null
+File "use_file: HASH LIDENT TRUE WITH", line 1, characters 14-18:
+Error: Syntax error
+File "use_file: QUOTED_STRING_ITEM RBRACKET", line 1, characters 17-18:
+Error: Syntax error
+File "use_file: UIDENT LBRACKETATAT AND RBRACKET AND", line 1, characters 17-20:
+Error: Syntax error
+File "use_file: UIDENT WITH", line 1, characters 7-11:
+Error: Syntax error
+File "use_file: WITH", line 1, characters 0-4:
+Error: Syntax error
+File "toplevel_phrase: HASH UIDENT UIDENT DOT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "toplevel_phrase: HASH UIDENT UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "toplevel_phrase: HASH UIDENT VAL", line 1, characters 9-12:
+Error: Syntax error
+File "toplevel_phrase: HASH UIDENT WITH", line 1, characters 9-13:
+Error: Syntax error
+File "toplevel_phrase: HASH WITH", line 1, characters 2-6:
+Error: Syntax error
+File "toplevel_phrase: QUOTED_STRING_ITEM RBRACKET", line 1, characters 17-18:
+Error: Syntax error
+File "toplevel_phrase: UIDENT LBRACKETATAT AND RBRACKET VAL", line 1, characters 17-20:
+Error: Syntax error
+File "toplevel_phrase: UIDENT WITH", line 1, characters 7-11:
+Error: Syntax error
+File "toplevel_phrase: WITH", line 1, characters 0-4:
+Error: Syntax error
+File "implementation: ASSERT LBRACKETAT AND RBRACKET ASSERT", line 1, characters 16-22:
+Error: Syntax error
+File "implementation: ASSERT PERCENT AND ASSERT", line 1, characters 13-19:
+Error: Syntax error
+File "implementation: ASSERT UIDENT UIDENT", line 1, characters 14-20:
+Error: Syntax error
+File "implementation: ASSERT WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: BACKQUOTE UIDENT UIDENT UIDENT", line 1, characters 16-22:
+Error: Syntax error
+File "implementation: BACKQUOTE UIDENT WHILE", line 1, characters 9-14:
+Error: Syntax error
+File "implementation: BACKQUOTE WITH", line 1, characters 2-6:
+Error: Syntax error
+File "implementation: BANG WITH", line 1, characters 2-6:
+Error: Syntax error
+File "implementation: BEGIN LBRACKETAT AND RBRACKET AND", line 1, characters 15-18:
+Error: Syntax error
+File "implementation: BEGIN PERCENT AND VIRTUAL", line 1, characters 12-19:
+Error: Syntax error
+File "implementation: BEGIN UIDENT WITH", line 1, characters 13-17:
+Error: Syntax error: 'end' expected
+File "implementation: BEGIN UIDENT WITH", line 1, characters 0-5:
+ This 'begin' might be unmatched
+File "implementation: BEGIN WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: CLASS LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: CLASS LBRACKET UNDERSCORE WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: CLASS LBRACKET WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: CLASS LBRACKETAT AND RBRACKET LBRACELESS", line 1, characters 15-17:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LBRACKET UNDERSCORE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LBRACKET WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 52-56:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT IN WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN BANG WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN LBRACKETAT AND RBRACKET WHILE", line 1, characters 33-38:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 50-54:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN UIDENT IN WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN UIDENT WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET OPEN WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LET WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LIDENT COLON UNDERSCORE MINUSGREATER WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LIDENT COLON UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LIDENT COLON WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON LIDENT WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT LBRACKETAT AND RBRACKET WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT UNDERSCORE EQUAL LIDENT INITIALIZER", line 1, characters 44-55:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT UNDERSCORE EQUAL LIDENT INITIALIZER", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT END WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT INHERIT LBRACKETAT AND RBRACKET WHILE", line 1, characters 39-44:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT INHERIT QUOTED_STRING_EXPR WITH", line 1, characters 46-50:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT INHERIT QUOTED_STRING_EXPR WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT INHERIT WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT LBRACKETAT AND RBRACKET WHILE", line 1, characters 31-36:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT LBRACKETAT AND RBRACKET WHILE", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT LBRACKETATATAT AND RBRACKET WITH", line 1, characters 33-37:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT LBRACKETATATAT AND RBRACKET WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT LPAREN UNDERSCORE RPAREN WITH", line 1, characters 28-32:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT LPAREN UNDERSCORE RPAREN WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT LPAREN UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT LPAREN WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD LBRACKETAT AND RBRACKET WHILE", line 1, characters 38-43:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT COLON UNDERSCORE INITIALIZER", line 1, characters 40-51:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT COLON UNDERSCORE INITIALIZER", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT COLON WITH", line 1, characters 38-42:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD PRIVATE WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD VIRTUAL PRIVATE WITH", line 1, characters 45-49:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD VIRTUAL WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT METHOD WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT QUOTED_STRING_ITEM WITH", line 1, characters 39-43:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT QUOTED_STRING_ITEM WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT VAL LBRACKETAT AND RBRACKET WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT COLON UNDERSCORE WITH", line 1, characters 37-41:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT COLON UNDERSCORE WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT COLON WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL MUTABLE WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL VIRTUAL MUTABLE WITH", line 1, characters 42-46:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL VIRTUAL WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT VAL WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OBJECT WITH", line 1, characters 22-26:
+Error: Syntax error: 'end' expected
+File "implementation: CLASS LIDENT COLON OBJECT WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: CLASS LIDENT COLON OPTLABEL UNDERSCORE MINUSGREATER WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OPTLABEL UNDERSCORE WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON OPTLABEL WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR EQUAL QUOTED_STRING_EXPR WITH", line 1, characters 49-53:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR EQUAL WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR VAL", line 1, characters 31-34:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON UIDENT DOT LIDENT WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON UNDERSCORE MINUSGREATER WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON UNDERSCORE WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: CLASS LIDENT COLON WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 41-45:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 44-49:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL LIDENT LBRACKETATAT AND RBRACKET METHOD", line 1, characters 61-67:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT WITH", line 1, characters 42-46:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS", line 1, characters 43-45:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 41-47:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: CLASS LIDENT EQUAL WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: CLASS LIDENT UNDERSCORE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: CLASS LIDENT WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: CLASS PERCENT AND LBRACELESS", line 1, characters 12-14:
+Error: Syntax error
+File "implementation: CLASS TYPE LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: CLASS TYPE LBRACKETAT AND RBRACKET LBRACELESS", line 1, characters 20-22:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL LBRACKET WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 46-50:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET LBRACELESS", line 1, characters 49-51:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 75-81:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL QUOTED_STRING_EXPR WITH", line 1, characters 65-69:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL WITH", line 1, characters 49-53:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT WITH", line 1, characters 47-51:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS", line 1, characters 48-50:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND WITH", line 1, characters 40-44:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 46-52:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT EQUAL WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: CLASS TYPE LIDENT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: CLASS TYPE PERCENT AND LBRACELESS", line 1, characters 17-19:
+Error: Syntax error
+File "implementation: CLASS TYPE VIRTUAL LBRACELESS", line 1, characters 19-21:
+Error: Syntax error
+File "implementation: CLASS TYPE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: CLASS VIRTUAL LBRACELESS", line 1, characters 14-16:
+Error: Syntax error
+File "implementation: CLASS WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: EXCEPTION LBRACKET WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: EXCEPTION LBRACKETAT AND RBRACKET EXTERNAL", line 1, characters 19-27:
+Error: Syntax error
+File "implementation: EXCEPTION LPAREN COLONCOLON WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: EXCEPTION LPAREN WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: EXCEPTION PERCENT AND EXTERNAL", line 1, characters 16-24:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT COLON UNDERSCORE MINUSGREATER UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT COLON UNDERSCORE MINUSGREATER WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT COLON UNDERSCORE STAR LIDENT VAL", line 1, characters 30-33:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT COLON UNDERSCORE WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT COLON WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL LPAREN WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL UIDENT BAR", line 1, characters 26-27:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL UIDENT DOT LPAREN WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL UIDENT DOT WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL UIDENT LBRACKETAT AND RBRACKET WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL UIDENT WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT EQUAL WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT LBRACKETAT AND RBRACKET CHAR", line 1, characters 26-29:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON LIDENT SEMI LBRACKETAT AND RBRACKET WHILE", line 1, characters 49-54:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE GREATER", line 1, characters 33-34:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE LBRACKETAT AND RBRACKET WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE SEMI WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE LIDENT WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE MUTABLE LETOP", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LBRACE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF LIDENT BAR", line 1, characters 27-28:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF UNDERSCORE STAR UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF UNDERSCORE STAR WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF UNDERSCORE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT OF WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: EXCEPTION UIDENT WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: EXCEPTION WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: EXTERNAL LBRACKETAT AND RBRACKET WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: EXTERNAL LIDENT COLON UNDERSCORE EQUAL STRING WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: EXTERNAL LIDENT COLON UNDERSCORE EQUAL WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: EXTERNAL LIDENT COLON UNDERSCORE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: EXTERNAL LIDENT COLON WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: EXTERNAL LIDENT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: EXTERNAL LPAREN MODULE WITH", line 1, characters 18-22:
+Error: Syntax error: module-expr expected.
+File "implementation: EXTERNAL LPAREN WITH", line 1, characters 11-15:
+Error: Syntax error: operator expected.
+File "implementation: EXTERNAL PERCENT AND LBRACKET", line 1, characters 15-16:
+Error: Syntax error
+File "implementation: EXTERNAL WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: FOR LBRACKETAT AND RBRACKET ASSERT", line 1, characters 13-19:
+Error: Syntax error
+File "implementation: FOR PERCENT AND ASSERT", line 1, characters 10-16:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT DO UIDENT WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT DO WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL UIDENT TO WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL UIDENT WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE EQUAL WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: FOR UNDERSCORE WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: FOR WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: FUN LABEL WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: FUN LBRACKETAT AND RBRACKET ASSERT", line 1, characters 13-19:
+Error: Syntax error
+File "implementation: FUN LPAREN TYPE LIDENT DOT", line 1, characters 18-19:
+Error: Syntax error
+File "implementation: FUN LPAREN TYPE LIDENT RPAREN WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: FUN LPAREN TYPE LIDENT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: FUN LPAREN TYPE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: FUN LPAREN WITH", line 1, characters 6-10:
+Error: Syntax error: operator expected.
+File "implementation: FUN OPTLABEL LPAREN UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: FUN OPTLABEL LPAREN UNDERSCORE COLON WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: FUN OPTLABEL LPAREN UNDERSCORE EQUAL CHAR WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: FUN OPTLABEL LPAREN UNDERSCORE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: FUN OPTLABEL LPAREN WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: FUN OPTLABEL WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: FUN PERCENT AND ASSERT", line 1, characters 10-16:
+Error: Syntax error
+File "implementation: FUN QUESTION LPAREN LIDENT EQUAL UIDENT WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: FUN QUESTION LPAREN LIDENT EQUAL WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: FUN QUESTION LPAREN WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: FUN QUESTION WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: FUN TILDE LPAREN LIDENT COLON UNDERSCORE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: FUN TILDE LPAREN LIDENT COLON WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: FUN TILDE LPAREN LIDENT EQUAL", line 1, characters 15-16:
+Error: Syntax error
+File "implementation: FUN TILDE LPAREN LIDENT WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: FUN TILDE LPAREN WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: FUN TILDE WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE COLON UNDERSCORE MINUSGREATER WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE COLON WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE LPAREN TYPE LIDENT DOT", line 1, characters 20-21:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE LPAREN TYPE LIDENT RPAREN WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE LPAREN TYPE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE LPAREN WITH", line 1, characters 8-12:
+Error: Syntax error: operator expected.
+File "implementation: FUN UNDERSCORE MINUSGREATER WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE UNDERSCORE WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: FUN UNDERSCORE WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: FUN WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: FUNCTION BAR WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: FUNCTION EXCEPTION LBRACKETAT AND RBRACKET ASSERT", line 1, characters 28-34:
+Error: Syntax error
+File "implementation: FUNCTION EXCEPTION PERCENT AND ASSERT", line 1, characters 25-31:
+Error: Syntax error
+File "implementation: FUNCTION EXCEPTION WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: FUNCTION LBRACKETAT AND RBRACKET ASSERT", line 1, characters 18-24:
+Error: Syntax error
+File "implementation: FUNCTION PERCENT AND ASSERT", line 1, characters 15-21:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE AS WITH", line 1, characters 14-18:
+Error: Syntax error: identifier expected.
+File "implementation: FUNCTION UNDERSCORE BAR UNDERSCORE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE BAR WITH", line 1, characters 13-17:
+Error: Syntax error: pattern expected.
+File "implementation: FUNCTION UNDERSCORE COLONCOLON UNDERSCORE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE COLONCOLON WITH", line 1, characters 14-18:
+Error: Syntax error: pattern expected.
+File "implementation: FUNCTION UNDERSCORE COMMA CHAR COMMA UNDERSCORE WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE COMMA CHAR COMMA WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE COMMA UNDERSCORE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE COMMA WITH", line 1, characters 13-17:
+Error: Syntax error: pattern expected.
+File "implementation: FUNCTION UNDERSCORE MINUSGREATER CHAR BAR WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE MINUSGREATER DOT WHILE", line 1, characters 16-21:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE MINUSGREATER WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE WHEN UIDENT MINUSGREATER WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE WHEN UIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE WHEN WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: FUNCTION UNDERSCORE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: FUNCTION WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: IF LBRACKETAT AND RBRACKET AND", line 1, characters 12-15:
+Error: Syntax error
+File "implementation: IF PERCENT AND VIRTUAL", line 1, characters 9-16:
+Error: Syntax error
+File "implementation: IF UIDENT THEN OBJECT END WHILE", line 1, characters 26-31:
+Error: Syntax error
+File "implementation: IF UIDENT THEN UIDENT ELSE OBJECT END WHILE", line 1, characters 38-43:
+Error: Syntax error
+File "implementation: IF UIDENT THEN UIDENT ELSE WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: IF UIDENT THEN WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: IF UIDENT WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: IF WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: INCLUDE LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 17-25:
+Error: Syntax error
+File "implementation: INCLUDE PERCENT AND FUNCTION", line 1, characters 14-22:
+Error: Syntax error
+File "implementation: INCLUDE UIDENT WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: INCLUDE WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: LAZY LBRACKETAT AND RBRACKET ASSERT", line 1, characters 14-20:
+Error: Syntax error
+File "implementation: LAZY PERCENT AND ASSERT", line 1, characters 11-17:
+Error: Syntax error
+File "implementation: LAZY UIDENT UIDENT", line 1, characters 12-18:
+Error: Syntax error
+File "implementation: LAZY WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: LBRACE LIDENT COLONGREATER LIDENT RPAREN", line 1, characters 19-20:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE LIDENT COLONGREATER LIDENT RPAREN", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE LIDENT EQUAL CHAR GREATERRBRACE", line 1, characters 15-17:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE LIDENT EQUAL CHAR GREATERRBRACE", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE LIDENT SEMI WITH", line 1, characters 11-15:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE LIDENT SEMI WITH", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE LIDENT WHILE", line 1, characters 9-14:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE LIDENT WHILE", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE TRUE DOT LBRACE UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE TRUE DOT LBRACE UIDENT WITH", line 1, characters 9-10:
+ This '{' might be unmatched
+File "implementation: LBRACE TRUE DOT LBRACE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT LBRACKET UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error: ']' expected
+File "implementation: LBRACE TRUE DOT LBRACKET UIDENT WITH", line 1, characters 9-10:
+ This '[' might be unmatched
+File "implementation: LBRACE TRUE DOT LBRACKET WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT LPAREN UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error: ')' expected
+File "implementation: LBRACE TRUE DOT LPAREN UIDENT WITH", line 1, characters 9-10:
+ This '(' might be unmatched
+File "implementation: LBRACE TRUE DOT LPAREN WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN", line 1, characters 28-29:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN", line 1, characters 19-20:
+ This '{' might be unmatched
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACE WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 28-29:
+Error: Syntax error: ']' expected
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 19-20:
+ This '[' might be unmatched
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACKET WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 28-29:
+Error: Syntax error: ')' expected
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 19-20:
+ This '(' might be unmatched
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP LPAREN WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT UIDENT DOTOP WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LBRACE TRUE DOT WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LBRACE TRUE WHILE", line 1, characters 7-12:
+Error: Syntax error
+File "implementation: LBRACE UIDENT DOT LIDENT WHILE", line 1, characters 18-23:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE UIDENT DOT LIDENT WHILE", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE UIDENT DOT WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACE UIDENT DOTOP LBRACE UIDENT SEMI RPAREN", line 1, characters 23-24:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE UIDENT DOTOP LBRACE UIDENT SEMI RPAREN", line 1, characters 12-13:
+ This '{' might be unmatched
+File "implementation: LBRACE UIDENT DOTOP LBRACE WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LBRACE UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 21-22:
+Error: Syntax error: ']' expected
+File "implementation: LBRACE UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 12-13:
+ This '[' might be unmatched
+File "implementation: LBRACE UIDENT DOTOP LBRACKET WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LBRACE UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 21-22:
+Error: Syntax error: ')' expected
+File "implementation: LBRACE UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 12-13:
+ This '(' might be unmatched
+File "implementation: LBRACE UIDENT DOTOP LPAREN WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LBRACE UIDENT DOTOP WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LBRACE UIDENT WHILE", line 1, characters 9-14:
+Error: Syntax error
+File "implementation: LBRACE UIDENT WITH LIDENT WITH", line 1, characters 21-25:
+Error: Syntax error: '}' expected
+File "implementation: LBRACE UIDENT WITH LIDENT WITH", line 1, characters 0-1:
+ This '{' might be unmatched
+File "implementation: LBRACE UIDENT WITH WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LBRACE WITH", line 1, characters 2-6:
+Error: Syntax error
+File "implementation: LBRACELESS LIDENT EQUAL UIDENT RBRACE", line 1, characters 19-20:
+Error: Syntax error: '>}' expected
+File "implementation: LBRACELESS LIDENT EQUAL UIDENT RBRACE", line 1, characters 0-2:
+ This '{<' might be unmatched
+File "implementation: LBRACELESS LIDENT EQUAL UIDENT WITH", line 1, characters 19-23:
+Error: Syntax error: '>}' expected
+File "implementation: LBRACELESS LIDENT EQUAL UIDENT WITH", line 1, characters 0-2:
+ This '{<' might be unmatched
+File "implementation: LBRACELESS LIDENT EQUAL WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LBRACELESS LIDENT SEMI WITH", line 1, characters 12-16:
+Error: Syntax error: '>}' expected
+File "implementation: LBRACELESS LIDENT SEMI WITH", line 1, characters 0-2:
+ This '{<' might be unmatched
+File "implementation: LBRACELESS LIDENT WITH", line 1, characters 10-14:
+Error: Syntax error: '>}' expected
+File "implementation: LBRACELESS LIDENT WITH", line 1, characters 0-2:
+ This '{<' might be unmatched
+File "implementation: LBRACELESS WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: LBRACKET UIDENT RPAREN", line 1, characters 9-10:
+Error: Syntax error: ']' expected
+File "implementation: LBRACKET UIDENT RPAREN", line 1, characters 0-1:
+ This '[' might be unmatched
+File "implementation: LBRACKET WITH", line 1, characters 2-6:
+Error: Syntax error
+File "implementation: LBRACKETATATAT UNDERSCORE", line 1, characters 5-6:
+Error: Syntax error
+File "implementation: LBRACKETATATAT WITH UIDENT WHEN", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LBRACKETATATAT WITH VIRTUAL", line 1, characters 10-17:
+Error: Syntax error
+File "implementation: LBRACKETBAR UIDENT RPAREN", line 1, characters 10-11:
+Error: Syntax error: '|]' expected
+File "implementation: LBRACKETBAR UIDENT RPAREN", line 1, characters 0-2:
+ This '[|' might be unmatched
+File "implementation: LBRACKETBAR UIDENT SEMI WITH", line 1, characters 12-16:
+Error: Syntax error: '|]' expected
+File "implementation: LBRACKETBAR UIDENT SEMI WITH", line 1, characters 0-2:
+ This '[|' might be unmatched
+File "implementation: LBRACKETBAR UIDENT WITH", line 1, characters 10-14:
+Error: Syntax error: '|]' expected
+File "implementation: LBRACKETBAR UIDENT WITH", line 1, characters 0-2:
+ This '[|' might be unmatched
+File "implementation: LBRACKETBAR WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: LBRACKETPERCENT UNDERSCORE", line 1, characters 3-4:
+Error: Syntax error
+File "implementation: LBRACKETPERCENT WITH UIDENT WHEN", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LBRACKETPERCENT WITH VIRTUAL", line 1, characters 8-15:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT UNDERSCORE", line 1, characters 4-5:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LBRACKETAT AND RBRACKET WHILE", line 1, characters 26-31:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 52-56:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 55-60:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 81-87:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON QUOTED_STRING_EXPR RPAREN", line 1, characters 71-72:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON WITH", line 1, characters 55-59:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT WITH", line 1, characters 53-57:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS", line 1, characters 54-56:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND WITH", line 1, characters 46-50:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 52-58:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR RPAREN", line 1, characters 42-43:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS PERCENT AND LBRACELESS", line 1, characters 23-25:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS VIRTUAL LBRACELESS", line 1, characters 25-27:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION LBRACKETAT AND RBRACKET WHILE", line 1, characters 30-35:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION PERCENT AND EXTERNAL", line 1, characters 27-35:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION UIDENT WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE LBRACKETAT AND RBRACKET WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE PERCENT AND FUNCTION", line 1, characters 25-33:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE UIDENT RPAREN", line 1, characters 26-27:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 27-32:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE PERCENT AND LBRACKET", line 1, characters 24-25:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 46-51:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON UIDENT LBRACKETATAT AND RBRACKET METHOD", line 1, characters 58-64:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON UIDENT RPAREN", line 1, characters 48-49:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON WITH", line 1, characters 41-45:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE WITH", line 1, characters 39-43:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT LBRACKETATAT AND RBRACKET METHOD", line 1, characters 43-49:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT RPAREN", line 1, characters 33-34:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE TYPE UIDENT LET", line 1, characters 30-33:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT COLONEQUAL UIDENT WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT COLONEQUAL WITH", line 1, characters 28-32:
+Error: Syntax error: module path expected.
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE COLON UIDENT RPAREN", line 1, characters 29-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE COLON WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE EQUAL UIDENT WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE EQUAL WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE LPAREN RPAREN WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 27-32:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG PERCENT AND LBRACKET", line 1, characters 24-25:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG UIDENT WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN LBRACKETAT AND RBRACKET WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN PERCENT AND LBRACKET", line 1, characters 22-23:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN UIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON QUOTED_STRING_ITEM WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON SEMISEMI WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LBRACKETAT AND RBRACKET WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 41-46:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL UNDERSCORE LBRACKETATAT AND RBRACKET METHOD", line 1, characters 54-60:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL UNDERSCORE LET", line 1, characters 44-47:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL WITH", line 1, characters 42-46:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT WITH", line 1, characters 39-43:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND UNDERSCORE LETOP", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 38-44:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL UNDERSCORE LET", line 1, characters 28-31:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ PRIVATE BANG", line 1, characters 34-35:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ UIDENT LET", line 1, characters 33-36:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE NONREC LIDENT LET", line 1, characters 30-33:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE PERCENT AND BACKQUOTE", line 1, characters 22-23:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE UIDENT DOT LIDENT WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE UNDERSCORE LETOP", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH COLON WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH DOT UNDERSCORE", line 1, characters 11-12:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH QUESTION UNDERSCORE WHEN WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH QUESTION UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH QUESTION WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH UIDENT WHEN", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH VIRTUAL", line 1, characters 9-16:
+Error: Syntax error
+File "implementation: LBRACKETPERCENTPERCENT WITH WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LET CHAR EQUAL CHAR AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 27-32:
+Error: Syntax error
+File "implementation: LET CHAR EQUAL CHAR AND UNDERSCORE EQUAL CHAR WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LET CHAR EQUAL CHAR AND WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LET CHAR EQUAL CHAR IN WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: LET CHAR EQUAL CHAR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 24-30:
+Error: Syntax error
+File "implementation: LET EXCEPTION LBRACKETAT AND RBRACKET EXTERNAL", line 1, characters 23-31:
+Error: Syntax error
+File "implementation: LET EXCEPTION PERCENT AND EXTERNAL", line 1, characters 20-28:
+Error: Syntax error
+File "implementation: LET EXCEPTION UIDENT IN WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LET EXCEPTION UIDENT LBRACKETAT AND RBRACKET WHILE", line 1, characters 30-35:
+Error: Syntax error
+File "implementation: LET EXCEPTION UIDENT OF UNDERSCORE EXTERNAL", line 1, characters 26-34:
+Error: Syntax error
+File "implementation: LET EXCEPTION UIDENT WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LET EXCEPTION WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LET LBRACKETAT AND RBRACKET ASSERT", line 1, characters 13-19:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE LIDENT DOT UNDERSCORE EQUAL WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE LIDENT DOT UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE LIDENT DOT WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE LIDENT QUOTE LIDENT WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE LIDENT QUOTE WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE UIDENT WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: LET LIDENT COLON QUOTE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: LET LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: LET LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: LET LIDENT COLON TYPE LIDENT DOT WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: LET LIDENT COLON TYPE LIDENT RPAREN", line 1, characters 25-26:
+Error: Syntax error
+File "implementation: LET LIDENT COLON TYPE WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LET LIDENT COLON WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LET LIDENT COLONGREATER UNDERSCORE EQUAL WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LET LIDENT COLONGREATER UNDERSCORE SEMI", line 1, characters 16-17:
+Error: Syntax error
+File "implementation: LET LIDENT WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LET MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: LET MODULE PERCENT AND LBRACKET", line 1, characters 17-18:
+Error: Syntax error
+File "implementation: LET MODULE UNDERSCORE EQUAL UIDENT IN WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: LET MODULE UNDERSCORE EQUAL UIDENT VAL", line 1, characters 22-25:
+Error: Syntax error
+File "implementation: LET MODULE UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LET MODULE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LET OPEN BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: LET OPEN BANG PERCENT AND WHILE", line 1, characters 17-22:
+Error: Syntax error
+File "implementation: LET OPEN BANG UIDENT IN WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: LET OPEN BANG UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LET OPEN BANG WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LET OPEN LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 18-26:
+Error: Syntax error
+File "implementation: LET OPEN PERCENT AND FUNCTION", line 1, characters 15-23:
+Error: Syntax error
+File "implementation: LET OPEN UIDENT IN WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: LET OPEN UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LET OPEN WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LET PERCENT AND ASSERT", line 1, characters 10-16:
+Error: Syntax error
+File "implementation: LET REC ASSERT", line 1, characters 8-14:
+Error: Syntax error
+File "implementation: LET UIDENT UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LET UNDERSCORE COLON UNDERSCORE EQUAL WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LET UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: LET UNDERSCORE COLON WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: LET UNDERSCORE EQUAL CHAR WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LET UNDERSCORE EQUAL WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: LET UNDERSCORE WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: LET WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: LETOP BACKQUOTE UIDENT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LETOP HASH WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP LAZY LBRACKETAT AND RBRACKET ASSERT", line 1, characters 19-25:
+Error: Syntax error
+File "implementation: LETOP LAZY PERCENT AND WHILE", line 1, characters 16-21:
+Error: Syntax error
+File "implementation: LETOP LAZY WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: LETOP LBRACE LIDENT COLON UNDERSCORE WITH", line 1, characters 18-22:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT COLON UNDERSCORE WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE LIDENT COLON WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LETOP LBRACE LIDENT EQUAL UNDERSCORE WITH", line 1, characters 18-22:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT EQUAL UNDERSCORE WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE LIDENT EQUAL WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE SEMI WITH", line 1, characters 20-24:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE SEMI WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE WITH", line 1, characters 18-22:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE LIDENT SEMI WITH", line 1, characters 16-20:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT SEMI WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE LIDENT WITH", line 1, characters 14-18:
+Error: Syntax error: '}' expected
+File "implementation: LETOP LBRACE LIDENT WITH", line 1, characters 5-6:
+ This '{' might be unmatched
+File "implementation: LETOP LBRACE WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP LBRACKET UNDERSCORE BARRBRACKET", line 1, characters 9-11:
+Error: Syntax error: ']' expected
+File "implementation: LETOP LBRACKET UNDERSCORE BARRBRACKET", line 1, characters 5-6:
+ This '[' might be unmatched
+File "implementation: LETOP LBRACKET WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP LBRACKETBAR UNDERSCORE RBRACKET", line 1, characters 10-11:
+Error: Syntax error: '|]' expected
+File "implementation: LETOP LBRACKETBAR UNDERSCORE RBRACKET", line 1, characters 5-7:
+ This '[|' might be unmatched
+File "implementation: LETOP LBRACKETBAR UNDERSCORE SEMI WITH", line 1, characters 12-16:
+Error: Syntax error: '|]' expected
+File "implementation: LETOP LBRACKETBAR UNDERSCORE SEMI WITH", line 1, characters 5-7:
+ This '[|' might be unmatched
+File "implementation: LETOP LBRACKETBAR UNDERSCORE WITH", line 1, characters 10-14:
+Error: Syntax error: '|]' expected
+File "implementation: LETOP LBRACKETBAR UNDERSCORE WITH", line 1, characters 5-7:
+ This '[|' might be unmatched
+File "implementation: LETOP LBRACKETBAR WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: LETOP LIDENT ANDOP WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: LETOP LIDENT EQUAL WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LETOP LIDENT IN WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: LETOP LIDENT LPAREN TYPE LIDENT DOT", line 1, characters 26-27:
+Error: Syntax error
+File "implementation: LETOP LIDENT LPAREN TYPE LIDENT RPAREN WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: LETOP LIDENT LPAREN TYPE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: LETOP LIDENT LPAREN WITH", line 1, characters 14-18:
+Error: Syntax error: operator expected.
+File "implementation: LETOP LIDENT UNDERSCORE COLONGREATER LIDENT EQUAL WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: LETOP LIDENT UNDERSCORE COLONGREATER LIDENT SEMI", line 1, characters 24-25:
+Error: Syntax error
+File "implementation: LETOP LIDENT UNDERSCORE WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LETOP LIDENT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LETOP LPAREN MINUS WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LETOP LPAREN MINUS WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: LETOP LPAREN MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 23-28:
+Error: Syntax error
+File "implementation: LETOP LPAREN MODULE PERCENT AND WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: LETOP LPAREN MODULE UNDERSCORE COLON UIDENT VAL", line 1, characters 25-28:
+Error: Syntax error: ')' expected
+File "implementation: LETOP LPAREN MODULE UNDERSCORE COLON UIDENT VAL", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: LETOP LPAREN MODULE UNDERSCORE COLON WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LETOP LPAREN MODULE UNDERSCORE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LETOP LPAREN MODULE WITH", line 1, characters 14-18:
+Error: Syntax error: module-expr expected.
+File "implementation: LETOP LPAREN PLUS WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LETOP LPAREN PLUS WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: LETOP LPAREN UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error: ')' expected
+File "implementation: LETOP LPAREN UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: LETOP LPAREN UNDERSCORE COLON WITH", line 1, characters 11-15:
+Error: Syntax error: type expected.
+File "implementation: LETOP LPAREN UNDERSCORE WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LETOP LPAREN UNDERSCORE WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: LETOP LPAREN WITH", line 1, characters 7-11:
+Error: Syntax error: operator expected.
+File "implementation: LETOP MINUS WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP PLUS WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP STRING DOTDOT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LETOP STRING WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LETOP UIDENT DOT LBRACKET WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LETOP UIDENT DOT LPAREN UNDERSCORE WITH", line 1, characters 18-22:
+Error: Syntax error: ')' expected
+File "implementation: LETOP UIDENT DOT LPAREN UNDERSCORE WITH", line 1, characters 14-15:
+ This '(' might be unmatched
+File "implementation: LETOP UIDENT DOT LPAREN WITH", line 1, characters 16-20:
+Error: Syntax error: pattern expected.
+File "implementation: LETOP UIDENT DOT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LETOP UIDENT LIDENT WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: LETOP UIDENT TILDE", line 1, characters 12-13:
+Error: Syntax error
+File "implementation: LETOP UIDENT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE AS WITH", line 1, characters 10-14:
+Error: Syntax error: identifier expected.
+File "implementation: LETOP UNDERSCORE BAR UNDERSCORE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE BAR WITH", line 1, characters 9-13:
+Error: Syntax error: pattern expected.
+File "implementation: LETOP UNDERSCORE COLON UNDERSCORE EQUAL WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COLON WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COLONCOLON UNDERSCORE WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COLONCOLON WITH", line 1, characters 10-14:
+Error: Syntax error: pattern expected.
+File "implementation: LETOP UNDERSCORE COMMA CHAR COMMA UNDERSCORE WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COMMA CHAR COMMA WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COMMA UNDERSCORE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE COMMA WITH", line 1, characters 9-13:
+Error: Syntax error: pattern expected.
+File "implementation: LETOP UNDERSCORE EQUAL CHAR WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE EQUAL WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LETOP UNDERSCORE WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LETOP WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: LIDENT LESSMINUS OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: LIDENT LESSMINUS WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: LIDENT WHILE", line 1, characters 7-12:
+Error: Syntax error
+File "implementation: LPAREN BANG WITH", line 1, characters 4-8:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN BANG WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN COLONCOLON WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LBRACE RBRACE WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN DOTOP LBRACE RBRACE WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN DOTOP LBRACE SEMI DOTDOT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LBRACE WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LBRACKET RBRACKET WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN DOTOP LBRACKET RBRACKET WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN DOTOP LBRACKET SEMI DOTDOT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LBRACKET WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LPAREN RPAREN WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN DOTOP LPAREN RPAREN WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN DOTOP LPAREN SEMI DOTDOT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LPAREN SEMI WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: LPAREN DOTOP LPAREN WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: LPAREN DOTOP WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: LPAREN LETOP WITH", line 1, characters 7-11:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN LETOP WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN MINUS WITH", line 1, characters 4-8:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN MINUS WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN MINUSDOT WITH", line 1, characters 5-9:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN MINUSDOT WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN MODULE LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 18-26:
+Error: Syntax error
+File "implementation: LPAREN MODULE PERCENT AND WHILE", line 1, characters 15-20:
+Error: Syntax error
+File "implementation: LPAREN MODULE UIDENT COLON UIDENT VAL", line 1, characters 25-28:
+Error: Syntax error
+File "implementation: LPAREN MODULE UIDENT COLON WITH", line 1, characters 18-22:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN MODULE UIDENT COLON WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN MODULE UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LPAREN MODULE WITH", line 1, characters 9-13:
+Error: Syntax error: module-expr expected.
+File "implementation: LPAREN PLUS WITH", line 1, characters 4-8:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN PLUS WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN PLUSDOT WITH", line 1, characters 5-9:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN PLUSDOT WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN PREFIXOP WITH", line 1, characters 5-9:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN PREFIXOP WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN STAR WITH", line 1, characters 4-8:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN STAR WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN UIDENT COLON UNDERSCORE COLONGREATER UNDERSCORE WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLON UNDERSCORE COLONGREATER WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLON UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLON WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLONGREATER LIDENT SEMI", line 1, characters 19-20:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLONGREATER UNDERSCORE WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: LPAREN UIDENT COLONGREATER WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: LPAREN UIDENT WITH", line 1, characters 9-13:
+Error: Syntax error: ')' expected
+File "implementation: LPAREN UIDENT WITH", line 1, characters 0-1:
+ This '(' might be unmatched
+File "implementation: LPAREN WITH", line 1, characters 2-6:
+Error: Syntax error: operator expected.
+File "implementation: MATCH LBRACKETAT AND RBRACKET AND", line 1, characters 15-18:
+Error: Syntax error
+File "implementation: MATCH PERCENT AND VIRTUAL", line 1, characters 12-19:
+Error: Syntax error
+File "implementation: MATCH UIDENT VAL", line 1, characters 13-16:
+Error: Syntax error
+File "implementation: MATCH UIDENT WITH UNDERSCORE MINUSGREATER DOT WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: MATCH UIDENT WITH WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: MATCH WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: MINUSDOT WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 16-21:
+Error: Syntax error
+File "implementation: MODULE PERCENT AND LBRACKET", line 1, characters 13-14:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 44-49:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE EQUAL QUOTED_STRING_EXPR IN", line 1, characters 55-57:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 65-71:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR IN", line 1, characters 31-33:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD", line 1, characters 41-47:
+Error: Syntax error
+File "implementation: MODULE REC UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: MODULE REC WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: MODULE TYPE LBRACKETAT AND RBRACKET WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: MODULE TYPE PERCENT AND WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: MODULE TYPE UIDENT EQUAL UIDENT RPAREN", line 1, characters 28-29:
+Error: Syntax error
+File "implementation: MODULE TYPE UIDENT EQUAL WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: MODULE TYPE UIDENT WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: MODULE TYPE WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON FUNCTOR LBRACKETAT AND RBRACKET WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN MINUSGREATER QUOTED_STRING_EXPR WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN MINUSGREATER WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON FUNCTOR WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON LPAREN UIDENT VAL", line 1, characters 20-23:
+Error: Syntax error: ')' expected
+File "implementation: MODULE UNDERSCORE COLON LPAREN UIDENT VAL", line 1, characters 11-12:
+ This '(' might be unmatched
+File "implementation: MODULE UNDERSCORE COLON LPAREN WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 35-43:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF UIDENT IN", line 1, characters 33-35:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON MODULE TYPE WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON MODULE WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON SIG LBRACKETAT AND RBRACKET WHILE", line 1, characters 24-29:
+Error: Syntax error: 'end' expected
+File "implementation: MODULE UNDERSCORE COLON SIG LBRACKETAT AND RBRACKET WHILE", line 1, characters 11-14:
+ This 'sig' might be unmatched
+File "implementation: MODULE UNDERSCORE COLON SIG SEMISEMI RBRACKET", line 1, characters 18-19:
+Error: Syntax error: 'end' expected
+File "implementation: MODULE UNDERSCORE COLON SIG SEMISEMI RBRACKET", line 1, characters 11-14:
+ This 'sig' might be unmatched
+File "implementation: MODULE UNDERSCORE COLON SIG WITH", line 1, characters 15-19:
+Error: Syntax error: 'end' expected
+File "implementation: MODULE UNDERSCORE COLON SIG WITH", line 1, characters 11-14:
+ This 'sig' might be unmatched
+File "implementation: MODULE UNDERSCORE COLON UIDENT DOT UIDENT WHILE", line 1, characters 27-32:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT DOT WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT EQUAL UIDENT WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT EQUAL WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT LPAREN UIDENT RPAREN WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT MINUSGREATER QUOTED_STRING_EXPR WHILE", line 1, characters 37-42:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT MINUSGREATER WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT VAL", line 1, characters 18-21:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT COLONEQUAL UIDENT WHILE", line 1, characters 47-52:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT COLONEQUAL WITH", line 1, characters 40-44:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT EQUAL UIDENT WHILE", line 1, characters 46-51:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT EQUAL WITH", line 1, characters 39-43:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT COLONEQUAL UNDERSCORE SEMI", line 1, characters 40-41:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT COLONEQUAL WITH", line 1, characters 38-42:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL PRIVATE WITH", line 1, characters 45-49:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL UNDERSCORE AND WITH", line 1, characters 43-47:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL UNDERSCORE SEMI", line 1, characters 39-40:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE UNDERSCORE LETOP", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON UIDENT WITH WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE COLON WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE EQUAL QUOTED_STRING_EXPR IN", line 1, characters 27-29:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE EQUAL UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE EQUAL WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE LPAREN RPAREN WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE COLON UIDENT VAL", line 1, characters 22-25:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE COLON WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE LPAREN WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: MODULE UNDERSCORE WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: MODULE WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: NEW LBRACKETAT AND RBRACKET WHILE", line 1, characters 13-18:
+Error: Syntax error
+File "implementation: NEW PERCENT AND LBRACKET", line 1, characters 10-11:
+Error: Syntax error
+File "implementation: NEW UIDENT DOT WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: NEW UIDENT WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: NEW WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT HASH WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT GREATER", line 1, characters 29-30:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF AMPERSAND WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE AMPERSAND UNDERSCORE WITH", line 1, characters 38-42:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE AMPERSAND WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BAR UNDERSCORE GREATER", line 1, characters 24-25:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET BAR WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE BAR UNDERSCORE GREATER", line 1, characters 26-27:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE BAR WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE RBRACKET", line 1, characters 22-23:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKET WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETAT AND RBRACKET GREATER", line 1, characters 27-28:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETGREATER BAR ASSERT", line 1, characters 23-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETGREATER UNDERSCORE GREATER", line 1, characters 23-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETGREATER WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS BACKQUOTE UIDENT LBRACKETAT AND RBRACKET WHILE", line 1, characters 39-44:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS BAR ASSERT", line 1, characters 23-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE BAR WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE GREATER BACKQUOTE LIDENT WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE GREATER WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LBRACKETLESS WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS DOTDOT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT DOT UNDERSCORE WITH", line 1, characters 42-46:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT DOT WITH", line 1, characters 40-44:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT QUOTE LIDENT WITH", line 1, characters 47-51:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE LBRACKETAT AND RBRACKET FUNCTOR", line 1, characters 40-47:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE RBRACE", line 1, characters 31-32:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE SEMI LBRACKETAT AND RBRACKET CONSTRAINT", line 1, characters 42-52:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE SEMI WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT COLON WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS LIDENT WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS UNDERSCORE SEMI WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS UNDERSCORE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LESS WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LIDENT COLON UNDERSCORE MINUSGREATER WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LIDENT COLON UNDERSCORE WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LIDENT COLON WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LIDENT WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 36-41:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN MODULE PERCENT AND FUNCTION", line 1, characters 33-41:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN MODULE UIDENT VAL", line 1, characters 34-37:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN MODULE WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT COMMA UNDERSCORE WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT COMMA WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT RPAREN HASH WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT RPAREN WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA UNDERSCORE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT LPAREN WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT OPTLABEL UNDERSCORE MINUSGREATER WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT OPTLABEL UNDERSCORE WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT OPTLABEL WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT QUESTION LIDENT WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT QUESTION WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT QUOTE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE AMPERSAND", line 1, characters 20-21:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE AS QUOTE WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE AS WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE EQUAL UNDERSCORE WITH", line 1, characters 24-28:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT CONSTRAINT UNDERSCORE EQUAL UNDERSCORE WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT CONSTRAINT UNDERSCORE EQUAL WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE HASH WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE MINUSGREATER WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE STAR LIDENT STAR UNDERSCORE WHILE", line 1, characters 33-38:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE STAR LIDENT STAR WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE STAR UNDERSCORE WHILE", line 1, characters 24-29:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE STAR WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT UNDERSCORE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT CONSTRAINT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: OBJECT END WHILE", line 1, characters 11-16:
+Error: Syntax error
+File "implementation: OBJECT INHERIT BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 26-31:
+Error: Syntax error
+File "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR AS LIDENT WITH", line 1, characters 43-47:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR AS LIDENT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR WITH", line 1, characters 33-37:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT BANG WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: OBJECT INHERIT FUN LBRACKETAT AND RBRACKET WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: OBJECT INHERIT FUN UNDERSCORE MINUSGREATER QUOTED_STRING_EXPR WITH", line 1, characters 40-44:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT FUN UNDERSCORE MINUSGREATER QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT FUN UNDERSCORE MINUSGREATER WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT INHERIT FUN UNDERSCORE WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT INHERIT FUN WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKET UNDERSCORE COMMA UNDERSCORE WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKET UNDERSCORE COMMA WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKET UNDERSCORE RBRACKET WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKET UNDERSCORE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKET WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LBRACKETAT AND RBRACKET FOR", line 1, characters 24-27:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR IN QUOTED_STRING_EXPR WITH", line 1, characters 48-52:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR IN QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR IN WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR LBRACKETATAT AND RBRACKET VAL", line 1, characters 39-42:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET LBRACKETAT AND RBRACKET WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN BANG UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 52-56:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT LET OPEN BANG UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT LET OPEN BANG UIDENT IN WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN BANG UIDENT WITH", line 1, characters 33-37:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN BANG WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN LBRACKETAT AND RBRACKET WHILE", line 1, characters 33-38:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 50-54:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT LET OPEN UIDENT IN QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT LET OPEN UIDENT IN WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN UIDENT WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET OPEN WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET REC ASSERT", line 1, characters 23-29:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET UNDERSCORE EQUAL CHAR WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LET WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LIDENT UIDENT WITH", line 1, characters 29-33:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT LIDENT UIDENT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT LIDENT WITH", line 1, characters 22-26:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT LIDENT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR COLON QUOTED_STRING_EXPR VAL", line 1, characters 51-54:
+Error: Syntax error: ')' expected
+File "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR COLON QUOTED_STRING_EXPR VAL", line 1, characters 15-16:
+ This '(' might be unmatched
+File "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR COLON WITH", line 1, characters 35-39:
+Error: Syntax error
+File "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR WITH", line 1, characters 33-37:
+Error: Syntax error: ')' expected
+File "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR WITH", line 1, characters 15-16:
+ This '(' might be unmatched
+File "implementation: OBJECT INHERIT LPAREN WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: OBJECT INHERIT OBJECT LBRACKETAT AND RBRACKET WHILE", line 1, characters 31-36:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT OBJECT LBRACKETAT AND RBRACKET WHILE", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT OBJECT LPAREN CHAR RPAREN WITH", line 1, characters 30-34:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT OBJECT LPAREN CHAR RPAREN WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT OBJECT WITH", line 1, characters 22-26:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT OBJECT WITH", line 1, characters 15-21:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT QUOTED_STRING_EXPR AS LIDENT WITH", line 1, characters 41-45:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT QUOTED_STRING_EXPR AS LIDENT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT QUOTED_STRING_EXPR AS WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT INHERIT QUOTED_STRING_EXPR WITH", line 1, characters 31-35:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INHERIT QUOTED_STRING_EXPR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INHERIT WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: OBJECT INITIALIZER LBRACKETAT AND RBRACKET AND", line 1, characters 28-31:
+Error: Syntax error
+File "implementation: OBJECT INITIALIZER UIDENT WITH", line 1, characters 26-30:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT INITIALIZER UIDENT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT INITIALIZER WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT LBRACKETAT AND RBRACKET CLASS", line 1, characters 16-21:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT LBRACKETAT AND RBRACKET CLASS", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT LBRACKETATATAT AND RBRACKET WITH", line 1, characters 18-22:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT LBRACKETATATAT AND RBRACKET WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT LPAREN UNDERSCORE COLON UNDERSCORE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: OBJECT LPAREN UNDERSCORE COLON WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: OBJECT LPAREN UNDERSCORE RPAREN COMMENT", line 1, characters 0-2:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT LPAREN UNDERSCORE RPAREN COMMENT", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT LPAREN UNDERSCORE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: OBJECT LPAREN WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH", line 1, characters 43-47:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH", line 1, characters 41-45:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT WITH", line 1, characters 39-43:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT RPAREN", line 1, characters 37-38:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON TYPE WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON UNDERSCORE EQUAL WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON UNDERSCORE VAL", line 1, characters 27-30:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT COLON WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG LIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG PRIVATE LETOP", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: OBJECT METHOD BANG WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: OBJECT METHOD LBRACKETAT AND RBRACKET WHILE", line 1, characters 23-28:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT DOT UNDERSCORE WITH", line 1, characters 36-40:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT DOT WITH", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT QUOTE LIDENT WITH", line 1, characters 41-45:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH", line 1, characters 41-45:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH", line 1, characters 39-43:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT WITH", line 1, characters 37-41:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT RPAREN", line 1, characters 35-36:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON TYPE WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE EQUAL WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE VAL", line 1, characters 25-28:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT COLON WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: OBJECT METHOD LIDENT EQUAL CHAR WITH", line 1, characters 27-31:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT METHOD LIDENT EQUAL CHAR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT METHOD LIDENT WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT METHOD PRIVATE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT METHOD VIRTUAL LIDENT COLON WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: OBJECT METHOD VIRTUAL LIDENT WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: OBJECT METHOD VIRTUAL PRIVATE WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: OBJECT METHOD VIRTUAL WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT METHOD WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: OBJECT PERCENT AND COLON", line 1, characters 13-14:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT PERCENT AND COLON", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT QUOTED_STRING_ITEM WITH", line 1, characters 24-28:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT QUOTED_STRING_ITEM WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT VAL BANG LBRACKETAT AND RBRACKET WHILE", line 1, characters 22-27:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG LIDENT COLONGREATER LIDENT EQUAL WITH", line 1, characters 32-36:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG LIDENT COLONGREATER LIDENT SEMI", line 1, characters 30-31:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG LIDENT EQUAL WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG LIDENT WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG MUTABLE LETOP", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: OBJECT VAL BANG WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: OBJECT VAL LBRACKETAT AND RBRACKET WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: OBJECT VAL LIDENT COLONGREATER LIDENT EQUAL WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: OBJECT VAL LIDENT COLONGREATER LIDENT SEMI", line 1, characters 28-29:
+Error: Syntax error
+File "implementation: OBJECT VAL LIDENT EQUAL CHAR WITH", line 1, characters 24-28:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT VAL LIDENT EQUAL CHAR WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT VAL LIDENT EQUAL WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OBJECT VAL LIDENT WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: OBJECT VAL MUTABLE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT VAL VIRTUAL LIDENT COLON UNDERSCORE WITH", line 1, characters 30-34:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT VAL VIRTUAL LIDENT COLON UNDERSCORE WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OBJECT VAL VIRTUAL LIDENT COLON WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: OBJECT VAL VIRTUAL LIDENT WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: OBJECT VAL VIRTUAL MUTABLE WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: OBJECT VAL VIRTUAL WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: OBJECT VAL WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: OBJECT WITH", line 1, characters 7-11:
+Error: Syntax error: 'end' expected
+File "implementation: OBJECT WITH", line 1, characters 0-6:
+ This 'object' might be unmatched
+File "implementation: OPEN BANG LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 16-24:
+Error: Syntax error
+File "implementation: OPEN BANG PERCENT AND WHILE", line 1, characters 13-18:
+Error: Syntax error
+File "implementation: OPEN BANG UIDENT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: OPEN BANG WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: OPEN FUNCTOR LBRACKETAT AND RBRACKET WHILE", line 1, characters 22-27:
+Error: Syntax error
+File "implementation: OPEN FUNCTOR LPAREN RPAREN MINUSGREATER QUOTED_STRING_EXPR WHILE", line 1, characters 36-41:
+Error: Syntax error
+File "implementation: OPEN FUNCTOR LPAREN RPAREN MINUSGREATER WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: OPEN FUNCTOR LPAREN RPAREN WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: OPEN FUNCTOR WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: OPEN LBRACKETAT AND RBRACKET FUNCTION", line 1, characters 14-22:
+Error: Syntax error
+File "implementation: OPEN LBRACKETAT AND RBRACKET WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: OPEN LPAREN UIDENT COLON UIDENT VAL", line 1, characters 23-26:
+Error: Syntax error: ')' expected
+File "implementation: OPEN LPAREN UIDENT COLON UIDENT VAL", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: OPEN LPAREN UIDENT COLON WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: OPEN LPAREN UIDENT WITH", line 1, characters 14-18:
+Error: Syntax error: ')' expected
+File "implementation: OPEN LPAREN UIDENT WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: OPEN LPAREN VAL LBRACKETAT AND RBRACKET VIRTUAL", line 1, characters 20-27:
+Error: Syntax error
+File "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT COLONGREATER UIDENT VAL", line 1, characters 37-40:
+Error: Syntax error
+File "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT COLONGREATER WITH", line 1, characters 30-34:
+Error: Syntax error
+File "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT VAL", line 1, characters 27-30:
+Error: Syntax error
+File "implementation: OPEN LPAREN VAL UIDENT COLON WITH", line 1, characters 20-24:
+Error: Syntax error: ')' expected
+File "implementation: OPEN LPAREN VAL UIDENT COLON WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: OPEN LPAREN VAL UIDENT COLONGREATER UIDENT VAL", line 1, characters 28-31:
+Error: Syntax error
+File "implementation: OPEN LPAREN VAL UIDENT COLONGREATER WITH", line 1, characters 21-25:
+Error: Syntax error: ')' expected
+File "implementation: OPEN LPAREN VAL UIDENT COLONGREATER WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: OPEN LPAREN VAL UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error: ')' expected
+File "implementation: OPEN LPAREN VAL UIDENT WITH", line 1, characters 5-6:
+ This '(' might be unmatched
+File "implementation: OPEN LPAREN VAL WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: OPEN LPAREN WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: OPEN PERCENT AND FUNCTION", line 1, characters 11-19:
+Error: Syntax error
+File "implementation: OPEN PERCENT UNDERSCORE", line 1, characters 7-8:
+Error: Syntax error
+File "implementation: OPEN STRUCT LBRACKETAT AND RBRACKET AND", line 1, characters 21-24:
+Error: Syntax error: 'end' expected
+File "implementation: OPEN STRUCT LBRACKETAT AND RBRACKET AND", line 1, characters 5-11:
+ This 'struct' might be unmatched
+File "implementation: OPEN STRUCT UIDENT RBRACKET", line 1, characters 19-20:
+Error: Syntax error: 'end' expected
+File "implementation: OPEN STRUCT UIDENT RBRACKET", line 1, characters 5-11:
+ This 'struct' might be unmatched
+File "implementation: OPEN STRUCT WITH", line 1, characters 12-16:
+Error: Syntax error: 'end' expected
+File "implementation: OPEN STRUCT WITH", line 1, characters 5-11:
+ This 'struct' might be unmatched
+File "implementation: OPEN UIDENT DOT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: OPEN UIDENT LPAREN WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: OPEN UIDENT WHILE", line 1, characters 12-17:
+Error: Syntax error
+File "implementation: OPEN UIDENT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: OPEN WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: PLUSDOT LET CHAR EQUAL CHAR VAL", line 1, characters 17-20:
+Error: Syntax error
+File "implementation: PLUSDOT WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: PREFIXOP WITH", line 1, characters 3-7:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM HASH", line 1, characters 17-18:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LBRACKETATAT AND RBRACKET WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LBRACKETATAT UNDERSCORE", line 1, characters 21-22:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LBRACKETATAT WITH UIDENT WHEN", line 1, characters 34-38:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LBRACKETATAT WITH VIRTUAL", line 1, characters 26-33:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LET CHAR EQUAL CHAR IN", line 1, characters 31-33:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM LET WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: QUOTED_STRING_ITEM WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: STRING TRUE WHILE", line 1, characters 13-18:
+Error: Syntax error
+File "implementation: STRING UIDENT AS", line 1, characters 15-17:
+Error: Syntax error
+File "implementation: STRING WHILE", line 1, characters 8-13:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE", line 1, characters 32-37:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACE UIDENT RBRACE LESSMINUS WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACE UIDENT RBRACE WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACE UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error: '}' expected
+File "implementation: TRUE DOT LBRACE UIDENT WITH", line 1, characters 7-8:
+ This '{' might be unmatched
+File "implementation: TRUE DOT LBRACE WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE", line 1, characters 32-37:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACKET UIDENT RBRACKET WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: TRUE DOT LBRACKET UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error: ']' expected
+File "implementation: TRUE DOT LBRACKET UIDENT WITH", line 1, characters 7-8:
+ This '[' might be unmatched
+File "implementation: TRUE DOT LBRACKET WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: TRUE DOT LIDENT LESSMINUS OBJECT END WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: TRUE DOT LIDENT LESSMINUS WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: TRUE DOT LIDENT WHILE", line 1, characters 14-19:
+Error: Syntax error
+File "implementation: TRUE DOT LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE", line 1, characters 32-37:
+Error: Syntax error
+File "implementation: TRUE DOT LPAREN UIDENT RPAREN LESSMINUS WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TRUE DOT LPAREN UIDENT RPAREN WHILE", line 1, characters 18-23:
+Error: Syntax error
+File "implementation: TRUE DOT LPAREN UIDENT WITH", line 1, characters 16-20:
+Error: Syntax error: ')' expected
+File "implementation: TRUE DOT LPAREN UIDENT WITH", line 1, characters 7-8:
+ This '(' might be unmatched
+File "implementation: TRUE DOT LPAREN WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN", line 1, characters 26-27:
+Error: Syntax error: '}' expected
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN", line 1, characters 17-18:
+ This '{' might be unmatched
+File "implementation: TRUE DOT UIDENT DOTOP LBRACE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 26-27:
+Error: Syntax error: ']' expected
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 17-18:
+ This '[' might be unmatched
+File "implementation: TRUE DOT UIDENT DOTOP LBRACKET WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 26-27:
+Error: Syntax error: ')' expected
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 17-18:
+ This '(' might be unmatched
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE", line 1, characters 42-47:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN WHILE", line 1, characters 28-33:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP LPAREN WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT DOTOP WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: TRUE DOT UIDENT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: TRUE DOT WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TRY LBRACKETAT AND RBRACKET AND", line 1, characters 13-16:
+Error: Syntax error
+File "implementation: TRY PERCENT AND VIRTUAL", line 1, characters 10-17:
+Error: Syntax error
+File "implementation: TRY UIDENT VAL", line 1, characters 11-14:
+Error: Syntax error
+File "implementation: TRY UIDENT WITH UNDERSCORE MINUSGREATER DOT WHILE", line 1, characters 23-28:
+Error: Syntax error
+File "implementation: TRY UIDENT WITH WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TRY WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: TYPE BANG WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE LBRACKETAT AND RBRACKET BACKQUOTE", line 1, characters 14-15:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND LBRACKETAT AND RBRACKET WHILE", line 1, characters 25-30:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND LIDENT EQUAL DOTDOT AMPERSAND", line 1, characters 28-29:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND LIDENT LBRACKETATAT AND RBRACKET METHOD", line 1, characters 33-39:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND LIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND UNDERSCORE LETOP", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: TYPE LIDENT AND WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE EQUAL UNDERSCORE SEMI", line 1, characters 29-30:
+Error: Syntax error
+File "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE EQUAL WITH", line 1, characters 27-31:
+Error: Syntax error
+File "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: TYPE LIDENT CONSTRAINT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL BAR UIDENT OF LIDENT IN", line 1, characters 33-35:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL BAR UIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL BAR WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL DOTDOT AMPERSAND", line 1, characters 17-18:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL LBRACE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL LBRACKET WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL LPAREN WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL PRIVATE LBRACE WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL PRIVATE UNDERSCORE WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL PRIVATE WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL TRUE WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UIDENT BAR WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UIDENT LBRACKETAT AND RBRACKET WHILE", line 1, characters 30-35:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UIDENT OF LIDENT IN", line 1, characters 31-33:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UIDENT WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL LBRACE WITH", line 1, characters 20-24:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL PRIVATE LBRACE WITH", line 1, characters 28-32:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL PRIVATE WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL WITH", line 1, characters 18-22:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL UNDERSCORE WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: TYPE LIDENT EQUAL WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: TYPE LIDENT LBRACKETATAT WITH RBRACKET METHOD", line 1, characters 23-29:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ BAR UIDENT EQUAL TRUE WITH", line 1, characters 31-35:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ BAR UIDENT EQUAL WITH", line 1, characters 26-30:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ BAR UIDENT WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ BAR WITH", line 1, characters 17-21:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ PRIVATE BANG", line 1, characters 23-24:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ UIDENT EQUAL TRUE WITH", line 1, characters 29-33:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ UIDENT EQUAL WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ UIDENT OF LIDENT CONSTRAINT", line 1, characters 32-42:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ UIDENT WITH", line 1, characters 22-26:
+Error: Syntax error
+File "implementation: TYPE LIDENT PLUSEQ WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: TYPE LIDENT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: TYPE LPAREN UNDERSCORE COMMA WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: TYPE LPAREN UNDERSCORE WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: TYPE LPAREN WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE MINUS WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE NONREC LIDENT EQUAL DOTDOT AMPERSAND", line 1, characters 24-25:
+Error: Syntax error
+File "implementation: TYPE NONREC LIDENT WITH", line 1, characters 19-23:
+Error: Syntax error
+File "implementation: TYPE NONREC UNDERSCORE LETOP", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: TYPE NONREC WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: TYPE PERCENT AND WHILE", line 1, characters 11-16:
+Error: Syntax error
+File "implementation: TYPE PLUS WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE PREFIXOP WITH", line 1, characters 8-12:
+Error: Syntax error
+File "implementation: TYPE QUOTE WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE UIDENT DOT LIDENT WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TYPE UIDENT DOT WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: TYPE UIDENT LPAREN UIDENT DOT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: TYPE UIDENT LPAREN UIDENT WITH", line 1, characters 21-25:
+Error: Syntax error
+File "implementation: TYPE UIDENT LPAREN WITH", line 1, characters 14-18:
+Error: Syntax error: module path expected.
+File "implementation: TYPE UIDENT WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: TYPE UNDERSCORE LETOP", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: TYPE WITH", line 1, characters 5-9:
+Error: Syntax error
+File "implementation: UIDENT AMPERAMPER OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT AMPERAMPER WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT AMPERSAND OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT AMPERSAND WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT AS", line 1, characters 7-9:
+Error: Syntax error
+File "implementation: UIDENT BARBAR OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT BARBAR WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT COLONCOLON OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT COLONCOLON WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT COLONEQUAL OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT COLONEQUAL WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT COMMA CHAR COMMA OBJECT END WHILE", line 1, characters 26-31:
+Error: Syntax error
+File "implementation: UIDENT COMMA CHAR COMMA WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: UIDENT COMMA OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT COMMA WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT DOT LBRACE WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: UIDENT DOT LBRACELESS WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT DOT LBRACKET UIDENT RPAREN", line 1, characters 18-19:
+Error: Syntax error: ']' expected
+File "implementation: UIDENT DOT LBRACKET UIDENT RPAREN", line 1, characters 9-10:
+ This '[' might be unmatched
+File "implementation: UIDENT DOT LBRACKET WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: UIDENT DOT LBRACKETBAR UIDENT RPAREN", line 1, characters 19-20:
+Error: Syntax error: '|]' expected
+File "implementation: UIDENT DOT LBRACKETBAR UIDENT RPAREN", line 1, characters 9-11:
+ This '[|' might be unmatched
+File "implementation: UIDENT DOT LBRACKETBAR WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN COLONCOLON WITH", line 1, characters 14-18:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN MODULE LBRACKETAT AND RBRACKET WHILE", line 1, characters 27-32:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN MODULE PERCENT AND FUNCTION", line 1, characters 24-32:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN MODULE UIDENT COLON UIDENT VAL", line 1, characters 34-37:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN MODULE UIDENT COLON WITH", line 1, characters 27-31:
+Error: Syntax error: ')' expected
+File "implementation: UIDENT DOT LPAREN MODULE UIDENT COLON WITH", line 1, characters 9-10:
+ This '(' might be unmatched
+File "implementation: UIDENT DOT LPAREN MODULE UIDENT WITH", line 1, characters 25-29:
+Error: Syntax error
+File "implementation: UIDENT DOT LPAREN MODULE WITH", line 1, characters 18-22:
+Error: Syntax error: module-expr expected.
+File "implementation: UIDENT DOT LPAREN UIDENT WITH", line 1, characters 18-22:
+Error: Syntax error: ')' expected
+File "implementation: UIDENT DOT LPAREN UIDENT WITH", line 1, characters 9-10:
+ This '(' might be unmatched
+File "implementation: UIDENT DOT LPAREN WITH", line 1, characters 11-15:
+Error: Syntax error: operator expected.
+File "implementation: UIDENT DOT WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACE UIDENT SEMI RPAREN", line 1, characters 21-22:
+Error: Syntax error: '}' expected
+File "implementation: UIDENT DOTOP LBRACE UIDENT SEMI RPAREN", line 1, characters 10-11:
+ This '{' might be unmatched
+File "implementation: UIDENT DOTOP LBRACE UIDENT WITH", line 1, characters 19-23:
+Error: Syntax error: '}' expected
+File "implementation: UIDENT DOTOP LBRACE UIDENT WITH", line 1, characters 10-11:
+ This '{' might be unmatched
+File "implementation: UIDENT DOTOP LBRACE WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 19-20:
+Error: Syntax error: ']' expected
+File "implementation: UIDENT DOTOP LBRACKET UIDENT RPAREN", line 1, characters 10-11:
+ This '[' might be unmatched
+File "implementation: UIDENT DOTOP LBRACKET WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 19-20:
+Error: Syntax error: ')' expected
+File "implementation: UIDENT DOTOP LPAREN UIDENT RBRACKET", line 1, characters 10-11:
+ This '(' might be unmatched
+File "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE", line 1, characters 35-40:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS WITH", line 1, characters 24-28:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT DOTOP LPAREN WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT DOTOP WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT EQUAL OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT EQUAL WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT GREATER OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT GREATER WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT HASH WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT HASHOP TRUE WHILE", line 1, characters 15-20:
+Error: Syntax error
+File "implementation: UIDENT HASHOP WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP0 OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP0 WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP1 OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP1 WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP2 OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP2 WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP3 OBJECT END WHILE", line 1, characters 23-28:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP3 WITH", line 1, characters 12-16:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP4 OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT INFIXOP4 WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT LABEL TRUE WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT LABEL WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: UIDENT LBRACKETAT UNDERSCORE", line 1, characters 10-11:
+Error: Syntax error
+File "implementation: UIDENT LBRACKETAT WITH UIDENT WHEN", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: UIDENT LBRACKETAT WITH VIRTUAL", line 1, characters 15-22:
+Error: Syntax error
+File "implementation: UIDENT LBRACKETATAT AND RBRACKET AND", line 1, characters 17-20:
+Error: Syntax error
+File "implementation: UIDENT LESS OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT LESS WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT MINUS OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT MINUS WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT MINUSDOT OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT MINUSDOT WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT OPTLABEL TRUE WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT OPTLABEL WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: UIDENT OR OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT OR WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT PERCENT OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT PERCENT WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT PLUS OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT PLUS WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT PLUSDOT OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT PLUSDOT WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT PLUSEQ OBJECT END WHILE", line 1, characters 21-26:
+Error: Syntax error
+File "implementation: UIDENT PLUSEQ WITH", line 1, characters 10-14:
+Error: Syntax error
+File "implementation: UIDENT QUESTION WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT RBRACKET", line 1, characters 7-8:
+Error: Syntax error
+File "implementation: UIDENT SEMI PERCENT UNDERSCORE", line 1, characters 11-12:
+Error: Syntax error
+File "implementation: UIDENT SEMI PERCENT WITH VIRTUAL", line 1, characters 16-23:
+Error: Syntax error
+File "implementation: UIDENT SEMI WHEN", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT STAR OBJECT END WHILE", line 1, characters 20-25:
+Error: Syntax error
+File "implementation: UIDENT STAR WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT TILDE WITH", line 1, characters 9-13:
+Error: Syntax error
+File "implementation: UIDENT UIDENT UIDENT", line 1, characters 14-20:
+Error: Syntax error
+File "implementation: UIDENT WHILE", line 1, characters 7-12:
+Error: Syntax error
+File "implementation: UIDENT WITH", line 1, characters 7-11:
+Error: Syntax error
+File "implementation: VAL LBRACKETAT AND RBRACKET WHILE", line 1, characters 13-18:
+Error: Syntax error
+File "implementation: VAL LIDENT COLON UNDERSCORE WITH", line 1, characters 15-19:
+Error: Syntax error
+File "implementation: VAL LIDENT COLON WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: VAL LIDENT WITH", line 1, characters 11-15:
+Error: Syntax error
+File "implementation: VAL PERCENT AND LBRACKET", line 1, characters 10-11:
+Error: Syntax error
+File "implementation: VAL WITH", line 1, characters 4-8:
+Error: Syntax error
+File "implementation: WHILE LBRACKETAT WITH RBRACKET AND", line 1, characters 16-19:
+Error: Syntax error
+File "implementation: WHILE PERCENT WITH VIRTUAL", line 1, characters 13-20:
+Error: Syntax error
+File "implementation: WHILE UIDENT DO UIDENT WITH", line 1, characters 23-27:
+Error: Syntax error
+File "implementation: WHILE UIDENT DO WITH", line 1, characters 16-20:
+Error: Syntax error
+File "implementation: WHILE UIDENT WITH", line 1, characters 13-17:
+Error: Syntax error
+File "implementation: WHILE WITH", line 1, characters 6-10:
+Error: Syntax error
+File "implementation: WITH", line 1, characters 0-4:
+Error: Syntax error
+
--- /dev/null
+(* TEST
+ * toplevel
+*)
+#0 "use_file: HASH LIDENT TRUE WITH"
+# lident true with
+;;
+#0 "use_file: QUOTED_STRING_ITEM RBRACKET"
+{%%hello|world|} ]
+;;
+#0 "use_file: UIDENT LBRACKETATAT AND RBRACKET AND"
+UIdent [@@ and ] and
+;;
+#0 "use_file: UIDENT WITH"
+UIdent with
+;;
+#0 "use_file: WITH"
+with
+;;
+#0 "toplevel_phrase: HASH UIDENT UIDENT DOT WITH"
+# UIdent UIdent . with
+;;
+#0 "toplevel_phrase: HASH UIDENT UIDENT WITH"
+# UIdent UIdent with
+;;
+#0 "toplevel_phrase: HASH UIDENT VAL"
+# UIdent val
+;;
+#0 "toplevel_phrase: HASH UIDENT WITH"
+# UIdent with
+;;
+#0 "toplevel_phrase: HASH WITH"
+# with
+;;
+#0 "toplevel_phrase: QUOTED_STRING_ITEM RBRACKET"
+{%%hello|world|} ]
+;;
+#0 "toplevel_phrase: UIDENT LBRACKETATAT AND RBRACKET VAL"
+UIdent [@@ and ] val
+;;
+#0 "toplevel_phrase: UIDENT WITH"
+UIdent with
+;;
+#0 "toplevel_phrase: WITH"
+with
+;;
+#0 "implementation: ASSERT LBRACKETAT AND RBRACKET ASSERT"
+assert [@ and ] assert
+;;
+#0 "implementation: ASSERT PERCENT AND ASSERT"
+assert % and assert
+;;
+#0 "implementation: ASSERT UIDENT UIDENT"
+assert UIdent UIdent
+;;
+#0 "implementation: ASSERT WITH"
+assert with
+;;
+#0 "implementation: BACKQUOTE UIDENT UIDENT UIDENT"
+` UIdent UIdent UIdent
+;;
+#0 "implementation: BACKQUOTE UIDENT WHILE"
+` UIdent while
+;;
+#0 "implementation: BACKQUOTE WITH"
+` with
+;;
+#0 "implementation: BANG WITH"
+! with
+;;
+#0 "implementation: BEGIN LBRACKETAT AND RBRACKET AND"
+begin [@ and ] and
+;;
+#0 "implementation: BEGIN PERCENT AND VIRTUAL"
+begin % and virtual
+;;
+#0 "implementation: BEGIN UIDENT WITH"
+begin UIdent with
+;;
+#0 "implementation: BEGIN WITH"
+begin with
+;;
+#0 "implementation: CLASS LBRACKET UNDERSCORE RBRACKET WITH"
+class [ _ ] with
+;;
+#0 "implementation: CLASS LBRACKET UNDERSCORE WITH"
+class [ _ with
+;;
+#0 "implementation: CLASS LBRACKET WITH"
+class [ with
+;;
+#0 "implementation: CLASS LBRACKETAT AND RBRACKET LBRACELESS"
+class [@ and ] {<
+;;
+#0 "implementation: CLASS LIDENT COLON LBRACKET UNDERSCORE RBRACKET WITH"
+class lident : [ _ ] with
+;;
+#0 "implementation: CLASS LIDENT COLON LBRACKET UNDERSCORE WITH"
+class lident : [ _ with
+;;
+#0 "implementation: CLASS LIDENT COLON LBRACKET WITH"
+class lident : [ with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN BANG LBRACKETAT AND RBRACKET WHILE"
+class lident : let open ! [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT IN QUOTED_STRING_EXPR WITH"
+class lident : let open ! UIdent in {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT IN WITH"
+class lident : let open ! UIdent in with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN BANG UIDENT WITH"
+class lident : let open ! UIdent with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN BANG WITH"
+class lident : let open ! with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN LBRACKETAT AND RBRACKET WHILE"
+class lident : let open [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN UIDENT IN QUOTED_STRING_EXPR WITH"
+class lident : let open UIdent in {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN UIDENT IN WITH"
+class lident : let open UIdent in with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN UIDENT WITH"
+class lident : let open UIdent with
+;;
+#0 "implementation: CLASS LIDENT COLON LET OPEN WITH"
+class lident : let open with
+;;
+#0 "implementation: CLASS LIDENT COLON LET WITH"
+class lident : let with
+;;
+#0 "implementation: CLASS LIDENT COLON LIDENT COLON UNDERSCORE MINUSGREATER WITH"
+class lident : lident : _ -> with
+;;
+#0 "implementation: CLASS LIDENT COLON LIDENT COLON UNDERSCORE WITH"
+class lident : lident : _ with
+;;
+#0 "implementation: CLASS LIDENT COLON LIDENT COLON WITH"
+class lident : lident : with
+;;
+#0 "implementation: CLASS LIDENT COLON LIDENT WITH"
+class lident : lident with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT LBRACKETAT AND RBRACKET WHILE"
+class lident : object constraint [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT UNDERSCORE EQUAL LIDENT INITIALIZER"
+class lident : object constraint _ = lident initializer
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT CONSTRAINT WITH"
+class lident : object constraint with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT END WITH"
+class lident : object end with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT INHERIT LBRACKETAT AND RBRACKET WHILE"
+class lident : object inherit [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT INHERIT QUOTED_STRING_EXPR WITH"
+class lident : object inherit {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT INHERIT WITH"
+class lident : object inherit with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT LBRACKETAT AND RBRACKET WHILE"
+class lident : object [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT LBRACKETATATAT AND RBRACKET WITH"
+class lident : object [@@@ and ] with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT LPAREN UNDERSCORE RPAREN WITH"
+class lident : object ( _ ) with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT LPAREN UNDERSCORE WITH"
+class lident : object ( _ with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT LPAREN WITH"
+class lident : object ( with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD LBRACKETAT AND RBRACKET WHILE"
+class lident : object method [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT COLON UNDERSCORE INITIALIZER"
+class lident : object method lident : _ initializer
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT COLON WITH"
+class lident : object method lident : with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD LIDENT WITH"
+class lident : object method lident with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD PRIVATE WITH"
+class lident : object method private with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD VIRTUAL PRIVATE WITH"
+class lident : object method virtual private with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD VIRTUAL WITH"
+class lident : object method virtual with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT METHOD WITH"
+class lident : object method with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT QUOTED_STRING_ITEM WITH"
+class lident : object {%%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL LBRACKETAT AND RBRACKET WHILE"
+class lident : object val [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT COLON UNDERSCORE WITH"
+class lident : object val lident : _ with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT COLON WITH"
+class lident : object val lident : with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL LIDENT WITH"
+class lident : object val lident with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL MUTABLE WITH"
+class lident : object val mutable with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL VIRTUAL MUTABLE WITH"
+class lident : object val virtual mutable with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL VIRTUAL WITH"
+class lident : object val virtual with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT VAL WITH"
+class lident : object val with
+;;
+#0 "implementation: CLASS LIDENT COLON OBJECT WITH"
+class lident : object with
+;;
+#0 "implementation: CLASS LIDENT COLON OPTLABEL UNDERSCORE MINUSGREATER WITH"
+class lident : ?label: _ -> with
+;;
+#0 "implementation: CLASS LIDENT COLON OPTLABEL UNDERSCORE WITH"
+class lident : ?label: _ with
+;;
+#0 "implementation: CLASS LIDENT COLON OPTLABEL WITH"
+class lident : ?label: with
+;;
+#0 "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR EQUAL QUOTED_STRING_EXPR WITH"
+class lident : {%hello|world|} = {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR EQUAL WITH"
+class lident : {%hello|world|} = with
+;;
+#0 "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR VAL"
+class lident : {%hello|world|} val
+;;
+#0 "implementation: CLASS LIDENT COLON QUOTED_STRING_EXPR WITH"
+class lident : {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT COLON UIDENT DOT LIDENT WITH"
+class lident : UIdent . lident with
+;;
+#0 "implementation: CLASS LIDENT COLON UNDERSCORE MINUSGREATER WITH"
+class lident : _ -> with
+;;
+#0 "implementation: CLASS LIDENT COLON UNDERSCORE WITH"
+class lident : _ with
+;;
+#0 "implementation: CLASS LIDENT COLON WITH"
+class lident : with
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH"
+class lident = {%hello|world|} and [ _ ] with
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE"
+class lident = {%hello|world|} and [@ and ] while
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL LIDENT LBRACKETATAT AND RBRACKET METHOD"
+class lident = {%hello|world|} and lident = lident [@@ and ] method
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT WITH"
+class lident = {%hello|world|} and lident with
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS"
+class lident = {%hello|world|} and virtual {<
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR AND WITH"
+class lident = {%hello|world|} and with
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+class lident = {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: CLASS LIDENT EQUAL QUOTED_STRING_EXPR WITH"
+class lident = {%hello|world|} with
+;;
+#0 "implementation: CLASS LIDENT EQUAL WITH"
+class lident = with
+;;
+#0 "implementation: CLASS LIDENT UNDERSCORE WITH"
+class lident _ with
+;;
+#0 "implementation: CLASS LIDENT WITH"
+class lident with
+;;
+#0 "implementation: CLASS PERCENT AND LBRACELESS"
+class % and {<
+;;
+#0 "implementation: CLASS TYPE LBRACKET UNDERSCORE RBRACKET WITH"
+class type [ _ ] with
+;;
+#0 "implementation: CLASS TYPE LBRACKETAT AND RBRACKET LBRACELESS"
+class type [@ and ] {<
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL LBRACKET WITH"
+class type lident = [ with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH"
+class type lident = {%hello|world|} and [ _ ] with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET LBRACELESS"
+class type lident = {%hello|world|} and [@ and ] {<
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+class type lident = {%hello|world|} and lident = {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL QUOTED_STRING_EXPR WITH"
+class type lident = {%hello|world|} and lident = {%hello|world|} with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT EQUAL WITH"
+class type lident = {%hello|world|} and lident = with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND LIDENT WITH"
+class type lident = {%hello|world|} and lident with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS"
+class type lident = {%hello|world|} and virtual {<
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR AND WITH"
+class type lident = {%hello|world|} and with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+class type lident = {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL QUOTED_STRING_EXPR WITH"
+class type lident = {%hello|world|} with
+;;
+#0 "implementation: CLASS TYPE LIDENT EQUAL WITH"
+class type lident = with
+;;
+#0 "implementation: CLASS TYPE LIDENT WITH"
+class type lident with
+;;
+#0 "implementation: CLASS TYPE PERCENT AND LBRACELESS"
+class type % and {<
+;;
+#0 "implementation: CLASS TYPE VIRTUAL LBRACELESS"
+class type virtual {<
+;;
+#0 "implementation: CLASS TYPE WITH"
+class type with
+;;
+#0 "implementation: CLASS VIRTUAL LBRACELESS"
+class virtual {<
+;;
+#0 "implementation: CLASS WITH"
+class with
+;;
+#0 "implementation: EXCEPTION LBRACKET WITH"
+exception [ with
+;;
+#0 "implementation: EXCEPTION LBRACKETAT AND RBRACKET EXTERNAL"
+exception [@ and ] external
+;;
+#0 "implementation: EXCEPTION LPAREN COLONCOLON WITH"
+exception ( :: with
+;;
+#0 "implementation: EXCEPTION LPAREN WITH"
+exception ( with
+;;
+#0 "implementation: EXCEPTION PERCENT AND EXTERNAL"
+exception % and external
+;;
+#0 "implementation: EXCEPTION UIDENT COLON UNDERSCORE MINUSGREATER UNDERSCORE WITH"
+exception UIdent : _ -> _ with
+;;
+#0 "implementation: EXCEPTION UIDENT COLON UNDERSCORE MINUSGREATER WITH"
+exception UIdent : _ -> with
+;;
+#0 "implementation: EXCEPTION UIDENT COLON UNDERSCORE STAR LIDENT VAL"
+exception UIdent : _ * lident val
+;;
+#0 "implementation: EXCEPTION UIDENT COLON UNDERSCORE WITH"
+exception UIdent : _ with
+;;
+#0 "implementation: EXCEPTION UIDENT COLON WITH"
+exception UIdent : with
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL LPAREN WITH"
+exception UIdent = ( with
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL UIDENT BAR"
+exception UIdent = UIdent |
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL UIDENT DOT LPAREN WITH"
+exception UIdent = UIdent . ( with
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL UIDENT DOT WITH"
+exception UIdent = UIdent . with
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL UIDENT LBRACKETAT AND RBRACKET WHILE"
+exception UIdent = UIdent [@ and ] while
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL UIDENT WITH"
+exception UIdent = UIdent with
+;;
+#0 "implementation: EXCEPTION UIDENT EQUAL WITH"
+exception UIdent = with
+;;
+#0 "implementation: EXCEPTION UIDENT LBRACKETAT AND RBRACKET CHAR"
+exception UIdent [@ and ] 'a'
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON LIDENT SEMI LBRACKETAT AND RBRACKET WHILE"
+exception UIdent of { lident : lident ; [@ and ] while
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE GREATER"
+exception UIdent of { lident : _ >
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE LBRACKETAT AND RBRACKET WHILE"
+exception UIdent of { lident : _ [@ and ] while
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON UNDERSCORE SEMI WITH"
+exception UIdent of { lident : _ ; with
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT COLON WITH"
+exception UIdent of { lident : with
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE LIDENT WITH"
+exception UIdent of { lident with
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE MUTABLE LETOP"
+exception UIdent of { mutable let*
+;;
+#0 "implementation: EXCEPTION UIDENT OF LBRACE WITH"
+exception UIdent of { with
+;;
+#0 "implementation: EXCEPTION UIDENT OF LIDENT BAR"
+exception UIdent of lident |
+;;
+#0 "implementation: EXCEPTION UIDENT OF UNDERSCORE STAR UNDERSCORE WITH"
+exception UIdent of _ * _ with
+;;
+#0 "implementation: EXCEPTION UIDENT OF UNDERSCORE STAR WITH"
+exception UIdent of _ * with
+;;
+#0 "implementation: EXCEPTION UIDENT OF UNDERSCORE WITH"
+exception UIdent of _ with
+;;
+#0 "implementation: EXCEPTION UIDENT OF WITH"
+exception UIdent of with
+;;
+#0 "implementation: EXCEPTION UIDENT WITH"
+exception UIdent with
+;;
+#0 "implementation: EXCEPTION WITH"
+exception with
+;;
+#0 "implementation: EXTERNAL LBRACKETAT AND RBRACKET WHILE"
+external [@ and ] while
+;;
+#0 "implementation: EXTERNAL LIDENT COLON UNDERSCORE EQUAL STRING WITH"
+external lident : _ = "hello" with
+;;
+#0 "implementation: EXTERNAL LIDENT COLON UNDERSCORE EQUAL WITH"
+external lident : _ = with
+;;
+#0 "implementation: EXTERNAL LIDENT COLON UNDERSCORE WITH"
+external lident : _ with
+;;
+#0 "implementation: EXTERNAL LIDENT COLON WITH"
+external lident : with
+;;
+#0 "implementation: EXTERNAL LIDENT WITH"
+external lident with
+;;
+#0 "implementation: EXTERNAL LPAREN MODULE WITH"
+external ( module with
+;;
+#0 "implementation: EXTERNAL LPAREN WITH"
+external ( with
+;;
+#0 "implementation: EXTERNAL PERCENT AND LBRACKET"
+external % and [
+;;
+#0 "implementation: EXTERNAL WITH"
+external with
+;;
+#0 "implementation: FOR LBRACKETAT AND RBRACKET ASSERT"
+for [@ and ] assert
+;;
+#0 "implementation: FOR PERCENT AND ASSERT"
+for % and assert
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT DO UIDENT WITH"
+for _ = UIdent to UIdent do UIdent with
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT DO WITH"
+for _ = UIdent to UIdent do with
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL UIDENT TO UIDENT WITH"
+for _ = UIdent to UIdent with
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL UIDENT TO WITH"
+for _ = UIdent to with
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL UIDENT WITH"
+for _ = UIdent with
+;;
+#0 "implementation: FOR UNDERSCORE EQUAL WITH"
+for _ = with
+;;
+#0 "implementation: FOR UNDERSCORE WITH"
+for _ with
+;;
+#0 "implementation: FOR WITH"
+for with
+;;
+#0 "implementation: FUN LABEL WITH"
+fun ~label: with
+;;
+#0 "implementation: FUN LBRACKETAT AND RBRACKET ASSERT"
+fun [@ and ] assert
+;;
+#0 "implementation: FUN LPAREN TYPE LIDENT DOT"
+fun ( type lident .
+;;
+#0 "implementation: FUN LPAREN TYPE LIDENT RPAREN WITH"
+fun ( type lident ) with
+;;
+#0 "implementation: FUN LPAREN TYPE LIDENT WITH"
+fun ( type lident with
+;;
+#0 "implementation: FUN LPAREN TYPE WITH"
+fun ( type with
+;;
+#0 "implementation: FUN LPAREN WITH"
+fun ( with
+;;
+#0 "implementation: FUN OPTLABEL LPAREN UNDERSCORE COLON UNDERSCORE WITH"
+fun ?label: ( _ : _ with
+;;
+#0 "implementation: FUN OPTLABEL LPAREN UNDERSCORE COLON WITH"
+fun ?label: ( _ : with
+;;
+#0 "implementation: FUN OPTLABEL LPAREN UNDERSCORE EQUAL CHAR WITH"
+fun ?label: ( _ = 'a' with
+;;
+#0 "implementation: FUN OPTLABEL LPAREN UNDERSCORE WITH"
+fun ?label: ( _ with
+;;
+#0 "implementation: FUN OPTLABEL LPAREN WITH"
+fun ?label: ( with
+;;
+#0 "implementation: FUN OPTLABEL WITH"
+fun ?label: with
+;;
+#0 "implementation: FUN PERCENT AND ASSERT"
+fun % and assert
+;;
+#0 "implementation: FUN QUESTION LPAREN LIDENT EQUAL UIDENT WITH"
+fun ? ( lident = UIdent with
+;;
+#0 "implementation: FUN QUESTION LPAREN LIDENT EQUAL WITH"
+fun ? ( lident = with
+;;
+#0 "implementation: FUN QUESTION LPAREN WITH"
+fun ? ( with
+;;
+#0 "implementation: FUN QUESTION WITH"
+fun ? with
+;;
+#0 "implementation: FUN TILDE LPAREN LIDENT COLON UNDERSCORE WITH"
+fun ~ ( lident : _ with
+;;
+#0 "implementation: FUN TILDE LPAREN LIDENT COLON WITH"
+fun ~ ( lident : with
+;;
+#0 "implementation: FUN TILDE LPAREN LIDENT EQUAL"
+fun ~ ( lident =
+;;
+#0 "implementation: FUN TILDE LPAREN LIDENT WITH"
+fun ~ ( lident with
+;;
+#0 "implementation: FUN TILDE LPAREN WITH"
+fun ~ ( with
+;;
+#0 "implementation: FUN TILDE WITH"
+fun ~ with
+;;
+#0 "implementation: FUN UNDERSCORE COLON UNDERSCORE MINUSGREATER WITH"
+fun _ : _ -> with
+;;
+#0 "implementation: FUN UNDERSCORE COLON UNDERSCORE WITH"
+fun _ : _ with
+;;
+#0 "implementation: FUN UNDERSCORE COLON WITH"
+fun _ : with
+;;
+#0 "implementation: FUN UNDERSCORE LPAREN TYPE LIDENT DOT"
+fun _ ( type lident .
+;;
+#0 "implementation: FUN UNDERSCORE LPAREN TYPE LIDENT RPAREN WITH"
+fun _ ( type lident ) with
+;;
+#0 "implementation: FUN UNDERSCORE LPAREN TYPE WITH"
+fun _ ( type with
+;;
+#0 "implementation: FUN UNDERSCORE LPAREN WITH"
+fun _ ( with
+;;
+#0 "implementation: FUN UNDERSCORE MINUSGREATER WITH"
+fun _ -> with
+;;
+#0 "implementation: FUN UNDERSCORE UNDERSCORE WITH"
+fun _ _ with
+;;
+#0 "implementation: FUN UNDERSCORE WITH"
+fun _ with
+;;
+#0 "implementation: FUN WITH"
+fun with
+;;
+#0 "implementation: FUNCTION BAR WITH"
+function | with
+;;
+#0 "implementation: FUNCTION EXCEPTION LBRACKETAT AND RBRACKET ASSERT"
+function exception [@ and ] assert
+;;
+#0 "implementation: FUNCTION EXCEPTION PERCENT AND ASSERT"
+function exception % and assert
+;;
+#0 "implementation: FUNCTION EXCEPTION WITH"
+function exception with
+;;
+#0 "implementation: FUNCTION LBRACKETAT AND RBRACKET ASSERT"
+function [@ and ] assert
+;;
+#0 "implementation: FUNCTION PERCENT AND ASSERT"
+function % and assert
+;;
+#0 "implementation: FUNCTION UNDERSCORE AS WITH"
+function _ as with
+;;
+#0 "implementation: FUNCTION UNDERSCORE BAR UNDERSCORE WITH"
+function _ | _ with
+;;
+#0 "implementation: FUNCTION UNDERSCORE BAR WITH"
+function _ | with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COLONCOLON UNDERSCORE WITH"
+function _ :: _ with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COLONCOLON WITH"
+function _ :: with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COMMA CHAR COMMA UNDERSCORE WITH"
+function _ , 'a' , _ with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COMMA CHAR COMMA WITH"
+function _ , 'a' , with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COMMA UNDERSCORE WITH"
+function _ , _ with
+;;
+#0 "implementation: FUNCTION UNDERSCORE COMMA WITH"
+function _ , with
+;;
+#0 "implementation: FUNCTION UNDERSCORE MINUSGREATER CHAR BAR WITH"
+function _ -> 'a' | with
+;;
+#0 "implementation: FUNCTION UNDERSCORE MINUSGREATER DOT WHILE"
+function _ -> . while
+;;
+#0 "implementation: FUNCTION UNDERSCORE MINUSGREATER WITH"
+function _ -> with
+;;
+#0 "implementation: FUNCTION UNDERSCORE WHEN UIDENT MINUSGREATER WITH"
+function _ when UIdent -> with
+;;
+#0 "implementation: FUNCTION UNDERSCORE WHEN UIDENT WITH"
+function _ when UIdent with
+;;
+#0 "implementation: FUNCTION UNDERSCORE WHEN WITH"
+function _ when with
+;;
+#0 "implementation: FUNCTION UNDERSCORE WITH"
+function _ with
+;;
+#0 "implementation: FUNCTION WITH"
+function with
+;;
+#0 "implementation: IF LBRACKETAT AND RBRACKET AND"
+if [@ and ] and
+;;
+#0 "implementation: IF PERCENT AND VIRTUAL"
+if % and virtual
+;;
+#0 "implementation: IF UIDENT THEN OBJECT END WHILE"
+if UIdent then object end while
+;;
+#0 "implementation: IF UIDENT THEN UIDENT ELSE OBJECT END WHILE"
+if UIdent then UIdent else object end while
+;;
+#0 "implementation: IF UIDENT THEN UIDENT ELSE WITH"
+if UIdent then UIdent else with
+;;
+#0 "implementation: IF UIDENT THEN WITH"
+if UIdent then with
+;;
+#0 "implementation: IF UIDENT WITH"
+if UIdent with
+;;
+#0 "implementation: IF WITH"
+if with
+;;
+#0 "implementation: INCLUDE LBRACKETAT AND RBRACKET FUNCTION"
+include [@ and ] function
+;;
+#0 "implementation: INCLUDE PERCENT AND FUNCTION"
+include % and function
+;;
+#0 "implementation: INCLUDE UIDENT WITH"
+include UIdent with
+;;
+#0 "implementation: INCLUDE WITH"
+include with
+;;
+#0 "implementation: LAZY LBRACKETAT AND RBRACKET ASSERT"
+lazy [@ and ] assert
+;;
+#0 "implementation: LAZY PERCENT AND ASSERT"
+lazy % and assert
+;;
+#0 "implementation: LAZY UIDENT UIDENT"
+lazy UIdent UIdent
+;;
+#0 "implementation: LAZY WITH"
+lazy with
+;;
+#0 "implementation: LBRACE LIDENT COLONGREATER LIDENT RPAREN"
+{ lident :> lident )
+;;
+#0 "implementation: LBRACE LIDENT EQUAL CHAR GREATERRBRACE"
+{ lident = 'a' >}
+;;
+#0 "implementation: LBRACE LIDENT SEMI WITH"
+{ lident ; with
+;;
+#0 "implementation: LBRACE LIDENT WHILE"
+{ lident while
+;;
+#0 "implementation: LBRACE TRUE DOT LBRACE UIDENT WITH"
+{ true . { UIdent with
+;;
+#0 "implementation: LBRACE TRUE DOT LBRACE WITH"
+{ true . { with
+;;
+#0 "implementation: LBRACE TRUE DOT LBRACKET UIDENT WITH"
+{ true . [ UIdent with
+;;
+#0 "implementation: LBRACE TRUE DOT LBRACKET WITH"
+{ true . [ with
+;;
+#0 "implementation: LBRACE TRUE DOT LPAREN UIDENT WITH"
+{ true . ( UIdent with
+;;
+#0 "implementation: LBRACE TRUE DOT LPAREN WITH"
+{ true . ( with
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN"
+{ true . UIdent .+ { UIdent )
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACE WITH"
+{ true . UIdent .+ { with
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN"
+{ true . UIdent .+ [ UIdent )
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LBRACKET WITH"
+{ true . UIdent .+ [ with
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET"
+{ true . UIdent .+ ( UIdent ]
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP LPAREN WITH"
+{ true . UIdent .+ ( with
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT DOTOP WITH"
+{ true . UIdent .+ with
+;;
+#0 "implementation: LBRACE TRUE DOT UIDENT WITH"
+{ true . UIdent with
+;;
+#0 "implementation: LBRACE TRUE DOT WITH"
+{ true . with
+;;
+#0 "implementation: LBRACE TRUE WHILE"
+{ true while
+;;
+#0 "implementation: LBRACE UIDENT DOT LIDENT WHILE"
+{ UIdent . lident while
+;;
+#0 "implementation: LBRACE UIDENT DOT WITH"
+{ UIdent . with
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LBRACE UIDENT SEMI RPAREN"
+{ UIdent .+ { UIdent ; )
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LBRACE WITH"
+{ UIdent .+ { with
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LBRACKET UIDENT RPAREN"
+{ UIdent .+ [ UIdent )
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LBRACKET WITH"
+{ UIdent .+ [ with
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LPAREN UIDENT RBRACKET"
+{ UIdent .+ ( UIdent ]
+;;
+#0 "implementation: LBRACE UIDENT DOTOP LPAREN WITH"
+{ UIdent .+ ( with
+;;
+#0 "implementation: LBRACE UIDENT DOTOP WITH"
+{ UIdent .+ with
+;;
+#0 "implementation: LBRACE UIDENT WHILE"
+{ UIdent while
+;;
+#0 "implementation: LBRACE UIDENT WITH LIDENT WITH"
+{ UIdent with lident with
+;;
+#0 "implementation: LBRACE UIDENT WITH WITH"
+{ UIdent with with
+;;
+#0 "implementation: LBRACE WITH"
+{ with
+;;
+#0 "implementation: LBRACELESS LIDENT EQUAL UIDENT RBRACE"
+{< lident = UIdent }
+;;
+#0 "implementation: LBRACELESS LIDENT EQUAL UIDENT WITH"
+{< lident = UIdent with
+;;
+#0 "implementation: LBRACELESS LIDENT EQUAL WITH"
+{< lident = with
+;;
+#0 "implementation: LBRACELESS LIDENT SEMI WITH"
+{< lident ; with
+;;
+#0 "implementation: LBRACELESS LIDENT WITH"
+{< lident with
+;;
+#0 "implementation: LBRACELESS WITH"
+{< with
+;;
+#0 "implementation: LBRACKET UIDENT RPAREN"
+[ UIdent )
+;;
+#0 "implementation: LBRACKET WITH"
+[ with
+;;
+#0 "implementation: LBRACKETATATAT UNDERSCORE"
+[@@@ _
+;;
+#0 "implementation: LBRACKETATATAT WITH UIDENT WHEN"
+[@@@ with UIdent when
+;;
+#0 "implementation: LBRACKETATATAT WITH VIRTUAL"
+[@@@ with virtual
+;;
+#0 "implementation: LBRACKETBAR UIDENT RPAREN"
+[| UIdent )
+;;
+#0 "implementation: LBRACKETBAR UIDENT SEMI WITH"
+[| UIdent ; with
+;;
+#0 "implementation: LBRACKETBAR UIDENT WITH"
+[| UIdent with
+;;
+#0 "implementation: LBRACKETBAR WITH"
+[| with
+;;
+#0 "implementation: LBRACKETPERCENT UNDERSCORE"
+[% _
+;;
+#0 "implementation: LBRACKETPERCENT WITH UIDENT WHEN"
+[% with UIdent when
+;;
+#0 "implementation: LBRACKETPERCENT WITH VIRTUAL"
+[% with virtual
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT UNDERSCORE"
+[%% _
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LBRACKET UNDERSCORE RBRACKET WITH"
+[%% with : class [ _ ] with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LBRACKETAT AND RBRACKET WHILE"
+[%% with : class [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LBRACKET UNDERSCORE RBRACKET WITH"
+[%% with : class lident : {%hello|world|} and [ _ ] with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE"
+[%% with : class lident : {%hello|world|} and [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+[%% with : class lident : {%hello|world|} and lident : {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON QUOTED_STRING_EXPR RPAREN"
+[%% with : class lident : {%hello|world|} and lident : {%hello|world|} )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT COLON WITH"
+[%% with : class lident : {%hello|world|} and lident : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND LIDENT WITH"
+[%% with : class lident : {%hello|world|} and lident with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND VIRTUAL LBRACELESS"
+[%% with : class lident : {%hello|world|} and virtual {<
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR AND WITH"
+[%% with : class lident : {%hello|world|} and with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+[%% with : class lident : {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON QUOTED_STRING_EXPR RPAREN"
+[%% with : class lident : {%hello|world|} )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT COLON WITH"
+[%% with : class lident : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS LIDENT WITH"
+[%% with : class lident with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS PERCENT AND LBRACELESS"
+[%% with : class % and {<
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS VIRTUAL LBRACELESS"
+[%% with : class virtual {<
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON CLASS WITH"
+[%% with : class with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION LBRACKETAT AND RBRACKET WHILE"
+[%% with : exception [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION PERCENT AND EXTERNAL"
+[%% with : exception % and external
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION UIDENT WITH"
+[%% with : exception UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON EXCEPTION WITH"
+[%% with : exception with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE LBRACKETAT AND RBRACKET WHILE"
+[%% with : include [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE PERCENT AND FUNCTION"
+[%% with : include % and function
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE UIDENT RPAREN"
+[%% with : include UIdent )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON INCLUDE WITH"
+[%% with : include with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE LBRACKETAT AND RBRACKET WHILE"
+[%% with : module [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE PERCENT AND LBRACKET"
+[%% with : module % and [
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND LBRACKETAT AND RBRACKET WHILE"
+[%% with : module rec _ : UIdent and [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON UIDENT LBRACKETATAT AND RBRACKET METHOD"
+[%% with : module rec _ : UIdent and _ : UIdent [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON UIDENT RPAREN"
+[%% with : module rec _ : UIdent and _ : UIdent )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE COLON WITH"
+[%% with : module rec _ : UIdent and _ : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND UNDERSCORE WITH"
+[%% with : module rec _ : UIdent and _ with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT AND WITH"
+[%% with : module rec _ : UIdent and with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT LBRACKETATAT AND RBRACKET METHOD"
+[%% with : module rec _ : UIdent [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON UIDENT RPAREN"
+[%% with : module rec _ : UIdent )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE COLON WITH"
+[%% with : module rec _ : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC UNDERSCORE WITH"
+[%% with : module rec _ with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE REC WITH"
+[%% with : module rec with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE TYPE UIDENT LET"
+[%% with : module type UIdent let
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT COLONEQUAL UIDENT WITH"
+[%% with : module UIdent := UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT COLONEQUAL WITH"
+[%% with : module UIdent := with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UIDENT WITH"
+[%% with : module UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE COLON UIDENT RPAREN"
+[%% with : module _ : UIdent )
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE COLON WITH"
+[%% with : module _ : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE EQUAL UIDENT WITH"
+[%% with : module _ = UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE EQUAL WITH"
+[%% with : module _ = with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE LPAREN RPAREN WITH"
+[%% with : module _ ( ) with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE UNDERSCORE WITH"
+[%% with : module _ with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON MODULE WITH"
+[%% with : module with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG LBRACKETAT AND RBRACKET WHILE"
+[%% with : open ! [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG PERCENT AND LBRACKET"
+[%% with : open ! % and [
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG UIDENT WITH"
+[%% with : open ! UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN BANG WITH"
+[%% with : open ! with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN LBRACKETAT AND RBRACKET WHILE"
+[%% with : open [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN PERCENT AND LBRACKET"
+[%% with : open % and [
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN UIDENT WITH"
+[%% with : open UIdent with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON OPEN WITH"
+[%% with : open with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON QUOTED_STRING_ITEM WITH"
+[%% with : {%%hello|world|} with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON SEMISEMI WITH"
+[%% with : ;; with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LBRACKETAT AND RBRACKET WHILE"
+[%% with : type [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LBRACKETAT AND RBRACKET WHILE"
+[%% with : type lident := | and [@ and ] while
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL UNDERSCORE LBRACKETATAT AND RBRACKET METHOD"
+[%% with : type lident := | and lident := _ [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL UNDERSCORE LET"
+[%% with : type lident := | and lident := _ let
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT COLONEQUAL WITH"
+[%% with : type lident := | and lident := with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND LIDENT WITH"
+[%% with : type lident := | and lident with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND UNDERSCORE LETOP"
+[%% with : type lident := | and _ let*
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR AND WITH"
+[%% with : type lident := | and with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL BAR LBRACKETATAT AND RBRACKET METHOD"
+[%% with : type lident := | [@@ and ] method
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL UNDERSCORE LET"
+[%% with : type lident := _ let
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT COLONEQUAL WITH"
+[%% with : type lident := with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ PRIVATE BANG"
+[%% with : type lident += private !
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ UIDENT LET"
+[%% with : type lident += UIdent let
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT PLUSEQ WITH"
+[%% with : type lident += with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE LIDENT WITH"
+[%% with : type lident with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE NONREC LIDENT LET"
+[%% with : type nonrec lident let
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE PERCENT AND BACKQUOTE"
+[%% with : type % and `
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE UIDENT DOT LIDENT WITH"
+[%% with : type UIdent . lident with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE UNDERSCORE LETOP"
+[%% with : type _ let*
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON TYPE WITH"
+[%% with : type with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON UNDERSCORE WITH"
+[%% with : _ with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH COLON WITH"
+[%% with : with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH DOT UNDERSCORE"
+[%% with . _
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH QUESTION UNDERSCORE WHEN WITH"
+[%% with ? _ when with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH QUESTION UNDERSCORE WITH"
+[%% with ? _ with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH QUESTION WITH"
+[%% with ? with
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH UIDENT WHEN"
+[%% with UIdent when
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH VIRTUAL"
+[%% with virtual
+;;
+#0 "implementation: LBRACKETPERCENTPERCENT WITH WITH"
+[%% with with
+;;
+#0 "implementation: LET CHAR EQUAL CHAR AND LBRACKETAT AND RBRACKET WHILE"
+let 'a' = 'a' and [@ and ] while
+;;
+#0 "implementation: LET CHAR EQUAL CHAR AND UNDERSCORE EQUAL CHAR WITH"
+let 'a' = 'a' and _ = 'a' with
+;;
+#0 "implementation: LET CHAR EQUAL CHAR AND WITH"
+let 'a' = 'a' and with
+;;
+#0 "implementation: LET CHAR EQUAL CHAR IN WITH"
+let 'a' = 'a' in with
+;;
+#0 "implementation: LET CHAR EQUAL CHAR LBRACKETATAT AND RBRACKET METHOD"
+let 'a' = 'a' [@@ and ] method
+;;
+#0 "implementation: LET EXCEPTION LBRACKETAT AND RBRACKET EXTERNAL"
+let exception [@ and ] external
+;;
+#0 "implementation: LET EXCEPTION PERCENT AND EXTERNAL"
+let exception % and external
+;;
+#0 "implementation: LET EXCEPTION UIDENT IN WITH"
+let exception UIdent in with
+;;
+#0 "implementation: LET EXCEPTION UIDENT LBRACKETAT AND RBRACKET WHILE"
+let exception UIdent [@ and ] while
+;;
+#0 "implementation: LET EXCEPTION UIDENT OF UNDERSCORE EXTERNAL"
+let exception UIdent of _ external
+;;
+#0 "implementation: LET EXCEPTION UIDENT WITH"
+let exception UIdent with
+;;
+#0 "implementation: LET EXCEPTION WITH"
+let exception with
+;;
+#0 "implementation: LET LBRACKETAT AND RBRACKET ASSERT"
+let [@ and ] assert
+;;
+#0 "implementation: LET LIDENT COLON QUOTE LIDENT DOT UNDERSCORE EQUAL WITH"
+let lident : ' lident . _ = with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE LIDENT DOT UNDERSCORE WITH"
+let lident : ' lident . _ with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE LIDENT DOT WITH"
+let lident : ' lident . with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE LIDENT QUOTE LIDENT WITH"
+let lident : ' lident ' lident with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE LIDENT QUOTE WITH"
+let lident : ' lident ' with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE UIDENT WITH"
+let lident : ' UIdent with
+;;
+#0 "implementation: LET LIDENT COLON QUOTE WITH"
+let lident : ' with
+;;
+#0 "implementation: LET LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH"
+let lident : type lident . _ = with
+;;
+#0 "implementation: LET LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH"
+let lident : type lident . _ with
+;;
+#0 "implementation: LET LIDENT COLON TYPE LIDENT DOT WITH"
+let lident : type lident . with
+;;
+#0 "implementation: LET LIDENT COLON TYPE LIDENT RPAREN"
+let lident : type lident )
+;;
+#0 "implementation: LET LIDENT COLON TYPE WITH"
+let lident : type with
+;;
+#0 "implementation: LET LIDENT COLON WITH"
+let lident : with
+;;
+#0 "implementation: LET LIDENT COLONGREATER UNDERSCORE EQUAL WITH"
+let lident :> _ = with
+;;
+#0 "implementation: LET LIDENT COLONGREATER UNDERSCORE SEMI"
+let lident :> _ ;
+;;
+#0 "implementation: LET LIDENT WITH"
+let lident with
+;;
+#0 "implementation: LET MODULE LBRACKETAT AND RBRACKET WHILE"
+let module [@ and ] while
+;;
+#0 "implementation: LET MODULE PERCENT AND LBRACKET"
+let module % and [
+;;
+#0 "implementation: LET MODULE UNDERSCORE EQUAL UIDENT IN WITH"
+let module _ = UIdent in with
+;;
+#0 "implementation: LET MODULE UNDERSCORE EQUAL UIDENT VAL"
+let module _ = UIdent val
+;;
+#0 "implementation: LET MODULE UNDERSCORE WITH"
+let module _ with
+;;
+#0 "implementation: LET MODULE WITH"
+let module with
+;;
+#0 "implementation: LET OPEN BANG LBRACKETAT AND RBRACKET WHILE"
+let open ! [@ and ] while
+;;
+#0 "implementation: LET OPEN BANG PERCENT AND WHILE"
+let open ! % and while
+;;
+#0 "implementation: LET OPEN BANG UIDENT IN WITH"
+let open ! UIdent in with
+;;
+#0 "implementation: LET OPEN BANG UIDENT WITH"
+let open ! UIdent with
+;;
+#0 "implementation: LET OPEN BANG WITH"
+let open ! with
+;;
+#0 "implementation: LET OPEN LBRACKETAT AND RBRACKET FUNCTION"
+let open [@ and ] function
+;;
+#0 "implementation: LET OPEN PERCENT AND FUNCTION"
+let open % and function
+;;
+#0 "implementation: LET OPEN UIDENT IN WITH"
+let open UIdent in with
+;;
+#0 "implementation: LET OPEN UIDENT WITH"
+let open UIdent with
+;;
+#0 "implementation: LET OPEN WITH"
+let open with
+;;
+#0 "implementation: LET PERCENT AND ASSERT"
+let % and assert
+;;
+#0 "implementation: LET REC ASSERT"
+let rec assert
+;;
+#0 "implementation: LET UIDENT UNDERSCORE WITH"
+let UIdent _ with
+;;
+#0 "implementation: LET UNDERSCORE COLON UNDERSCORE EQUAL WITH"
+let _ : _ = with
+;;
+#0 "implementation: LET UNDERSCORE COLON UNDERSCORE WITH"
+let _ : _ with
+;;
+#0 "implementation: LET UNDERSCORE COLON WITH"
+let _ : with
+;;
+#0 "implementation: LET UNDERSCORE EQUAL CHAR WITH"
+let _ = 'a' with
+;;
+#0 "implementation: LET UNDERSCORE EQUAL WITH"
+let _ = with
+;;
+#0 "implementation: LET UNDERSCORE WITH"
+let _ with
+;;
+#0 "implementation: LET WITH"
+let with
+;;
+#0 "implementation: LETOP BACKQUOTE UIDENT WITH"
+let* ` UIdent with
+;;
+#0 "implementation: LETOP HASH WITH"
+let* # with
+;;
+#0 "implementation: LETOP LAZY LBRACKETAT AND RBRACKET ASSERT"
+let* lazy [@ and ] assert
+;;
+#0 "implementation: LETOP LAZY PERCENT AND WHILE"
+let* lazy % and while
+;;
+#0 "implementation: LETOP LAZY WITH"
+let* lazy with
+;;
+#0 "implementation: LETOP LBRACE LIDENT COLON UNDERSCORE WITH"
+let* { lident : _ with
+;;
+#0 "implementation: LETOP LBRACE LIDENT COLON WITH"
+let* { lident : with
+;;
+#0 "implementation: LETOP LBRACE LIDENT EQUAL UNDERSCORE WITH"
+let* { lident = _ with
+;;
+#0 "implementation: LETOP LBRACE LIDENT EQUAL WITH"
+let* { lident = with
+;;
+#0 "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE SEMI WITH"
+let* { lident ; _ ; with
+;;
+#0 "implementation: LETOP LBRACE LIDENT SEMI UNDERSCORE WITH"
+let* { lident ; _ with
+;;
+#0 "implementation: LETOP LBRACE LIDENT SEMI WITH"
+let* { lident ; with
+;;
+#0 "implementation: LETOP LBRACE LIDENT WITH"
+let* { lident with
+;;
+#0 "implementation: LETOP LBRACE WITH"
+let* { with
+;;
+#0 "implementation: LETOP LBRACKET UNDERSCORE BARRBRACKET"
+let* [ _ |]
+;;
+#0 "implementation: LETOP LBRACKET WITH"
+let* [ with
+;;
+#0 "implementation: LETOP LBRACKETBAR UNDERSCORE RBRACKET"
+let* [| _ ]
+;;
+#0 "implementation: LETOP LBRACKETBAR UNDERSCORE SEMI WITH"
+let* [| _ ; with
+;;
+#0 "implementation: LETOP LBRACKETBAR UNDERSCORE WITH"
+let* [| _ with
+;;
+#0 "implementation: LETOP LBRACKETBAR WITH"
+let* [| with
+;;
+#0 "implementation: LETOP LIDENT ANDOP WITH"
+let* lident and* with
+;;
+#0 "implementation: LETOP LIDENT EQUAL WITH"
+let* lident = with
+;;
+#0 "implementation: LETOP LIDENT IN WITH"
+let* lident in with
+;;
+#0 "implementation: LETOP LIDENT LPAREN TYPE LIDENT DOT"
+let* lident ( type lident .
+;;
+#0 "implementation: LETOP LIDENT LPAREN TYPE LIDENT RPAREN WITH"
+let* lident ( type lident ) with
+;;
+#0 "implementation: LETOP LIDENT LPAREN TYPE WITH"
+let* lident ( type with
+;;
+#0 "implementation: LETOP LIDENT LPAREN WITH"
+let* lident ( with
+;;
+#0 "implementation: LETOP LIDENT UNDERSCORE COLONGREATER LIDENT EQUAL WITH"
+let* lident _ :> lident = with
+;;
+#0 "implementation: LETOP LIDENT UNDERSCORE COLONGREATER LIDENT SEMI"
+let* lident _ :> lident ;
+;;
+#0 "implementation: LETOP LIDENT UNDERSCORE WITH"
+let* lident _ with
+;;
+#0 "implementation: LETOP LIDENT WITH"
+let* lident with
+;;
+#0 "implementation: LETOP LPAREN MINUS WITH"
+let* ( - with
+;;
+#0 "implementation: LETOP LPAREN MODULE LBRACKETAT AND RBRACKET WHILE"
+let* ( module [@ and ] while
+;;
+#0 "implementation: LETOP LPAREN MODULE PERCENT AND WHILE"
+let* ( module % and while
+;;
+#0 "implementation: LETOP LPAREN MODULE UNDERSCORE COLON UIDENT VAL"
+let* ( module _ : UIdent val
+;;
+#0 "implementation: LETOP LPAREN MODULE UNDERSCORE COLON WITH"
+let* ( module _ : with
+;;
+#0 "implementation: LETOP LPAREN MODULE UNDERSCORE WITH"
+let* ( module _ with
+;;
+#0 "implementation: LETOP LPAREN MODULE WITH"
+let* ( module with
+;;
+#0 "implementation: LETOP LPAREN PLUS WITH"
+let* ( + with
+;;
+#0 "implementation: LETOP LPAREN UNDERSCORE COLON UNDERSCORE WITH"
+let* ( _ : _ with
+;;
+#0 "implementation: LETOP LPAREN UNDERSCORE COLON WITH"
+let* ( _ : with
+;;
+#0 "implementation: LETOP LPAREN UNDERSCORE WITH"
+let* ( _ with
+;;
+#0 "implementation: LETOP LPAREN WITH"
+let* ( with
+;;
+#0 "implementation: LETOP MINUS WITH"
+let* - with
+;;
+#0 "implementation: LETOP PLUS WITH"
+let* + with
+;;
+#0 "implementation: LETOP STRING DOTDOT WITH"
+let* "hello" .. with
+;;
+#0 "implementation: LETOP STRING WITH"
+let* "hello" with
+;;
+#0 "implementation: LETOP UIDENT DOT LBRACKET WITH"
+let* UIdent . [ with
+;;
+#0 "implementation: LETOP UIDENT DOT LPAREN UNDERSCORE WITH"
+let* UIdent . ( _ with
+;;
+#0 "implementation: LETOP UIDENT DOT LPAREN WITH"
+let* UIdent . ( with
+;;
+#0 "implementation: LETOP UIDENT DOT WITH"
+let* UIdent . with
+;;
+#0 "implementation: LETOP UIDENT LIDENT WITH"
+let* UIdent lident with
+;;
+#0 "implementation: LETOP UIDENT TILDE"
+let* UIdent ~
+;;
+#0 "implementation: LETOP UIDENT WITH"
+let* UIdent with
+;;
+#0 "implementation: LETOP UNDERSCORE AS WITH"
+let* _ as with
+;;
+#0 "implementation: LETOP UNDERSCORE BAR UNDERSCORE WITH"
+let* _ | _ with
+;;
+#0 "implementation: LETOP UNDERSCORE BAR WITH"
+let* _ | with
+;;
+#0 "implementation: LETOP UNDERSCORE COLON UNDERSCORE EQUAL WITH"
+let* _ : _ = with
+;;
+#0 "implementation: LETOP UNDERSCORE COLON UNDERSCORE WITH"
+let* _ : _ with
+;;
+#0 "implementation: LETOP UNDERSCORE COLON WITH"
+let* _ : with
+;;
+#0 "implementation: LETOP UNDERSCORE COLONCOLON UNDERSCORE WITH"
+let* _ :: _ with
+;;
+#0 "implementation: LETOP UNDERSCORE COLONCOLON WITH"
+let* _ :: with
+;;
+#0 "implementation: LETOP UNDERSCORE COMMA CHAR COMMA UNDERSCORE WITH"
+let* _ , 'a' , _ with
+;;
+#0 "implementation: LETOP UNDERSCORE COMMA CHAR COMMA WITH"
+let* _ , 'a' , with
+;;
+#0 "implementation: LETOP UNDERSCORE COMMA UNDERSCORE WITH"
+let* _ , _ with
+;;
+#0 "implementation: LETOP UNDERSCORE COMMA WITH"
+let* _ , with
+;;
+#0 "implementation: LETOP UNDERSCORE EQUAL CHAR WITH"
+let* _ = 'a' with
+;;
+#0 "implementation: LETOP UNDERSCORE EQUAL WITH"
+let* _ = with
+;;
+#0 "implementation: LETOP UNDERSCORE WITH"
+let* _ with
+;;
+#0 "implementation: LETOP WITH"
+let* with
+;;
+#0 "implementation: LIDENT LESSMINUS OBJECT END WHILE"
+lident <- object end while
+;;
+#0 "implementation: LIDENT LESSMINUS WITH"
+lident <- with
+;;
+#0 "implementation: LIDENT WHILE"
+lident while
+;;
+#0 "implementation: LPAREN BANG WITH"
+( ! with
+;;
+#0 "implementation: LPAREN COLONCOLON WITH"
+( :: with
+;;
+#0 "implementation: LPAREN DOTOP LBRACE RBRACE WITH"
+( .+ { } with
+;;
+#0 "implementation: LPAREN DOTOP LBRACE SEMI DOTDOT WITH"
+( .+ { ; .. with
+;;
+#0 "implementation: LPAREN DOTOP LBRACE WITH"
+( .+ { with
+;;
+#0 "implementation: LPAREN DOTOP LBRACKET RBRACKET WITH"
+( .+ [ ] with
+;;
+#0 "implementation: LPAREN DOTOP LBRACKET SEMI DOTDOT WITH"
+( .+ [ ; .. with
+;;
+#0 "implementation: LPAREN DOTOP LBRACKET WITH"
+( .+ [ with
+;;
+#0 "implementation: LPAREN DOTOP LPAREN RPAREN WITH"
+( .+ ( ) with
+;;
+#0 "implementation: LPAREN DOTOP LPAREN SEMI DOTDOT WITH"
+( .+ ( ; .. with
+;;
+#0 "implementation: LPAREN DOTOP LPAREN SEMI WITH"
+( .+ ( ; with
+;;
+#0 "implementation: LPAREN DOTOP LPAREN WITH"
+( .+ ( with
+;;
+#0 "implementation: LPAREN DOTOP WITH"
+( .+ with
+;;
+#0 "implementation: LPAREN LETOP WITH"
+( let* with
+;;
+#0 "implementation: LPAREN MINUS WITH"
+( - with
+;;
+#0 "implementation: LPAREN MINUSDOT WITH"
+( -. with
+;;
+#0 "implementation: LPAREN MODULE LBRACKETAT AND RBRACKET FUNCTION"
+( module [@ and ] function
+;;
+#0 "implementation: LPAREN MODULE PERCENT AND WHILE"
+( module % and while
+;;
+#0 "implementation: LPAREN MODULE UIDENT COLON UIDENT VAL"
+( module UIdent : UIdent val
+;;
+#0 "implementation: LPAREN MODULE UIDENT COLON WITH"
+( module UIdent : with
+;;
+#0 "implementation: LPAREN MODULE UIDENT WITH"
+( module UIdent with
+;;
+#0 "implementation: LPAREN MODULE WITH"
+( module with
+;;
+#0 "implementation: LPAREN PLUS WITH"
+( + with
+;;
+#0 "implementation: LPAREN PLUSDOT WITH"
+( +. with
+;;
+#0 "implementation: LPAREN PREFIXOP WITH"
+( !+ with
+;;
+#0 "implementation: LPAREN STAR WITH"
+( * with
+;;
+#0 "implementation: LPAREN UIDENT COLON UNDERSCORE COLONGREATER UNDERSCORE WITH"
+( UIdent : _ :> _ with
+;;
+#0 "implementation: LPAREN UIDENT COLON UNDERSCORE COLONGREATER WITH"
+( UIdent : _ :> with
+;;
+#0 "implementation: LPAREN UIDENT COLON UNDERSCORE WITH"
+( UIdent : _ with
+;;
+#0 "implementation: LPAREN UIDENT COLON WITH"
+( UIdent : with
+;;
+#0 "implementation: LPAREN UIDENT COLONGREATER LIDENT SEMI"
+( UIdent :> lident ;
+;;
+#0 "implementation: LPAREN UIDENT COLONGREATER UNDERSCORE WITH"
+( UIdent :> _ with
+;;
+#0 "implementation: LPAREN UIDENT COLONGREATER WITH"
+( UIdent :> with
+;;
+#0 "implementation: LPAREN UIDENT WITH"
+( UIdent with
+;;
+#0 "implementation: LPAREN WITH"
+( with
+;;
+#0 "implementation: MATCH LBRACKETAT AND RBRACKET AND"
+match [@ and ] and
+;;
+#0 "implementation: MATCH PERCENT AND VIRTUAL"
+match % and virtual
+;;
+#0 "implementation: MATCH UIDENT VAL"
+match UIdent val
+;;
+#0 "implementation: MATCH UIDENT WITH UNDERSCORE MINUSGREATER DOT WHILE"
+match UIdent with _ -> . while
+;;
+#0 "implementation: MATCH UIDENT WITH WITH"
+match UIdent with with
+;;
+#0 "implementation: MATCH WITH"
+match with
+;;
+#0 "implementation: MINUSDOT WITH"
+-. with
+;;
+#0 "implementation: MODULE LBRACKETAT AND RBRACKET WHILE"
+module [@ and ] while
+;;
+#0 "implementation: MODULE PERCENT AND LBRACKET"
+module % and [
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND LBRACKETAT AND RBRACKET WHILE"
+module rec _ = {%hello|world|} and [@ and ] while
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE EQUAL QUOTED_STRING_EXPR IN"
+module rec _ = {%hello|world|} and _ = {%hello|world|} in
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+module rec _ = {%hello|world|} and _ = {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND UNDERSCORE WITH"
+module rec _ = {%hello|world|} and _ with
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR AND WITH"
+module rec _ = {%hello|world|} and with
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR IN"
+module rec _ = {%hello|world|} in
+;;
+#0 "implementation: MODULE REC UNDERSCORE EQUAL QUOTED_STRING_EXPR LBRACKETATAT AND RBRACKET METHOD"
+module rec _ = {%hello|world|} [@@ and ] method
+;;
+#0 "implementation: MODULE REC UNDERSCORE WITH"
+module rec _ with
+;;
+#0 "implementation: MODULE REC WITH"
+module rec with
+;;
+#0 "implementation: MODULE TYPE LBRACKETAT AND RBRACKET WHILE"
+module type [@ and ] while
+;;
+#0 "implementation: MODULE TYPE PERCENT AND WHILE"
+module type % and while
+;;
+#0 "implementation: MODULE TYPE UIDENT EQUAL UIDENT RPAREN"
+module type UIdent = UIdent )
+;;
+#0 "implementation: MODULE TYPE UIDENT EQUAL WITH"
+module type UIdent = with
+;;
+#0 "implementation: MODULE TYPE UIDENT WITH"
+module type UIdent with
+;;
+#0 "implementation: MODULE TYPE WITH"
+module type with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON FUNCTOR LBRACKETAT AND RBRACKET WHILE"
+module _ : functor [@ and ] while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN MINUSGREATER QUOTED_STRING_EXPR WHILE"
+module _ : functor ( ) -> {%hello|world|} while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN MINUSGREATER WITH"
+module _ : functor ( ) -> with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON FUNCTOR LPAREN RPAREN WITH"
+module _ : functor ( ) with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON FUNCTOR WITH"
+module _ : functor with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON LPAREN UIDENT VAL"
+module _ : ( UIdent val
+;;
+#0 "implementation: MODULE UNDERSCORE COLON LPAREN WITH"
+module _ : ( with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF LBRACKETAT AND RBRACKET FUNCTION"
+module _ : module type of [@ and ] function
+;;
+#0 "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF UIDENT IN"
+module _ : module type of UIdent in
+;;
+#0 "implementation: MODULE UNDERSCORE COLON MODULE TYPE OF WITH"
+module _ : module type of with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON MODULE TYPE WITH"
+module _ : module type with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON MODULE WITH"
+module _ : module with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON SIG LBRACKETAT AND RBRACKET WHILE"
+module _ : sig [@ and ] while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON SIG SEMISEMI RBRACKET"
+module _ : sig ;; ]
+;;
+#0 "implementation: MODULE UNDERSCORE COLON SIG WITH"
+module _ : sig with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT DOT UIDENT WHILE"
+module _ : UIdent . UIdent while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT DOT WITH"
+module _ : UIdent . with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT EQUAL UIDENT WITH"
+module _ : UIdent = UIdent with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT EQUAL WITH"
+module _ : UIdent = with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT LPAREN UIDENT RPAREN WITH"
+module _ : UIdent ( UIdent ) with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT MINUSGREATER QUOTED_STRING_EXPR WHILE"
+module _ : UIdent -> {%hello|world|} while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT MINUSGREATER WITH"
+module _ : UIdent -> with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT VAL"
+module _ : UIdent val
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WHILE"
+module _ : UIdent while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT COLONEQUAL UIDENT WHILE"
+module _ : UIdent with module UIdent := UIdent while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT COLONEQUAL WITH"
+module _ : UIdent with module UIdent := with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT EQUAL UIDENT WHILE"
+module _ : UIdent with module UIdent = UIdent while
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT EQUAL WITH"
+module _ : UIdent with module UIdent = with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE UIDENT WITH"
+module _ : UIdent with module UIdent with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH MODULE WITH"
+module _ : UIdent with module with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT COLONEQUAL UNDERSCORE SEMI"
+module _ : UIdent with type lident := _ ;
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT COLONEQUAL WITH"
+module _ : UIdent with type lident := with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL PRIVATE WITH"
+module _ : UIdent with type lident = private with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL UNDERSCORE AND WITH"
+module _ : UIdent with type lident = _ and with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL UNDERSCORE SEMI"
+module _ : UIdent with type lident = _ ;
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT EQUAL WITH"
+module _ : UIdent with type lident = with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE LIDENT WITH"
+module _ : UIdent with type lident with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE UNDERSCORE LETOP"
+module _ : UIdent with type _ let*
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH TYPE WITH"
+module _ : UIdent with type with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON UIDENT WITH WITH"
+module _ : UIdent with with
+;;
+#0 "implementation: MODULE UNDERSCORE COLON WITH"
+module _ : with
+;;
+#0 "implementation: MODULE UNDERSCORE EQUAL QUOTED_STRING_EXPR IN"
+module _ = {%hello|world|} in
+;;
+#0 "implementation: MODULE UNDERSCORE EQUAL UIDENT WITH"
+module _ = UIdent with
+;;
+#0 "implementation: MODULE UNDERSCORE EQUAL WITH"
+module _ = with
+;;
+#0 "implementation: MODULE UNDERSCORE LPAREN RPAREN WITH"
+module _ ( ) with
+;;
+#0 "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE COLON UIDENT VAL"
+module _ ( _ : UIdent val
+;;
+#0 "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE COLON WITH"
+module _ ( _ : with
+;;
+#0 "implementation: MODULE UNDERSCORE LPAREN UNDERSCORE WITH"
+module _ ( _ with
+;;
+#0 "implementation: MODULE UNDERSCORE LPAREN WITH"
+module _ ( with
+;;
+#0 "implementation: MODULE UNDERSCORE WITH"
+module _ with
+;;
+#0 "implementation: MODULE WITH"
+module with
+;;
+#0 "implementation: NEW LBRACKETAT AND RBRACKET WHILE"
+new [@ and ] while
+;;
+#0 "implementation: NEW PERCENT AND LBRACKET"
+new % and [
+;;
+#0 "implementation: NEW UIDENT DOT WITH"
+new UIdent . with
+;;
+#0 "implementation: NEW UIDENT WITH"
+new UIdent with
+;;
+#0 "implementation: NEW WITH"
+new with
+;;
+#0 "implementation: OBJECT CONSTRAINT HASH WITH"
+object constraint # with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT GREATER"
+object constraint [ ` UIdent >
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF AMPERSAND WITH"
+object constraint [ ` UIdent of & with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE AMPERSAND UNDERSCORE WITH"
+object constraint [ ` UIdent of _ & _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE AMPERSAND WITH"
+object constraint [ ` UIdent of _ & with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF UNDERSCORE WITH"
+object constraint [ ` UIdent of _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT OF WITH"
+object constraint [ ` UIdent of with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BACKQUOTE UIDENT WITH"
+object constraint [ ` UIdent with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BAR UNDERSCORE GREATER"
+object constraint [ | _ >
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET BAR WITH"
+object constraint [ | with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE BAR UNDERSCORE GREATER"
+object constraint [ _ | _ >
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE BAR WITH"
+object constraint [ _ | with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE RBRACKET"
+object constraint [ _ ]
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET UNDERSCORE WITH"
+object constraint [ _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKET WITH"
+object constraint [ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETAT AND RBRACKET GREATER"
+object constraint [@ and ] >
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETGREATER BAR ASSERT"
+object constraint [> | assert
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETGREATER UNDERSCORE GREATER"
+object constraint [> _ >
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETGREATER WITH"
+object constraint [> with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS BACKQUOTE UIDENT LBRACKETAT AND RBRACKET WHILE"
+object constraint [< ` UIdent [@ and ] while
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS BAR ASSERT"
+object constraint [< | assert
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE BAR WITH"
+object constraint [< _ | with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE GREATER BACKQUOTE LIDENT WITH"
+object constraint [< _ > ` lident with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS UNDERSCORE GREATER WITH"
+object constraint [< _ > with
+;;
+#0 "implementation: OBJECT CONSTRAINT LBRACKETLESS WITH"
+object constraint [< with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS DOTDOT WITH"
+object constraint < .. with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT DOT UNDERSCORE WITH"
+object constraint < lident : ' UIdent . _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT DOT WITH"
+object constraint < lident : ' UIdent . with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON QUOTE UIDENT QUOTE LIDENT WITH"
+object constraint < lident : ' UIdent ' lident with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE LBRACKETAT AND RBRACKET FUNCTOR"
+object constraint < lident : _ [@ and ] functor
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE RBRACE"
+object constraint < lident : _ }
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE SEMI LBRACKETAT AND RBRACKET CONSTRAINT"
+object constraint < lident : _ ; [@ and ] constraint
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE SEMI WITH"
+object constraint < lident : _ ; with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON UNDERSCORE WITH"
+object constraint < lident : _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT COLON WITH"
+object constraint < lident : with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS LIDENT WITH"
+object constraint < lident with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS UNDERSCORE SEMI WITH"
+object constraint < _ ; with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS UNDERSCORE WITH"
+object constraint < _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LESS WITH"
+object constraint < with
+;;
+#0 "implementation: OBJECT CONSTRAINT LIDENT COLON UNDERSCORE MINUSGREATER WITH"
+object constraint lident : _ -> with
+;;
+#0 "implementation: OBJECT CONSTRAINT LIDENT COLON UNDERSCORE WITH"
+object constraint lident : _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LIDENT COLON WITH"
+object constraint lident : with
+;;
+#0 "implementation: OBJECT CONSTRAINT LIDENT WHILE"
+object constraint lident while
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN MODULE LBRACKETAT AND RBRACKET WHILE"
+object constraint ( module [@ and ] while
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN MODULE PERCENT AND FUNCTION"
+object constraint ( module % and function
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN MODULE UIDENT VAL"
+object constraint ( module UIdent val
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN MODULE WITH"
+object constraint ( module with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT COMMA UNDERSCORE WITH"
+object constraint ( _ , lident , _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT COMMA WITH"
+object constraint ( _ , lident , with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT RPAREN HASH WITH"
+object constraint ( _ , lident ) # with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA LIDENT RPAREN WITH"
+object constraint ( _ , lident ) with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA UNDERSCORE WITH"
+object constraint ( _ , _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE COMMA WITH"
+object constraint ( _ , with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN UNDERSCORE WITH"
+object constraint ( _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT LPAREN WITH"
+object constraint ( with
+;;
+#0 "implementation: OBJECT CONSTRAINT OPTLABEL UNDERSCORE MINUSGREATER WITH"
+object constraint ?label: _ -> with
+;;
+#0 "implementation: OBJECT CONSTRAINT OPTLABEL UNDERSCORE WITH"
+object constraint ?label: _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT OPTLABEL WITH"
+object constraint ?label: with
+;;
+#0 "implementation: OBJECT CONSTRAINT QUESTION LIDENT WITH"
+object constraint ? lident with
+;;
+#0 "implementation: OBJECT CONSTRAINT QUESTION WITH"
+object constraint ? with
+;;
+#0 "implementation: OBJECT CONSTRAINT QUOTE WITH"
+object constraint ' with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE AMPERSAND"
+object constraint _ &
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE AS QUOTE WITH"
+object constraint _ as ' with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE AS WITH"
+object constraint _ as with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE EQUAL UNDERSCORE WITH"
+object constraint _ = _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE EQUAL WITH"
+object constraint _ = with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE HASH WITH"
+object constraint _ # with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE MINUSGREATER WITH"
+object constraint _ -> with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE STAR LIDENT STAR UNDERSCORE WHILE"
+object constraint _ * lident * _ while
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE STAR LIDENT STAR WITH"
+object constraint _ * lident * with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE STAR UNDERSCORE WHILE"
+object constraint _ * _ while
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE STAR WITH"
+object constraint _ * with
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE WHILE"
+object constraint _ while
+;;
+#0 "implementation: OBJECT CONSTRAINT UNDERSCORE WITH"
+object constraint _ with
+;;
+#0 "implementation: OBJECT CONSTRAINT WITH"
+object constraint with
+;;
+#0 "implementation: OBJECT END WHILE"
+object end while
+;;
+#0 "implementation: OBJECT INHERIT BANG LBRACKETAT AND RBRACKET WHILE"
+object inherit ! [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR AS LIDENT WITH"
+object inherit ! {%hello|world|} as lident with
+;;
+#0 "implementation: OBJECT INHERIT BANG QUOTED_STRING_EXPR WITH"
+object inherit ! {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT BANG WITH"
+object inherit ! with
+;;
+#0 "implementation: OBJECT INHERIT FUN LBRACKETAT AND RBRACKET WHILE"
+object inherit fun [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT FUN UNDERSCORE MINUSGREATER QUOTED_STRING_EXPR WITH"
+object inherit fun _ -> {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT FUN UNDERSCORE MINUSGREATER WITH"
+object inherit fun _ -> with
+;;
+#0 "implementation: OBJECT INHERIT FUN UNDERSCORE WITH"
+object inherit fun _ with
+;;
+#0 "implementation: OBJECT INHERIT FUN WITH"
+object inherit fun with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKET UNDERSCORE COMMA UNDERSCORE WITH"
+object inherit [ _ , _ with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKET UNDERSCORE COMMA WITH"
+object inherit [ _ , with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKET UNDERSCORE RBRACKET WITH"
+object inherit [ _ ] with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKET UNDERSCORE WITH"
+object inherit [ _ with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKET WITH"
+object inherit [ with
+;;
+#0 "implementation: OBJECT INHERIT LBRACKETAT AND RBRACKET FOR"
+object inherit [@ and ] for
+;;
+#0 "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR IN QUOTED_STRING_EXPR WITH"
+object inherit let 'a' = 'a' in {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR IN WITH"
+object inherit let 'a' = 'a' in with
+;;
+#0 "implementation: OBJECT INHERIT LET CHAR EQUAL CHAR LBRACKETATAT AND RBRACKET VAL"
+object inherit let 'a' = 'a' [@@ and ] val
+;;
+#0 "implementation: OBJECT INHERIT LET LBRACKETAT AND RBRACKET WHILE"
+object inherit let [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN BANG LBRACKETAT AND RBRACKET WHILE"
+object inherit let open ! [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN BANG UIDENT IN QUOTED_STRING_EXPR WITH"
+object inherit let open ! UIdent in {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN BANG UIDENT IN WITH"
+object inherit let open ! UIdent in with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN BANG UIDENT WITH"
+object inherit let open ! UIdent with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN BANG WITH"
+object inherit let open ! with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN LBRACKETAT AND RBRACKET WHILE"
+object inherit let open [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN UIDENT IN QUOTED_STRING_EXPR WITH"
+object inherit let open UIdent in {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN UIDENT IN WITH"
+object inherit let open UIdent in with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN UIDENT WITH"
+object inherit let open UIdent with
+;;
+#0 "implementation: OBJECT INHERIT LET OPEN WITH"
+object inherit let open with
+;;
+#0 "implementation: OBJECT INHERIT LET REC ASSERT"
+object inherit let rec assert
+;;
+#0 "implementation: OBJECT INHERIT LET UNDERSCORE EQUAL CHAR WITH"
+object inherit let _ = 'a' with
+;;
+#0 "implementation: OBJECT INHERIT LET WITH"
+object inherit let with
+;;
+#0 "implementation: OBJECT INHERIT LIDENT UIDENT WITH"
+object inherit lident UIdent with
+;;
+#0 "implementation: OBJECT INHERIT LIDENT WITH"
+object inherit lident with
+;;
+#0 "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR COLON QUOTED_STRING_EXPR VAL"
+object inherit ( {%hello|world|} : {%hello|world|} val
+;;
+#0 "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR COLON WITH"
+object inherit ( {%hello|world|} : with
+;;
+#0 "implementation: OBJECT INHERIT LPAREN QUOTED_STRING_EXPR WITH"
+object inherit ( {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT LPAREN WITH"
+object inherit ( with
+;;
+#0 "implementation: OBJECT INHERIT OBJECT LBRACKETAT AND RBRACKET WHILE"
+object inherit object [@ and ] while
+;;
+#0 "implementation: OBJECT INHERIT OBJECT LPAREN CHAR RPAREN WITH"
+object inherit object ( 'a' ) with
+;;
+#0 "implementation: OBJECT INHERIT OBJECT WITH"
+object inherit object with
+;;
+#0 "implementation: OBJECT INHERIT QUOTED_STRING_EXPR AS LIDENT WITH"
+object inherit {%hello|world|} as lident with
+;;
+#0 "implementation: OBJECT INHERIT QUOTED_STRING_EXPR AS WITH"
+object inherit {%hello|world|} as with
+;;
+#0 "implementation: OBJECT INHERIT QUOTED_STRING_EXPR WITH"
+object inherit {%hello|world|} with
+;;
+#0 "implementation: OBJECT INHERIT WITH"
+object inherit with
+;;
+#0 "implementation: OBJECT INITIALIZER LBRACKETAT AND RBRACKET AND"
+object initializer [@ and ] and
+;;
+#0 "implementation: OBJECT INITIALIZER UIDENT WITH"
+object initializer UIdent with
+;;
+#0 "implementation: OBJECT INITIALIZER WITH"
+object initializer with
+;;
+#0 "implementation: OBJECT LBRACKETAT AND RBRACKET CLASS"
+object [@ and ] class
+;;
+#0 "implementation: OBJECT LBRACKETATATAT AND RBRACKET WITH"
+object [@@@ and ] with
+;;
+#0 "implementation: OBJECT LPAREN UNDERSCORE COLON UNDERSCORE WITH"
+object ( _ : _ with
+;;
+#0 "implementation: OBJECT LPAREN UNDERSCORE COLON WITH"
+object ( _ : with
+;;
+#0 "implementation: OBJECT LPAREN UNDERSCORE RPAREN COMMENT"
+object ( _ ) (* comment *)
+;;
+#0 "implementation: OBJECT LPAREN UNDERSCORE WITH"
+object ( _ with
+;;
+#0 "implementation: OBJECT LPAREN WITH"
+object ( with
+;;
+#0 "implementation: OBJECT METHOD BANG LBRACKETAT AND RBRACKET WHILE"
+object method ! [@ and ] while
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH"
+object method ! lident : type lident . _ = with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH"
+object method ! lident : type lident . _ with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT DOT WITH"
+object method ! lident : type lident . with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON TYPE LIDENT RPAREN"
+object method ! lident : type lident )
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON TYPE WITH"
+object method ! lident : type with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON UNDERSCORE EQUAL WITH"
+object method ! lident : _ = with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON UNDERSCORE VAL"
+object method ! lident : _ val
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT COLON WITH"
+object method ! lident : with
+;;
+#0 "implementation: OBJECT METHOD BANG LIDENT WITH"
+object method ! lident with
+;;
+#0 "implementation: OBJECT METHOD BANG PRIVATE LETOP"
+object method ! private let*
+;;
+#0 "implementation: OBJECT METHOD BANG WITH"
+object method ! with
+;;
+#0 "implementation: OBJECT METHOD LBRACKETAT AND RBRACKET WHILE"
+object method [@ and ] while
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT DOT UNDERSCORE WITH"
+object method lident : ' lident . _ with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT DOT WITH"
+object method lident : ' lident . with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON QUOTE LIDENT QUOTE LIDENT WITH"
+object method lident : ' lident ' lident with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT UNDERSCORE EQUAL WITH"
+object method lident : type lident . _ = with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT UNDERSCORE WITH"
+object method lident : type lident . _ with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT DOT WITH"
+object method lident : type lident . with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON TYPE LIDENT RPAREN"
+object method lident : type lident )
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON TYPE WITH"
+object method lident : type with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE EQUAL WITH"
+object method lident : _ = with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE VAL"
+object method lident : _ val
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON UNDERSCORE WITH"
+object method lident : _ with
+;;
+#0 "implementation: OBJECT METHOD LIDENT COLON WITH"
+object method lident : with
+;;
+#0 "implementation: OBJECT METHOD LIDENT EQUAL CHAR WITH"
+object method lident = 'a' with
+;;
+#0 "implementation: OBJECT METHOD LIDENT WITH"
+object method lident with
+;;
+#0 "implementation: OBJECT METHOD PRIVATE WITH"
+object method private with
+;;
+#0 "implementation: OBJECT METHOD VIRTUAL LIDENT COLON WITH"
+object method virtual lident : with
+;;
+#0 "implementation: OBJECT METHOD VIRTUAL LIDENT WITH"
+object method virtual lident with
+;;
+#0 "implementation: OBJECT METHOD VIRTUAL PRIVATE WITH"
+object method virtual private with
+;;
+#0 "implementation: OBJECT METHOD VIRTUAL WITH"
+object method virtual with
+;;
+#0 "implementation: OBJECT METHOD WITH"
+object method with
+;;
+#0 "implementation: OBJECT PERCENT AND COLON"
+object % and :
+;;
+#0 "implementation: OBJECT QUOTED_STRING_ITEM WITH"
+object {%%hello|world|} with
+;;
+#0 "implementation: OBJECT VAL BANG LBRACKETAT AND RBRACKET WHILE"
+object val ! [@ and ] while
+;;
+#0 "implementation: OBJECT VAL BANG LIDENT COLONGREATER LIDENT EQUAL WITH"
+object val ! lident :> lident = with
+;;
+#0 "implementation: OBJECT VAL BANG LIDENT COLONGREATER LIDENT SEMI"
+object val ! lident :> lident ;
+;;
+#0 "implementation: OBJECT VAL BANG LIDENT EQUAL WITH"
+object val ! lident = with
+;;
+#0 "implementation: OBJECT VAL BANG LIDENT WITH"
+object val ! lident with
+;;
+#0 "implementation: OBJECT VAL BANG MUTABLE LETOP"
+object val ! mutable let*
+;;
+#0 "implementation: OBJECT VAL BANG WITH"
+object val ! with
+;;
+#0 "implementation: OBJECT VAL LBRACKETAT AND RBRACKET WHILE"
+object val [@ and ] while
+;;
+#0 "implementation: OBJECT VAL LIDENT COLONGREATER LIDENT EQUAL WITH"
+object val lident :> lident = with
+;;
+#0 "implementation: OBJECT VAL LIDENT COLONGREATER LIDENT SEMI"
+object val lident :> lident ;
+;;
+#0 "implementation: OBJECT VAL LIDENT EQUAL CHAR WITH"
+object val lident = 'a' with
+;;
+#0 "implementation: OBJECT VAL LIDENT EQUAL WITH"
+object val lident = with
+;;
+#0 "implementation: OBJECT VAL LIDENT WITH"
+object val lident with
+;;
+#0 "implementation: OBJECT VAL MUTABLE WITH"
+object val mutable with
+;;
+#0 "implementation: OBJECT VAL VIRTUAL LIDENT COLON UNDERSCORE WITH"
+object val virtual lident : _ with
+;;
+#0 "implementation: OBJECT VAL VIRTUAL LIDENT COLON WITH"
+object val virtual lident : with
+;;
+#0 "implementation: OBJECT VAL VIRTUAL LIDENT WITH"
+object val virtual lident with
+;;
+#0 "implementation: OBJECT VAL VIRTUAL MUTABLE WITH"
+object val virtual mutable with
+;;
+#0 "implementation: OBJECT VAL VIRTUAL WITH"
+object val virtual with
+;;
+#0 "implementation: OBJECT VAL WITH"
+object val with
+;;
+#0 "implementation: OBJECT WITH"
+object with
+;;
+#0 "implementation: OPEN BANG LBRACKETAT AND RBRACKET FUNCTION"
+open ! [@ and ] function
+;;
+#0 "implementation: OPEN BANG PERCENT AND WHILE"
+open ! % and while
+;;
+#0 "implementation: OPEN BANG UIDENT WITH"
+open ! UIdent with
+;;
+#0 "implementation: OPEN BANG WITH"
+open ! with
+;;
+#0 "implementation: OPEN FUNCTOR LBRACKETAT AND RBRACKET WHILE"
+open functor [@ and ] while
+;;
+#0 "implementation: OPEN FUNCTOR LPAREN RPAREN MINUSGREATER QUOTED_STRING_EXPR WHILE"
+open functor ( ) -> {%hello|world|} while
+;;
+#0 "implementation: OPEN FUNCTOR LPAREN RPAREN MINUSGREATER WITH"
+open functor ( ) -> with
+;;
+#0 "implementation: OPEN FUNCTOR LPAREN RPAREN WITH"
+open functor ( ) with
+;;
+#0 "implementation: OPEN FUNCTOR WITH"
+open functor with
+;;
+#0 "implementation: OPEN LBRACKETAT AND RBRACKET FUNCTION"
+open [@ and ] function
+;;
+#0 "implementation: OPEN LBRACKETAT AND RBRACKET WITH"
+open [@ and ] with
+;;
+#0 "implementation: OPEN LPAREN UIDENT COLON UIDENT VAL"
+open ( UIdent : UIdent val
+;;
+#0 "implementation: OPEN LPAREN UIDENT COLON WITH"
+open ( UIdent : with
+;;
+#0 "implementation: OPEN LPAREN UIDENT WITH"
+open ( UIdent with
+;;
+#0 "implementation: OPEN LPAREN VAL LBRACKETAT AND RBRACKET VIRTUAL"
+open ( val [@ and ] virtual
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT COLONGREATER UIDENT VAL"
+open ( val UIdent : UIdent :> UIdent val
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT COLONGREATER WITH"
+open ( val UIdent : UIdent :> with
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLON UIDENT VAL"
+open ( val UIdent : UIdent val
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLON WITH"
+open ( val UIdent : with
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLONGREATER UIDENT VAL"
+open ( val UIdent :> UIdent val
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT COLONGREATER WITH"
+open ( val UIdent :> with
+;;
+#0 "implementation: OPEN LPAREN VAL UIDENT WITH"
+open ( val UIdent with
+;;
+#0 "implementation: OPEN LPAREN VAL WITH"
+open ( val with
+;;
+#0 "implementation: OPEN LPAREN WITH"
+open ( with
+;;
+#0 "implementation: OPEN PERCENT AND FUNCTION"
+open % and function
+;;
+#0 "implementation: OPEN PERCENT UNDERSCORE"
+open % _
+;;
+#0 "implementation: OPEN STRUCT LBRACKETAT AND RBRACKET AND"
+open struct [@ and ] and
+;;
+#0 "implementation: OPEN STRUCT UIDENT RBRACKET"
+open struct UIdent ]
+;;
+#0 "implementation: OPEN STRUCT WITH"
+open struct with
+;;
+#0 "implementation: OPEN UIDENT DOT WITH"
+open UIdent . with
+;;
+#0 "implementation: OPEN UIDENT LPAREN WITH"
+open UIdent ( with
+;;
+#0 "implementation: OPEN UIDENT WHILE"
+open UIdent while
+;;
+#0 "implementation: OPEN UIDENT WITH"
+open UIdent with
+;;
+#0 "implementation: OPEN WITH"
+open with
+;;
+#0 "implementation: PLUSDOT LET CHAR EQUAL CHAR VAL"
++. let 'a' = 'a' val
+;;
+#0 "implementation: PLUSDOT WITH"
++. with
+;;
+#0 "implementation: PREFIXOP WITH"
+!+ with
+;;
+#0 "implementation: QUOTED_STRING_ITEM HASH"
+{%%hello|world|} #
+;;
+#0 "implementation: QUOTED_STRING_ITEM LBRACKETATAT AND RBRACKET WITH"
+{%%hello|world|} [@@ and ] with
+;;
+#0 "implementation: QUOTED_STRING_ITEM LBRACKETATAT UNDERSCORE"
+{%%hello|world|} [@@ _
+;;
+#0 "implementation: QUOTED_STRING_ITEM LBRACKETATAT WITH UIDENT WHEN"
+{%%hello|world|} [@@ with UIdent when
+;;
+#0 "implementation: QUOTED_STRING_ITEM LBRACKETATAT WITH VIRTUAL"
+{%%hello|world|} [@@ with virtual
+;;
+#0 "implementation: QUOTED_STRING_ITEM LET CHAR EQUAL CHAR IN"
+{%%hello|world|} let 'a' = 'a' in
+;;
+#0 "implementation: QUOTED_STRING_ITEM LET WITH"
+{%%hello|world|} let with
+;;
+#0 "implementation: QUOTED_STRING_ITEM WITH"
+{%%hello|world|} with
+;;
+#0 "implementation: STRING TRUE WHILE"
+"hello" true while
+;;
+#0 "implementation: STRING UIDENT AS"
+"hello" UIdent as
+;;
+#0 "implementation: STRING WHILE"
+"hello" while
+;;
+#0 "implementation: TRUE DOT LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE"
+true . { UIdent } <- object end while
+;;
+#0 "implementation: TRUE DOT LBRACE UIDENT RBRACE LESSMINUS WITH"
+true . { UIdent } <- with
+;;
+#0 "implementation: TRUE DOT LBRACE UIDENT RBRACE WHILE"
+true . { UIdent } while
+;;
+#0 "implementation: TRUE DOT LBRACE UIDENT WITH"
+true . { UIdent with
+;;
+#0 "implementation: TRUE DOT LBRACE WITH"
+true . { with
+;;
+#0 "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE"
+true . [ UIdent ] <- object end while
+;;
+#0 "implementation: TRUE DOT LBRACKET UIDENT RBRACKET LESSMINUS WITH"
+true . [ UIdent ] <- with
+;;
+#0 "implementation: TRUE DOT LBRACKET UIDENT RBRACKET WHILE"
+true . [ UIdent ] while
+;;
+#0 "implementation: TRUE DOT LBRACKET UIDENT WITH"
+true . [ UIdent with
+;;
+#0 "implementation: TRUE DOT LBRACKET WITH"
+true . [ with
+;;
+#0 "implementation: TRUE DOT LIDENT LESSMINUS OBJECT END WHILE"
+true . lident <- object end while
+;;
+#0 "implementation: TRUE DOT LIDENT LESSMINUS WITH"
+true . lident <- with
+;;
+#0 "implementation: TRUE DOT LIDENT WHILE"
+true . lident while
+;;
+#0 "implementation: TRUE DOT LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE"
+true . ( UIdent ) <- object end while
+;;
+#0 "implementation: TRUE DOT LPAREN UIDENT RPAREN LESSMINUS WITH"
+true . ( UIdent ) <- with
+;;
+#0 "implementation: TRUE DOT LPAREN UIDENT RPAREN WHILE"
+true . ( UIdent ) while
+;;
+#0 "implementation: TRUE DOT LPAREN UIDENT WITH"
+true . ( UIdent with
+;;
+#0 "implementation: TRUE DOT LPAREN WITH"
+true . ( with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE"
+true . UIdent .+ { UIdent } <- object end while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS WITH"
+true . UIdent .+ { UIdent } <- with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RBRACE WHILE"
+true . UIdent .+ { UIdent } while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACE UIDENT RPAREN"
+true . UIdent .+ { UIdent )
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACE WITH"
+true . UIdent .+ { with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE"
+true . UIdent .+ [ UIdent ] <- object end while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS WITH"
+true . UIdent .+ [ UIdent ] <- with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RBRACKET WHILE"
+true . UIdent .+ [ UIdent ] while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACKET UIDENT RPAREN"
+true . UIdent .+ [ UIdent )
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LBRACKET WITH"
+true . UIdent .+ [ with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RBRACKET"
+true . UIdent .+ ( UIdent ]
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE"
+true . UIdent .+ ( UIdent ) <- object end while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS WITH"
+true . UIdent .+ ( UIdent ) <- with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LPAREN UIDENT RPAREN WHILE"
+true . UIdent .+ ( UIdent ) while
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP LPAREN WITH"
+true . UIdent .+ ( with
+;;
+#0 "implementation: TRUE DOT UIDENT DOTOP WITH"
+true . UIdent .+ with
+;;
+#0 "implementation: TRUE DOT UIDENT WITH"
+true . UIdent with
+;;
+#0 "implementation: TRUE DOT WITH"
+true . with
+;;
+#0 "implementation: TRY LBRACKETAT AND RBRACKET AND"
+try [@ and ] and
+;;
+#0 "implementation: TRY PERCENT AND VIRTUAL"
+try % and virtual
+;;
+#0 "implementation: TRY UIDENT VAL"
+try UIdent val
+;;
+#0 "implementation: TRY UIDENT WITH UNDERSCORE MINUSGREATER DOT WHILE"
+try UIdent with _ -> . while
+;;
+#0 "implementation: TRY UIDENT WITH WITH"
+try UIdent with with
+;;
+#0 "implementation: TRY WITH"
+try with
+;;
+#0 "implementation: TYPE BANG WITH"
+type ! with
+;;
+#0 "implementation: TYPE LBRACKETAT AND RBRACKET BACKQUOTE"
+type [@ and ] `
+;;
+#0 "implementation: TYPE LIDENT AND LBRACKETAT AND RBRACKET WHILE"
+type lident and [@ and ] while
+;;
+#0 "implementation: TYPE LIDENT AND LIDENT EQUAL DOTDOT AMPERSAND"
+type lident and lident = .. &
+;;
+#0 "implementation: TYPE LIDENT AND LIDENT LBRACKETATAT AND RBRACKET METHOD"
+type lident and lident [@@ and ] method
+;;
+#0 "implementation: TYPE LIDENT AND LIDENT WITH"
+type lident and lident with
+;;
+#0 "implementation: TYPE LIDENT AND UNDERSCORE LETOP"
+type lident and _ let*
+;;
+#0 "implementation: TYPE LIDENT AND WITH"
+type lident and with
+;;
+#0 "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE EQUAL UNDERSCORE SEMI"
+type lident constraint _ = _ ;
+;;
+#0 "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE EQUAL WITH"
+type lident constraint _ = with
+;;
+#0 "implementation: TYPE LIDENT CONSTRAINT UNDERSCORE WITH"
+type lident constraint _ with
+;;
+#0 "implementation: TYPE LIDENT CONSTRAINT WITH"
+type lident constraint with
+;;
+#0 "implementation: TYPE LIDENT EQUAL BAR UIDENT OF LIDENT IN"
+type lident = | UIdent of lident in
+;;
+#0 "implementation: TYPE LIDENT EQUAL BAR UIDENT WITH"
+type lident = | UIdent with
+;;
+#0 "implementation: TYPE LIDENT EQUAL BAR WITH"
+type lident = | with
+;;
+#0 "implementation: TYPE LIDENT EQUAL DOTDOT AMPERSAND"
+type lident = .. &
+;;
+#0 "implementation: TYPE LIDENT EQUAL LBRACE WITH"
+type lident = { with
+;;
+#0 "implementation: TYPE LIDENT EQUAL LBRACKET WITH"
+type lident = [ with
+;;
+#0 "implementation: TYPE LIDENT EQUAL LPAREN WITH"
+type lident = ( with
+;;
+#0 "implementation: TYPE LIDENT EQUAL PRIVATE LBRACE WITH"
+type lident = private { with
+;;
+#0 "implementation: TYPE LIDENT EQUAL PRIVATE UNDERSCORE WITH"
+type lident = private _ with
+;;
+#0 "implementation: TYPE LIDENT EQUAL PRIVATE WITH"
+type lident = private with
+;;
+#0 "implementation: TYPE LIDENT EQUAL TRUE WITH"
+type lident = true with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UIDENT BAR WITH"
+type lident = UIdent | with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UIDENT LBRACKETAT AND RBRACKET WHILE"
+type lident = UIdent [@ and ] while
+;;
+#0 "implementation: TYPE LIDENT EQUAL UIDENT OF LIDENT IN"
+type lident = UIdent of lident in
+;;
+#0 "implementation: TYPE LIDENT EQUAL UIDENT WITH"
+type lident = UIdent with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL LBRACE WITH"
+type lident = _ = { with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL PRIVATE LBRACE WITH"
+type lident = _ = private { with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL PRIVATE WITH"
+type lident = _ = private with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UNDERSCORE EQUAL WITH"
+type lident = _ = with
+;;
+#0 "implementation: TYPE LIDENT EQUAL UNDERSCORE WITH"
+type lident = _ with
+;;
+#0 "implementation: TYPE LIDENT EQUAL WITH"
+type lident = with
+;;
+#0 "implementation: TYPE LIDENT LBRACKETATAT WITH RBRACKET METHOD"
+type lident [@@ with ] method
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ BAR UIDENT EQUAL TRUE WITH"
+type lident += | UIdent = true with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ BAR UIDENT EQUAL WITH"
+type lident += | UIdent = with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ BAR UIDENT WITH"
+type lident += | UIdent with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ BAR WITH"
+type lident += | with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ PRIVATE BANG"
+type lident += private !
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ UIDENT EQUAL TRUE WITH"
+type lident += UIdent = true with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ UIDENT EQUAL WITH"
+type lident += UIdent = with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ UIDENT OF LIDENT CONSTRAINT"
+type lident += UIdent of lident constraint
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ UIDENT WITH"
+type lident += UIdent with
+;;
+#0 "implementation: TYPE LIDENT PLUSEQ WITH"
+type lident += with
+;;
+#0 "implementation: TYPE LIDENT WITH"
+type lident with
+;;
+#0 "implementation: TYPE LPAREN UNDERSCORE COMMA WITH"
+type ( _ , with
+;;
+#0 "implementation: TYPE LPAREN UNDERSCORE WITH"
+type ( _ with
+;;
+#0 "implementation: TYPE LPAREN WITH"
+type ( with
+;;
+#0 "implementation: TYPE MINUS WITH"
+type - with
+;;
+#0 "implementation: TYPE NONREC LIDENT EQUAL DOTDOT AMPERSAND"
+type nonrec lident = .. &
+;;
+#0 "implementation: TYPE NONREC LIDENT WITH"
+type nonrec lident with
+;;
+#0 "implementation: TYPE NONREC UNDERSCORE LETOP"
+type nonrec _ let*
+;;
+#0 "implementation: TYPE NONREC WITH"
+type nonrec with
+;;
+#0 "implementation: TYPE PERCENT AND WHILE"
+type % and while
+;;
+#0 "implementation: TYPE PLUS WITH"
+type + with
+;;
+#0 "implementation: TYPE PREFIXOP WITH"
+type !+ with
+;;
+#0 "implementation: TYPE QUOTE WITH"
+type ' with
+;;
+#0 "implementation: TYPE UIDENT DOT LIDENT WITH"
+type UIdent . lident with
+;;
+#0 "implementation: TYPE UIDENT DOT WITH"
+type UIdent . with
+;;
+#0 "implementation: TYPE UIDENT LPAREN UIDENT DOT WITH"
+type UIdent ( UIdent . with
+;;
+#0 "implementation: TYPE UIDENT LPAREN UIDENT WITH"
+type UIdent ( UIdent with
+;;
+#0 "implementation: TYPE UIDENT LPAREN WITH"
+type UIdent ( with
+;;
+#0 "implementation: TYPE UIDENT WITH"
+type UIdent with
+;;
+#0 "implementation: TYPE UNDERSCORE LETOP"
+type _ let*
+;;
+#0 "implementation: TYPE WITH"
+type with
+;;
+#0 "implementation: UIDENT AMPERAMPER OBJECT END WHILE"
+UIdent && object end while
+;;
+#0 "implementation: UIDENT AMPERAMPER WITH"
+UIdent && with
+;;
+#0 "implementation: UIDENT AMPERSAND OBJECT END WHILE"
+UIdent & object end while
+;;
+#0 "implementation: UIDENT AMPERSAND WITH"
+UIdent & with
+;;
+#0 "implementation: UIDENT AS"
+UIdent as
+;;
+#0 "implementation: UIDENT BARBAR OBJECT END WHILE"
+UIdent || object end while
+;;
+#0 "implementation: UIDENT BARBAR WITH"
+UIdent || with
+;;
+#0 "implementation: UIDENT COLONCOLON OBJECT END WHILE"
+UIdent :: object end while
+;;
+#0 "implementation: UIDENT COLONCOLON WITH"
+UIdent :: with
+;;
+#0 "implementation: UIDENT COLONEQUAL OBJECT END WHILE"
+UIdent := object end while
+;;
+#0 "implementation: UIDENT COLONEQUAL WITH"
+UIdent := with
+;;
+#0 "implementation: UIDENT COMMA CHAR COMMA OBJECT END WHILE"
+UIdent , 'a' , object end while
+;;
+#0 "implementation: UIDENT COMMA CHAR COMMA WITH"
+UIdent , 'a' , with
+;;
+#0 "implementation: UIDENT COMMA OBJECT END WHILE"
+UIdent , object end while
+;;
+#0 "implementation: UIDENT COMMA WITH"
+UIdent , with
+;;
+#0 "implementation: UIDENT DOT LBRACE WITH"
+UIdent . { with
+;;
+#0 "implementation: UIDENT DOT LBRACELESS WITH"
+UIdent . {< with
+;;
+#0 "implementation: UIDENT DOT LBRACKET UIDENT RPAREN"
+UIdent . [ UIdent )
+;;
+#0 "implementation: UIDENT DOT LBRACKET WITH"
+UIdent . [ with
+;;
+#0 "implementation: UIDENT DOT LBRACKETBAR UIDENT RPAREN"
+UIdent . [| UIdent )
+;;
+#0 "implementation: UIDENT DOT LBRACKETBAR WITH"
+UIdent . [| with
+;;
+#0 "implementation: UIDENT DOT LPAREN COLONCOLON WITH"
+UIdent . ( :: with
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE LBRACKETAT AND RBRACKET WHILE"
+UIdent . ( module [@ and ] while
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE PERCENT AND FUNCTION"
+UIdent . ( module % and function
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE UIDENT COLON UIDENT VAL"
+UIdent . ( module UIdent : UIdent val
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE UIDENT COLON WITH"
+UIdent . ( module UIdent : with
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE UIDENT WITH"
+UIdent . ( module UIdent with
+;;
+#0 "implementation: UIDENT DOT LPAREN MODULE WITH"
+UIdent . ( module with
+;;
+#0 "implementation: UIDENT DOT LPAREN UIDENT WITH"
+UIdent . ( UIdent with
+;;
+#0 "implementation: UIDENT DOT LPAREN WITH"
+UIdent . ( with
+;;
+#0 "implementation: UIDENT DOT WITH"
+UIdent . with
+;;
+#0 "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS OBJECT END WHILE"
+UIdent .+ { UIdent } <- object end while
+;;
+#0 "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE LESSMINUS WITH"
+UIdent .+ { UIdent } <- with
+;;
+#0 "implementation: UIDENT DOTOP LBRACE UIDENT RBRACE WHILE"
+UIdent .+ { UIdent } while
+;;
+#0 "implementation: UIDENT DOTOP LBRACE UIDENT SEMI RPAREN"
+UIdent .+ { UIdent ; )
+;;
+#0 "implementation: UIDENT DOTOP LBRACE UIDENT WITH"
+UIdent .+ { UIdent with
+;;
+#0 "implementation: UIDENT DOTOP LBRACE WITH"
+UIdent .+ { with
+;;
+#0 "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS OBJECT END WHILE"
+UIdent .+ [ UIdent ] <- object end while
+;;
+#0 "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET LESSMINUS WITH"
+UIdent .+ [ UIdent ] <- with
+;;
+#0 "implementation: UIDENT DOTOP LBRACKET UIDENT RBRACKET WHILE"
+UIdent .+ [ UIdent ] while
+;;
+#0 "implementation: UIDENT DOTOP LBRACKET UIDENT RPAREN"
+UIdent .+ [ UIdent )
+;;
+#0 "implementation: UIDENT DOTOP LBRACKET WITH"
+UIdent .+ [ with
+;;
+#0 "implementation: UIDENT DOTOP LPAREN UIDENT RBRACKET"
+UIdent .+ ( UIdent ]
+;;
+#0 "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS OBJECT END WHILE"
+UIdent .+ ( UIdent ) <- object end while
+;;
+#0 "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN LESSMINUS WITH"
+UIdent .+ ( UIdent ) <- with
+;;
+#0 "implementation: UIDENT DOTOP LPAREN UIDENT RPAREN WHILE"
+UIdent .+ ( UIdent ) while
+;;
+#0 "implementation: UIDENT DOTOP LPAREN WITH"
+UIdent .+ ( with
+;;
+#0 "implementation: UIDENT DOTOP WITH"
+UIdent .+ with
+;;
+#0 "implementation: UIDENT EQUAL OBJECT END WHILE"
+UIdent = object end while
+;;
+#0 "implementation: UIDENT EQUAL WITH"
+UIdent = with
+;;
+#0 "implementation: UIDENT GREATER OBJECT END WHILE"
+UIdent > object end while
+;;
+#0 "implementation: UIDENT GREATER WITH"
+UIdent > with
+;;
+#0 "implementation: UIDENT HASH WITH"
+UIdent # with
+;;
+#0 "implementation: UIDENT HASHOP TRUE WHILE"
+UIdent ## true while
+;;
+#0 "implementation: UIDENT HASHOP WITH"
+UIdent ## with
+;;
+#0 "implementation: UIDENT INFIXOP0 OBJECT END WHILE"
+UIdent != object end while
+;;
+#0 "implementation: UIDENT INFIXOP0 WITH"
+UIdent != with
+;;
+#0 "implementation: UIDENT INFIXOP1 OBJECT END WHILE"
+UIdent @ object end while
+;;
+#0 "implementation: UIDENT INFIXOP1 WITH"
+UIdent @ with
+;;
+#0 "implementation: UIDENT INFIXOP2 OBJECT END WHILE"
+UIdent +! object end while
+;;
+#0 "implementation: UIDENT INFIXOP2 WITH"
+UIdent +! with
+;;
+#0 "implementation: UIDENT INFIXOP3 OBJECT END WHILE"
+UIdent land object end while
+;;
+#0 "implementation: UIDENT INFIXOP3 WITH"
+UIdent land with
+;;
+#0 "implementation: UIDENT INFIXOP4 OBJECT END WHILE"
+UIdent ** object end while
+;;
+#0 "implementation: UIDENT INFIXOP4 WITH"
+UIdent ** with
+;;
+#0 "implementation: UIDENT LABEL TRUE WHILE"
+UIdent ~label: true while
+;;
+#0 "implementation: UIDENT LABEL WITH"
+UIdent ~label: with
+;;
+#0 "implementation: UIDENT LBRACKETAT UNDERSCORE"
+UIdent [@ _
+;;
+#0 "implementation: UIDENT LBRACKETAT WITH UIDENT WHEN"
+UIdent [@ with UIdent when
+;;
+#0 "implementation: UIDENT LBRACKETAT WITH VIRTUAL"
+UIdent [@ with virtual
+;;
+#0 "implementation: UIDENT LBRACKETATAT AND RBRACKET AND"
+UIdent [@@ and ] and
+;;
+#0 "implementation: UIDENT LESS OBJECT END WHILE"
+UIdent < object end while
+;;
+#0 "implementation: UIDENT LESS WITH"
+UIdent < with
+;;
+#0 "implementation: UIDENT MINUS OBJECT END WHILE"
+UIdent - object end while
+;;
+#0 "implementation: UIDENT MINUS WITH"
+UIdent - with
+;;
+#0 "implementation: UIDENT MINUSDOT OBJECT END WHILE"
+UIdent -. object end while
+;;
+#0 "implementation: UIDENT MINUSDOT WITH"
+UIdent -. with
+;;
+#0 "implementation: UIDENT OPTLABEL TRUE WHILE"
+UIdent ?label: true while
+;;
+#0 "implementation: UIDENT OPTLABEL WITH"
+UIdent ?label: with
+;;
+#0 "implementation: UIDENT OR OBJECT END WHILE"
+UIdent or object end while
+;;
+#0 "implementation: UIDENT OR WITH"
+UIdent or with
+;;
+#0 "implementation: UIDENT PERCENT OBJECT END WHILE"
+UIdent % object end while
+;;
+#0 "implementation: UIDENT PERCENT WITH"
+UIdent % with
+;;
+#0 "implementation: UIDENT PLUS OBJECT END WHILE"
+UIdent + object end while
+;;
+#0 "implementation: UIDENT PLUS WITH"
+UIdent + with
+;;
+#0 "implementation: UIDENT PLUSDOT OBJECT END WHILE"
+UIdent +. object end while
+;;
+#0 "implementation: UIDENT PLUSDOT WITH"
+UIdent +. with
+;;
+#0 "implementation: UIDENT PLUSEQ OBJECT END WHILE"
+UIdent += object end while
+;;
+#0 "implementation: UIDENT PLUSEQ WITH"
+UIdent += with
+;;
+#0 "implementation: UIDENT QUESTION WITH"
+UIdent ? with
+;;
+#0 "implementation: UIDENT RBRACKET"
+UIdent ]
+;;
+#0 "implementation: UIDENT SEMI PERCENT UNDERSCORE"
+UIdent ; % _
+;;
+#0 "implementation: UIDENT SEMI PERCENT WITH VIRTUAL"
+UIdent ; % with virtual
+;;
+#0 "implementation: UIDENT SEMI WHEN"
+UIdent ; when
+;;
+#0 "implementation: UIDENT STAR OBJECT END WHILE"
+UIdent * object end while
+;;
+#0 "implementation: UIDENT STAR WITH"
+UIdent * with
+;;
+#0 "implementation: UIDENT TILDE WITH"
+UIdent ~ with
+;;
+#0 "implementation: UIDENT UIDENT UIDENT"
+UIdent UIdent UIdent
+;;
+#0 "implementation: UIDENT WHILE"
+UIdent while
+;;
+#0 "implementation: UIDENT WITH"
+UIdent with
+;;
+#0 "implementation: VAL LBRACKETAT AND RBRACKET WHILE"
+val [@ and ] while
+;;
+#0 "implementation: VAL LIDENT COLON UNDERSCORE WITH"
+val lident : _ with
+;;
+#0 "implementation: VAL LIDENT COLON WITH"
+val lident : with
+;;
+#0 "implementation: VAL LIDENT WITH"
+val lident with
+;;
+#0 "implementation: VAL PERCENT AND LBRACKET"
+val % and [
+;;
+#0 "implementation: VAL WITH"
+val with
+;;
+#0 "implementation: WHILE LBRACKETAT WITH RBRACKET AND"
+while [@ with ] and
+;;
+#0 "implementation: WHILE PERCENT WITH VIRTUAL"
+while % with virtual
+;;
+#0 "implementation: WHILE UIDENT DO UIDENT WITH"
+while UIdent do UIdent with
+;;
+#0 "implementation: WHILE UIDENT DO WITH"
+while UIdent do with
+;;
+#0 "implementation: WHILE UIDENT WITH"
+while UIdent with
+;;
+#0 "implementation: WHILE WITH"
+while with
+;;
+#0 "implementation: WITH"
+with
+;;
(* TEST
- * hasinstrumentedruntime
+ * instrumented-runtime
** native
flags = "-runtime-variant=i"
*)
^^^^^^^^
Warning 18 [not-principal]: typing this pattern requires considering GADT_ordering.point and a as equal.
But the knowledge of these types is not principal.
-Line 5, characters 13-14:
+Line 5, characters 11-19:
5 | and+ { x; y } = a in
- ^
-Error: The record field x belongs to the type GADT_ordering.point
- but is mixed here with fields of type a = GADT_ordering.point
+ ^^^^^^^^
+Error: This pattern matches values of type GADT_ordering.point
+ but a pattern was expected which matches values of type
+ a = GADT_ordering.point
This instance of GADT_ordering.point is ambiguous:
it would escape the scope of its equation
|}];;
- : unit = ()
- : float array = [|0.; 0.; 42.; 42.; 42.; 0.; 0.; 0.|]
|}]
+
+let a = [|(1, 'a'); (2, 'b'); (3, 'c')|];;
+let _ = Array.split a;;
+[%%expect{|
+val a : (int * char) array = [|(1, 'a'); (2, 'b'); (3, 'c')|]
+- : int array * char array = ([|1; 2; 3|], [|'a'; 'b'; 'c'|])
+|}]
+
+let a = [|1; 2; 3|];;
+let b = [|'a'; 'b'; 'c'|];;
+let _ = Array.combine a b;;
+[%%expect{|
+val a : int array = [|1; 2; 3|]
+val b : char array = [|'a'; 'b'; 'c'|]
+- : (int * char) array = [|(1, 'a'); (2, 'b'); (3, 'c')|]
+|}]
+
+let _ : int array * char array = Array.split [||];;
+[%%expect{|
+- : int array * char array = ([||], [||])
+|}]
+
+let _ : (int * char) array = Array.combine [||] [||];;
+[%%expect{|
+- : (int * char) array = [||]
+|}]
+
+let _ = Array.combine [||] [|1|];;
+[%%expect{|
+Exception: Invalid_argument "Array.combine".
+|}]
+
+let a = [|1; 2; 3|];;
+let _ = Array.find_opt (function 2 -> true | _ -> false) a;;
+[%%expect{|
+val a : int array = [|1; 2; 3|]
+- : int option = Some 2
+|}]
+
+let a = [|'a'; 'b'; 'c'|];;
+let _ = Array.find_map (function 'b' -> Some 121 | _ -> None) a;;
+[%%expect{|
+val a : char array = [|'a'; 'b'; 'c'|]
+- : int option = Some 121
+|}]
+
+let a = [|1; 2|];;
+let _ = Array.find_opt (function 101 -> true | _ -> false) a;;
+[%%expect{|
+val a : int array = [|1; 2|]
+- : int option = None
+|}]
+
+let a = [|1; 2|];;
+let _ = Array.find_map (fun _ -> None) a;;
+[%%expect{|
+val a : int array = [|1; 2|]
+- : 'a option = None
+|}]
+
+let a = Array.init 8 succ;;
+let _ = Array.fold_left_map (fun a b -> a + b, string_of_int b) 0 a;;
+a (* [a] is unchanged *);;
+[%%expect {|
+val a : int array = [|1; 2; 3; 4; 5; 6; 7; 8|]
+- : int * string array = (36, [|"1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"|])
+- : int array = [|1; 2; 3; 4; 5; 6; 7; 8|]
+|}]
+
+let (_ : (_ * unit array)) =
+ Array.fold_left_map (fun _ _ -> assert false) 0 [||];;
+[%%expect{|
+- : int * unit array = (0, [||])
+|}]
--- /dev/null
+(* TEST
+
+modules = "bigarrcstub.c"
+
+*)
+
+open Bigarray
+open Printf
+
+(* Test harness *)
+
+let error_occurred = ref false
+
+let function_tested = ref ""
+
+let testing_function s =
+ function_tested := s;
+ print_newline();
+ print_string s;
+ print_newline()
+
+let test test_number answer correct_answer =
+ flush stdout;
+ flush stderr;
+ if answer <> correct_answer then begin
+ eprintf "*** Bad result (%s, test %d)\n" !function_tested test_number;
+ flush stderr;
+ error_occurred := true
+ end else begin
+ printf " %d..." test_number
+ end
+
+(* External C functions *)
+
+external c_filltab :
+ unit -> (float, float64_elt, c_layout) Array2.t = "c_filltab"
+external c_printtab :
+ (float, float64_elt, c_layout) Array2.t -> unit = "c_printtab"
+
+let _ =
+
+ let make_array2 kind layout ind0 dim1 dim2 fromint =
+ let a = Array2.create kind layout dim1 dim2 in
+ for i = ind0 to dim1 - 1 + ind0 do
+ for j = ind0 to dim2 - 1 + ind0 do
+ a.{i,j} <- (fromint (i * 1000 + j))
+ done
+ done;
+ a in
+
+ print_newline();
+ testing_function "------ Foreign function interface --------";
+ testing_function "Passing an array to C";
+ c_printtab (make_array2 float64 c_layout 0 6 8 float);
+ testing_function "Accessing a C array";
+ let a = c_filltab () in
+ test 1 a.{0,0} 0.0;
+ test 2 a.{1,0} 100.0;
+ test 3 a.{0,1} 1.0;
+ test 4 a.{5,4} 504.0;
--- /dev/null
+
+
+------ Foreign function interface --------
+
+Passing an array to C
+ 0 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0
+ 1 1000.0 1001.0 1002.0 1003.0 1004.0 1005.0 1006.0 1007.0
+ 2 2000.0 2001.0 2002.0 2003.0 2004.0 2005.0 2006.0 2007.0
+ 3 3000.0 3001.0 3002.0 3003.0 3004.0 3005.0 3006.0 3007.0
+ 4 4000.0 4001.0 4002.0 4003.0 4004.0 4005.0 4006.0 4007.0
+ 5 5000.0 5001.0 5002.0 5003.0 5004.0 5005.0 5006.0 5007.0
+
+Accessing a C array
+ 1... 2... 3... 4...
\ No newline at end of file
--- /dev/null
+/**************************************************************************/
+/* */
+/* OCaml */
+/* */
+/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
+/* */
+/* Copyright 2000 Institut National de Recherche en Informatique et */
+/* en Automatique. */
+/* */
+/* All rights reserved. This file is distributed under the terms of */
+/* the GNU Lesser General Public License version 2.1, with the */
+/* special exception on linking described in the file LICENSE. */
+/* */
+/**************************************************************************/
+
+#define CAML_NAME_SPACE
+#include <stdio.h>
+#include <caml/mlvalues.h>
+#include <caml/bigarray.h>
+
+#define DIMX 6
+#define DIMY 8
+
+double ctab[DIMX][DIMY];
+
+void filltab(void)
+{
+ int x, y;
+ for (x = 0; x < DIMX; x++)
+ for (y = 0; y < DIMY; y++)
+ ctab[x][y] = x * 100 + y;
+}
+
+void printtab(double tab[DIMX][DIMY])
+{
+ int x, y;
+ for (x = 0; x < DIMX; x++) {
+ printf("%3d", x);
+ for (y = 0; y < DIMY; y++)
+ printf(" %6.1f", tab[x][y]);
+ printf("\n");
+ }
+}
+
+value c_filltab(value unit)
+{
+ filltab();
+ return caml_ba_alloc_dims(CAML_BA_FLOAT64 | CAML_BA_C_LAYOUT,
+ 2, ctab, (intnat)DIMX, (intnat)DIMY);
+}
+
+value c_printtab(value ba)
+{
+ printtab(Caml_ba_data_val(ba));
+ fflush(stdout);
+ return Val_unit;
+}
(* TEST
-files = "bigarrf.f bigarrfstub.c"
+readonly_files = "bigarrf.f bigarrfstub.c"
last_flags = "-cclib -lgfortran"
* script
printf " %d..." test_number
end
-(* External C and Fortran functions *)
+(* External Fortran functions *)
-external c_filltab :
- unit -> (float, float64_elt, c_layout) Array2.t = "c_filltab"
-external c_printtab :
- (float, float64_elt, c_layout) Array2.t -> unit = "c_printtab"
external fortran_filltab :
unit -> (float, float32_elt, fortran_layout) Array2.t = "fortran_filltab"
external fortran_printtab :
print_newline();
testing_function "------ Foreign function interface --------";
- testing_function "Passing an array to C";
- c_printtab (make_array2 float64 c_layout 0 6 8 float);
- testing_function "Accessing a C array";
- let a = c_filltab () in
- test 1 a.{0,0} 0.0;
- test 2 a.{1,0} 100.0;
- test 3 a.{0,1} 1.0;
- test 4 a.{5,4} 504.0;
testing_function "Passing an array to Fortran";
fortran_printtab (make_array2 float32 fortran_layout 1 5 4 float);
testing_function "Accessing a Fortran array";
------ Foreign function interface --------
-Passing an array to C
-
-Accessing a C array
- 1... 2... 3... 4...
Passing an array to Fortran
- 0 0.0 1.0 2.0 3.0 4.0 5.0 6.0 7.0
- 1 1000.0 1001.0 1002.0 1003.0 1004.0 1005.0 1006.0 1007.0
- 2 2000.0 2001.0 2002.0 2003.0 2004.0 2005.0 2006.0 2007.0
- 3 3000.0 3001.0 3002.0 3003.0 3004.0 3005.0 3006.0 3007.0
- 4 4000.0 4001.0 4002.0 4003.0 4004.0 4005.0 4006.0 4007.0
- 5 5000.0 5001.0 5002.0 5003.0 5004.0 5005.0 5006.0 5007.0
Accessing a Fortran array
1... 2... 3... 4...
/* */
/**************************************************************************/
+#define CAML_NAME_SPACE
#include <stdio.h>
#include <caml/mlvalues.h>
#include <caml/bigarray.h>
extern void printtab_(float * data, int * dimx, int * dimy);
extern float ftab_[];
-#define DIMX 6
-#define DIMY 8
-
-double ctab[DIMX][DIMY];
-
-void filltab(void)
-{
- int x, y;
- for (x = 0; x < DIMX; x++)
- for (y = 0; y < DIMY; y++)
- ctab[x][y] = x * 100 + y;
-}
-
-void printtab(double tab[DIMX][DIMY])
-{
- int x, y;
- for (x = 0; x < DIMX; x++) {
- printf("%3d", x);
- for (y = 0; y < DIMY; y++)
- printf(" %6.1f", tab[x][y]);
- printf("\n");
- }
-}
-
-value c_filltab(value unit)
-{
- filltab();
- return alloc_bigarray_dims(BIGARRAY_FLOAT64 | BIGARRAY_C_LAYOUT,
- 2, ctab, DIMX, DIMY);
-}
-
-value c_printtab(value ba)
-{
- printtab(Data_bigarray_val(ba));
- return Val_unit;
-}
-
value fortran_filltab(value unit)
{
filltab_();
- return alloc_bigarray_dims(BIGARRAY_FLOAT32 | BIGARRAY_FORTRAN_LAYOUT,
- 2, ftab_, 8, 6);
+ return caml_ba_alloc_dims(CAML_BA_FLOAT32 | CAML_BA_FORTRAN_LAYOUT,
+ 2, ftab_, (intnat)8, (intnat)6);
}
value fortran_printtab(value ba)
{
- int dimx = Bigarray_val(ba)->dim[0];
- int dimy = Bigarray_val(ba)->dim[1];
- printtab_(Data_bigarray_val(ba), &dimx, &dimy);
+ int dimx = Caml_ba_array_val(ba)->dim[0];
+ int dimy = Caml_ba_array_val(ba)->dim[1];
+ printtab_(Caml_ba_data_val(ba), &dimx, &dimy);
return Val_unit;
}
length r = 7
&& check r 1 "abcde");
+ (*
+ abcde
+ edcba
+ *)
+ Testing.test
+ (let r = copy abcde in
+ let l = fold_left (fun acc x -> (make 1 x)::acc) [] r in
+ let result = concat (Bytes.of_string "") l in
+ length result = 5
+ && check result 0 "edcba");
+
+ (*
+ abcde
+ abcde
+ *)
+ Testing.test
+ (let r = copy abcde in
+ let l = fold_right (fun x acc -> (make 1 x)::acc) r [] in
+ let result = concat (Bytes.of_string "") l in
+ length result = 5
+ && check result 0 "abcde");
+
+ (*
+ test exists and for_all
+ *)
+ Testing.test
+ (exists (fun c -> c = 'b') abcde
+ && not (exists (fun c -> c = 'f') abcde)
+ && for_all (fun c -> c <> 'f') abcde
+ && not (for_all (fun c -> c = 'b') abcde));
+
(* length + left + right < 0 *)
test_raises_invalid_argument
(fun () -> extend abcde (-3) (-3)) ();
- 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
All tests succeeded.
(* TEST
- flags += " -w a "
+ flags += " -w -a "
*)
(* Test int32 arithmetic and optimizations using the MD5 algorithm *)
ld_library_path += "${test_build_directory}"
-files = "plug1.ml plug2.ml registry.ml stub1.c stub2.c"
+readonly_files = "plug1.ml plug2.ml registry.ml stub1.c stub2.c"
* shared-libraries
** setup-ocamlc.byte-build-env
include dynlink
-files = "entry.c main.cs plugin.ml"
+readonly_files = "entry.c main.cs plugin.ml"
* csharp-compiler
** shared-libraries
all_modules = "dynlink.cma entry.c main.ml"
****** script
script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
- ${ocamlsrcdir}/runtime/libcamlrun.lib ${bytecc_libs}"
+ ${ocamlsrcdir}/runtime/libcamlrun.${libext} ${bytecc_libs}"
******* script
script = "${csharp_cmd}"
******** run
all_modules = "dynlink.cmxa entry.c main.ml"
****** script
script = "${mkdll} -maindll -o main.dll main_obj.${objext} entry.${objext} \
- ${ocamlsrcdir}/runtime/libasmrun.lib ${nativecc_libs}"
+ ${ocamlsrcdir}/runtime/libasmrun.${libext} ${nativecc_libs}"
******* script
script = "${csharp_cmd}"
******** run
Called from Test10_plugin in file "test10_plugin.ml", line 10, characters 2-6
Called from Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 137, characters 16-25
Re-raised at Dynlink.Bytecode.run in file "otherlibs/dynlink/dynlink.ml", line 139, characters 6-137
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 337, characters 13-44
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 335, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-17
Called from Test10_main in file "test10_main.ml", line 51, characters 13-69
include dynlink
-files = "test10_plugin.ml"
+readonly_files = "test10_plugin.ml"
flags += "-g"
libraries = ""
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
Called from Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 85, characters 12-29
Re-raised at Dynlink.Native.run.(fun) in file "otherlibs/dynlink/native/dynlink.ml", line 87, characters 10-149
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 347, characters 13-44
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
-Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-240
-Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 355, characters 8-17
-Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 357, characters 26-45
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load.(fun) in file "otherlibs/dynlink/dynlink_common.ml", line 337, characters 13-44
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
+Called from Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 335, characters 8-240
+Re-raised at Dynlink_common.Make.load in file "otherlibs/dynlink/dynlink_common.ml", line 345, characters 8-17
+Called from Dynlink_common.Make.loadfile in file "otherlibs/dynlink/dynlink_common.ml" (inlined), line 347, characters 26-45
Called from Test10_main in file "test10_main.ml", line 49, characters 30-87
include dynlink
-files = "test1_inited_second.ml test1_plugin.ml"
+readonly_files = "test1_inited_second.ml test1_plugin.ml"
libraries = ""
include dynlink
-files = "test2_inited_first.ml test2_plugin.ml"
+readonly_files = "test2_inited_first.ml test2_plugin.ml"
libraries = ""
include dynlink
-files = "test3_plugin_a.ml test3_plugin_b.ml"
+readonly_files = "test3_plugin_a.ml test3_plugin_b.ml"
libraries = ""
include dynlink
-files = "test4_plugin_a.ml test4_plugin_b.ml"
+readonly_files = "test4_plugin_a.ml test4_plugin_b.ml"
libraries = ""
include dynlink
-files = "test5_plugin_a.ml test5_plugin_b.ml test5_second_plugin.ml"
+readonly_files = "test5_plugin_a.ml test5_plugin_b.ml test5_second_plugin.ml"
libraries = ""
include dynlink
-files = "test6_plugin.ml test6_second_plugin.ml"
+readonly_files = "test6_plugin.ml test6_second_plugin.ml"
libraries = ""
include dynlink
-files = "test7_interface_only.mli test7_plugin.ml"
+readonly_files = "test7_interface_only.mli test7_plugin.ml"
libraries = ""
include dynlink
-files = "test8_plugin_a.ml test8_plugin_b.ml test8_plugin_b.mli"
+readonly_files = "test8_plugin_a.ml test8_plugin_b.ml test8_plugin_b.mli"
libraries = ""
include dynlink
-files = "test9_plugin.ml test9_second_plugin.ml test9_second_plugin.mli"
+readonly_files = "test9_plugin.ml test9_second_plugin.ml test9_second_plugin.mli"
libraries = ""
(* TEST
-files = "a.ml api.ml b.ml bug.ml c.ml factorial.c pack_client.ml \
+readonly_files = "a.ml api.ml b.ml bug.ml c.ml factorial.c pack_client.ml \
packed1_client.ml packed1.ml plugin2.ml plugin4.ml plugin_ext.ml \
plugin_high_arity.ml plugin.ml plugin.mli plugin_ref.ml \
plugin_simple.ml plugin_thread.ml"
+subdirectories = "sub"
* hassysthreads
include systhreads
include dynlink
-set subdir = "${test_source_directory}/sub"
-
** native-dynlink
libraries = "" (* We will add them manually where appropriated *)
*** setup-ocamlopt.byte-build-env
ocamlopt_default_flags = "" (* Removes the -ccopt -no-pie on ised on OpenBSD *)
-**** script
-script = "mkdir sub"
-***** script
-script = "cp ${subdir}/api.mli ${subdir}/api.ml ${subdir}/plugin3.ml \
- ${subdir}/plugin.ml sub"
-****** ocamlopt.byte
+
+**** ocamlopt.byte
module = "api.ml"
-******* ocamlopt.byte
+***** ocamlopt.byte
flags = "-opaque"
module = "plugin.mli"
-******** ocamlopt.byte
+****** ocamlopt.byte
flags = ""
module = "plugin.ml"
-********* ocamlopt.byte
+******* ocamlopt.byte
module= ""
flags = "-shared"
program = "plugin.so"
all_modules = "plugin.cmx"
-********** script
+******** script
script = "mv plugin.cmx plugin.cmx.bak"
-*********** ocamlopt.byte
+********* ocamlopt.byte
flags = ""
module = "plugin2.ml"
-************ script
+********** script
script = "mv plugin.cmx.bak plugin.cmx"
-************* ocamlopt.byte
+*********** ocamlopt.byte
module= ""
flags = "-shared"
program = "plugin2.so"
all_modules = "plugin2.cmx"
-************** ocamlopt.byte
+************ ocamlopt.byte
flags = ""
module = "sub/plugin.ml"
-*************** ocamlopt.byte
+************* ocamlopt.byte
module = ""
flags = "-shared"
program = "sub/plugin.so"
all_modules = "sub/plugin.cmx"
-**************** cd
+************** cd
cwd = "sub"
-***************** ocamlopt.byte
+*************** ocamlopt.byte
module = "api.mli"
flags = "-opaque"
-****************** ocamlopt.byte
+**************** ocamlopt.byte
flags = ""
module = "api.ml"
-******************* script
+***************** script
script = "mv api.cmx api.cmx.bak"
-******************** ocamlopt.byte
+****************** ocamlopt.byte
module = "plugin3.ml"
-********************* script
+******************* script
script = "mv api.cmx.bak api.cmx"
-********************** cd
+******************** cd
cwd = ".."
-*********************** ocamlopt.byte
+********************* ocamlopt.byte
module = ""
flags = "-shared"
program = "sub/plugin3.so"
all_modules = "sub/plugin3.cmx"
-************************ ocamlopt.byte
+********************** ocamlopt.byte
flags = ""
module = "plugin4.ml"
-************************* ocamlopt.byte
+*********************** ocamlopt.byte
module = ""
flags = "-shared"
program = "plugin4.so"
all_modules = "plugin4.cmx"
-************************** ocamlopt.byte
+************************ ocamlopt.byte
module = "packed1.ml"
flags = "-for-pack Mypack"
-*************************** ocamlopt.byte
+************************* ocamlopt.byte
flags = "-S -pack"
module = ""
program = "mypack.cmx"
all_modules = "packed1.cmx"
-**************************** ocamlopt.byte
+************************** ocamlopt.byte
program = "mypack.so"
flags = "-shared"
all_modules = "mypack.cmx"
-***************************** ocamlopt.byte
+*************************** ocamlopt.byte
program = "packed1.so"
flags = "-shared"
all_modules = "packed1.cmx"
-****************************** ocamlopt.byte
+**************************** ocamlopt.byte
flags = ""
module = "packed1_client.ml"
-******************************* ocamlopt.byte
+***************************** ocamlopt.byte
module = ""
program = "packed1_client.so"
flags = "-shared"
all_modules = "packed1_client.cmx"
-******************************** ocamlopt.byte
+****************************** ocamlopt.byte
flags = ""
module = "pack_client.ml"
-********************************* ocamlopt.byte
+******************************* ocamlopt.byte
module = ""
program = "pack_client.so"
flags = "-shared"
all_modules = "pack_client.cmx"
-********************************** ocamlopt.byte
+******************************** ocamlopt.byte
flags = ""
module = "plugin_ref.ml"
-*********************************** ocamlopt.byte
+********************************* ocamlopt.byte
module = ""
program = "plugin_ref.so"
flags = "-shared"
all_modules = "plugin_ref.cmx"
-************************************ ocamlopt.byte
+********************************** ocamlopt.byte
flags = ""
module = "plugin_high_arity.ml"
-************************************* ocamlopt.byte
+*********************************** ocamlopt.byte
module = ""
program = "plugin_high_arity.so"
flags = "-shared"
all_modules = "plugin_high_arity.cmx"
-************************************** ocamlopt.byte
+************************************ ocamlopt.byte
flags = "-ccopt ${shared_library_cflags}"
module = "factorial.c"
-*************************************** ocamlopt.byte
+************************************* ocamlopt.byte
flags = ""
module = "plugin_ext.ml"
-**************************************** ocamlopt.byte
+************************************** ocamlopt.byte
module = ""
program = "plugin_ext.so"
flags = "-shared"
all_modules = "factorial.${objext} plugin_ext.cmx"
-***************************************** ocamlopt.byte
+*************************************** ocamlopt.byte
module = "plugin_simple.ml"
flags = ""
-****************************************** ocamlopt.byte
+**************************************** ocamlopt.byte
module = ""
program = "plugin_simple.so"
flags = "-shared"
all_modules = "plugin_simple.cmx"
-****************************************** ocamlopt.byte
+**************************************** ocamlopt.byte
module = "bug.ml"
flags = ""
-******************************************* ocamlopt.byte
+***************************************** ocamlopt.byte
module = ""
program = "bug.so"
flags = "-shared"
all_modules = "bug.cmx"
-******************************************* ocamlopt.byte
+***************************************** ocamlopt.byte
module = "plugin_thread.ml"
flags = ""
-******************************************** ocamlopt.byte
+****************************************** ocamlopt.byte
module = ""
program = "plugin_thread.so"
flags = "-shared"
all_modules = "plugin_thread.cmx"
-********************************************* ocamlopt.byte
+******************************************* ocamlopt.byte
program = "plugin4_unix.so"
all_modules = "unix.cmxa plugin4.cmx"
-********************************************** ocamlopt.byte
+******************************************** ocamlopt.byte
flags = ""
compile_only = "true"
all_modules = "a.ml b.ml c.ml main.ml"
-*********************************************** ocamlopt.byte
+********************************************* ocamlopt.byte
module = ""
compile_only = "false"
flags = "-shared"
program = "a.so"
all_modules = "a.cmx"
-************************************************ ocamlopt.byte
+********************************************** ocamlopt.byte
program = "b.so"
all_modules = "b.cmx"
-************************************************* ocamlopt.byte
+*********************************************** ocamlopt.byte
program = "c.so"
all_modules = "c.cmx"
-************************************************** ocamlopt.byte
+************************************************ ocamlopt.byte
program = "mylib.cmxa"
flags = "-a"
all_modules = "plugin.cmx plugin2.cmx"
-*************************************************** ocamlopt.byte
+************************************************* ocamlopt.byte
program = "mylib.so"
flags = "-shared -linkall"
all_modules = "mylib.cmxa"
-**************************************************** ocamlopt.byte
+************************************************** ocamlopt.byte
program = "${test_build_directory}/main.exe"
libraries = "unix threads dynlink"
flags = "-linkall"
test was ported to ocamltest.
*)
-***************************************************** run
+*************************************************** run
arguments = "plugin.so plugin2.so plugin_thread.so"
-****************************************************** check-program-output
+**************************************************** check-program-output
*)
let () =
include dynlink
libraries = ""
-files = "a.ml b.ml loader.ml"
+readonly_files = "a.ml b.ml loader.ml"
* shared-libraries
** setup-ocamlc.byte-build-env
include dynlink
-files = "abstract.mli abstract.ml static.ml client.ml main.ml"
+readonly_files = "abstract.mli abstract.ml static.ml client.ml main.ml"
-set src_sub = "${test_source_directory}/sub"
+subdirectories = "sub"
libraries = ""
* shared-libraries
** setup-ocamlc.byte-build-env
-*** script
-script = "mkdir sub"
-**** script
-script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
-***** cd
+*** cd
cwd = "sub"
-****** ocamlc.byte
+**** ocamlc.byte
module = "abstract.mli"
-******* ocamlc.byte
+***** ocamlc.byte
module = "abstract.ml"
-******** cd
+****** cd
cwd = ".."
-********* ocamlc.byte
+******* ocamlc.byte
module = "abstract.mli"
-********** ocamlc.byte
+******** ocamlc.byte
module = "abstract.ml"
-*********** ocamlc.byte
+********* ocamlc.byte
module = "static.ml"
-************ ocamlc.byte
+********** ocamlc.byte
module = "client.ml"
-************* ocamlc.byte
+*********** ocamlc.byte
module = "main.ml"
-************** ocamlc.byte
+************ ocamlc.byte
program = "${test_build_directory}/main"
libraries = "dynlink"
module = ""
all_modules = "abstract.cmo static.cmo main.cmo"
-*************** run
+************* run
exit_status = "2"
-**************** check-program-output
+************** check-program-output
** native-dynlink
*** setup-ocamlopt.byte-build-env
-**** script
-script = "mkdir sub"
-***** script
-script = "cp ${src_sub}/abstract.mli ${src_sub}/abstract.ml sub"
-****** cd
+**** cd
cwd = "sub"
-******* ocamlopt.byte
+***** ocamlopt.byte
module = "abstract.mli"
-******** ocamlopt.byte
+****** ocamlopt.byte
program = "abstract.cmxs"
flags = "-shared"
module = ""
all_modules = "abstract.ml"
-********* cd
+******* cd
cwd = ".."
-********** ocamlopt.byte
+******** ocamlopt.byte
flags = ""
module = "abstract.mli"
-*********** ocamlopt.byte
+********* ocamlopt.byte
module = "abstract.ml"
-************ ocamlopt.byte
+********** ocamlopt.byte
module = "static.ml"
-************* ocamlopt.byte
+*********** ocamlopt.byte
program = "client.cmxs"
flags = "-shared"
module = ""
all_modules = "client.ml"
-************* ocamlopt.byte
+*********** ocamlopt.byte
module = "main.ml"
-************** ocamlopt.byte
+************ ocamlopt.byte
program = "${test_build_directory}/main_native"
libraries = "dynlink"
module = ""
all_modules = "abstract.cmx static.cmx main.cmx"
-*************** run
+************* run
exit_status = "2"
-**************** check-program-output
+************** check-program-output
*)
(* PR#4229 *)
include dynlink
libraries = ""
-set host = "${test_source_directory}/host"
-set plugin1 = "${test_source_directory}/plugin1"
-set plugin2 = "${test_source_directory}/plugin2"
-set plugin3 = "${test_source_directory}/plugin3"
-set plugin4 = "${test_source_directory}/plugin4"
+subdirectories = "host plugin1 plugin2 plugin3 plugin4"
* shared-libraries
** setup-ocamlc.byte-build-env
-*** script
-script = "mkdir host plugin1 plugin2 plugin3 plugin4"
-*** script
-script = "cp ${host}/host.ml ${host}/api.mli ${host}/api.ml host"
-*** script
-script = "cp ${plugin1}/plugin.ml ${plugin1}/api.mli ${plugin1}/api.ml plugin1"
-*** script
-script = "cp ${plugin2}/plugin.ml ${plugin2}/api.mli ${plugin2}/api.ml plugin2"
-*** script
-script = "cp ${plugin3}/plugin.ml ${plugin3}/api.mli ${plugin3}/api.ml plugin3"
-*** script
-script = "cp ${plugin4}/plugin.ml ${plugin4}/api.mli ${plugin4}/api.ml plugin4"
-
*** cd
cwd = "plugin1"
*** ocamlc.byte
** native-dynlink
*** setup-ocamlopt.byte-build-env
-**** script
-script = "mkdir host plugin1 plugin2 plugin3 plugin4"
-**** script
-script = "cp ${host}/host.ml ${host}/api.mli ${host}/api.ml host"
-**** script
-script = "cp ${plugin1}/plugin.ml ${plugin1}/api.mli ${plugin1}/api.ml plugin1"
-**** script
-script = "cp ${plugin2}/plugin.ml ${plugin2}/api.mli ${plugin2}/api.ml plugin2"
-**** script
-script = "cp ${plugin3}/plugin.ml ${plugin3}/api.mli ${plugin3}/api.ml plugin3"
-**** script
-script = "cp ${plugin4}/plugin.ml ${plugin4}/api.mli ${plugin4}/api.ml plugin4"
-
**** cd
cwd = "plugin1"
**** ocamlopt.byte
include dynlink
libraries = ""
-files = "config.ml b.ml"
+readonly_files = "config.ml b.ml"
* shared-libraries
** setup-ocamlc.byte-build-env
(* TEST
include dynlink
-files = "lib.ml lib2.ml test.c"
+readonly_files = "lib.ml lib2.ml test.c"
ld_library_path += "${test_build_directory}"
* shared-libraries
include dynlink
libraries = ""
-files = "sheep.mli sheep.ml pig.mli"
-set plugin1 = "${test_source_directory}/plugin1"
-set plugin2 = "${test_source_directory}/plugin2"
-set plugin2b = "${test_source_directory}/plugin2b"
-set plugin2c = "${test_source_directory}/plugin2c"
-set plugin3 = "${test_source_directory}/plugin3"
-set plugin4 = "${test_source_directory}/plugin4"
-set plugin5 = "${test_source_directory}/plugin5"
-set plugin6 = "${test_source_directory}/plugin6"
+readonly_files = "sheep.mli sheep.ml pig.mli"
+subdirectories = "plugin1 plugin2 plugin2b plugin2c plugin3 plugin4 \
+ plugin5 plugin6"
* shared-libraries
** setup-ocamlc.byte-build-env
module = "pig.mli"
****** ocamlc.byte
module = "test.ml"
-*** script
-script = "mkdir plugin1 plugin2 plugin2b plugin2c plugin3 plugin4 plugin5 plugin6"
-**** script
-script = "cp ${plugin1}/sheep.mli ${plugin1}/sheep.ml plugin1"
-**** script
-script = "cp ${plugin2}/cow.mli ${plugin2}/cow.ml plugin2"
-**** script
-script = "cp ${plugin2b}/cow.mli ${plugin2b}/cow.ml plugin2b"
-**** script
-script = "cp ${plugin2c}/cow.mli ${plugin2c}/cow.ml plugin2c"
-**** script
-script = "cp ${plugin3}/pig.mli ${plugin3}/pig.ml plugin3"
-**** script
-script = "cp ${plugin4}/chicken.mli ${plugin4}/chicken.ml plugin4"
-**** script
-script = "cp ${plugin5}/chicken.mli ${plugin5}/chicken.ml plugin5"
-**** script
-script = "cp ${plugin6}/pheasant.mli ${plugin6}/pheasant.ml ${plugin6}/partridge.mli ${plugin6}/partridge.ml plugin6"
-***** ocamlc.byte
+******* ocamlc.byte
module = "plugin1/sheep.mli"
-***** ocamlc.byte
+******** ocamlc.byte
flags = "-I plugin1"
module = "plugin1/sheep.ml"
-***** ocamlc.byte
+********* ocamlc.byte
+flags = ""
module = "plugin2/cow.mli"
-***** ocamlc.byte
+********** ocamlc.byte
flags = "-I plugin2"
module = "plugin2/cow.ml"
-***** ocamlc.byte
+*********** ocamlc.byte
+flags = ""
module = "plugin2b/cow.mli"
-***** ocamlc.byte
+************ ocamlc.byte
flags = "-I plugin2b"
module = "plugin2b/cow.ml"
-***** ocamlc.byte
+************* ocamlc.byte
+flags = ""
module = "plugin2c/cow.mli"
-***** ocamlc.byte
+************** ocamlc.byte
flags = "-I plugin2c"
module = "plugin2c/cow.ml"
-***** ocamlc.byte
+*************** ocamlc.byte
+flags = ""
module = "plugin3/pig.mli"
-***** ocamlc.byte
+**************** ocamlc.byte
flags = "-I plugin3"
module = "plugin3/pig.ml"
-***** ocamlc.byte
+***************** ocamlc.byte
+flags = ""
module = "plugin4/chicken.mli"
-***** ocamlc.byte
+****************** ocamlc.byte
flags = "-I plugin4"
module = "plugin4/chicken.ml"
-***** ocamlc.byte
+******************* ocamlc.byte
+flags = ""
module = "plugin5/chicken.mli"
-***** ocamlc.byte
+******************** ocamlc.byte
flags = "-I plugin5"
module = "plugin5/chicken.ml"
-***** ocamlc.byte
+********************* ocamlc.byte
+flags = ""
module = "plugin6/pheasant.mli"
-***** ocamlc.byte
+********************** ocamlc.byte
flags = "-I plugin6"
module = "plugin6/pheasant.ml"
-***** ocamlc.byte
+*********************** ocamlc.byte
+flags = ""
module = "plugin6/partridge.mli"
-***** ocamlc.byte
+************************ ocamlc.byte
flags = "-I plugin6"
module = "plugin6/partridge.ml"
-***** ocamlc.byte
-program = "${test_build_directory}/test.byte"
+************************* ocamlc.byte
+flags = ""
+program = "./test.byte.exe"
libraries = "dynlink"
all_modules = "sheep.cmo test.cmo"
-****** run
+module = ""
+************************** run
** native-dynlink
*** setup-ocamlopt.byte-build-env
module = "pig.mli"
******* ocamlopt.byte
module = "test.ml"
-**** script
-script = "mkdir plugin1 plugin2 plugin2b plugin2c plugin3 plugin4 plugin5 plugin6"
-***** script
-script = "cp ${plugin1}/sheep.mli ${plugin1}/sheep.ml plugin1"
-***** script
-script = "cp ${plugin2}/cow.mli ${plugin2}/cow.ml plugin2"
-***** script
-script = "cp ${plugin2b}/cow.mli ${plugin2b}/cow.ml plugin2b"
-***** script
-script = "cp ${plugin2c}/cow.mli ${plugin2c}/cow.ml plugin2c"
-***** script
-script = "cp ${plugin3}/pig.mli ${plugin3}/pig.ml plugin3"
-***** script
-script = "cp ${plugin4}/chicken.mli ${plugin4}/chicken.ml plugin4"
-***** script
-script = "cp ${plugin5}/chicken.mli ${plugin5}/chicken.ml plugin5"
-***** script
-script = "cp ${plugin6}/pheasant.mli ${plugin6}/pheasant.ml ${plugin6}/partridge.mli ${plugin6}/partridge.ml plugin6"
-****** ocamlopt.byte
+******** ocamlopt.byte
+flags = ""
module = "plugin1/sheep.mli"
-****** ocamlopt.byte
+********* ocamlopt.byte
program = "plugin1/sheep.cmxs"
flags = "-I plugin1 -shared"
+module = ""
all_modules = "plugin1/sheep.ml"
-****** ocamlopt.byte
+********** ocamlopt.byte
+flags = ""
module = "plugin2/cow.mli"
-****** ocamlopt.byte
+*********** ocamlopt.byte
program = "plugin2/cow.cmxs"
flags = "-I plugin2 -shared"
+module = ""
all_modules = "plugin2/cow.ml"
-****** ocamlopt.byte
+************ ocamlopt.byte
+flags = ""
module = "plugin2b/cow.mli"
-****** ocamlopt.byte
+************* ocamlopt.byte
program = "plugin2b/cow.cmxs"
flags = "-I plugin2b -shared"
+module = ""
all_modules = "plugin2b/cow.ml"
-****** ocamlopt.byte
+************** ocamlopt.byte
+flags = ""
module = "plugin2c/cow.mli"
-****** ocamlopt.byte
+*************** ocamlopt.byte
program = "plugin2c/cow.cmxs"
flags = "-I plugin2c -shared"
+module = ""
all_modules = "plugin2c/cow.ml"
-****** ocamlopt.byte
+**************** ocamlopt.byte
+flags = ""
module = "plugin3/pig.mli"
-****** ocamlopt.byte
+***************** ocamlopt.byte
program = "plugin3/pig.cmxs"
flags = "-I plugin3 -shared"
+module = ""
all_modules = "plugin3/pig.ml"
-****** ocamlopt.byte
+****************** ocamlopt.byte
+flags = ""
module = "plugin4/chicken.mli"
-****** ocamlopt.byte
+******************* ocamlopt.byte
program = "plugin4/chicken.cmxs"
flags = "-I plugin4 -shared"
+module = ""
all_modules = "plugin4/chicken.ml"
-****** ocamlopt.byte
+******************** ocamlopt.byte
+flags = ""
module = "plugin5/chicken.mli"
-****** ocamlopt.byte
+********************* ocamlopt.byte
program = "plugin5/chicken.cmxs"
flags = "-I plugin5 -shared"
+module = ""
all_modules = "plugin5/chicken.ml"
-****** ocamlopt.byte
+********************** ocamlopt.byte
+flags = ""
module = "plugin6/pheasant.mli"
-****** ocamlopt.byte
+*********************** ocamlopt.byte
program = "plugin6/pheasant.cmxs"
flags = "-I plugin6 -shared"
+module = ""
all_modules = "plugin6/pheasant.ml"
-****** ocamlopt.byte
+************************ ocamlopt.byte
+flags = ""
module = "plugin6/partridge.mli"
-****** ocamlopt.byte
+************************* ocamlopt.byte
program = "plugin6/partridge.cmxs"
flags = "-I plugin6 -shared"
+module = ""
all_modules = "plugin6/partridge.ml"
-****** ocamlopt.byte
-program = "${test_build_directory}/test.exe"
+************************** ocamlopt.byte
+flags = ""
+program = "./test.opt.exe"
libraries = "dynlink"
all_modules = "sheep.cmx test.cmx"
-******* run
+*************************** run
*)
let () = Sheep.baa Sheep.s (* Use Sheep module *)
- : (unit, int) Either.t list = [Left (); Right 3]
|}];;
-[map succ not (Left 1); map succ not (Right true)];;
+[map ~left:succ ~right:not (Left 1);
+ map ~left:succ ~right:not (Right true)];;
[%%expect {|
- : (int, bool) Either.t list = [Left 2; Right false]
|}];;
(* TEST
-files = "myecho.ml"
+readonly_files = "myecho.ml"
* setup-ocamlc.byte-build-env
program = "${test_build_directory}/quotecommand.byte"
(* TEST
*)
+let is_nan2 (x, y) = Float.is_nan x && Float.is_nan y
+
+type test = True of (unit -> bool)
+ | False of (unit -> bool)
+ | Equal of ((unit -> float) * float)
+ | Pair of ((unit -> float * float) * (float * float))
+
+let cases = [
+ ( 1, True (fun () -> Float.is_finite 1.));
+ ( 2, True (fun () -> Float.is_finite Float.pi));
+ ( 3, False(fun () -> Float.is_finite Float.infinity));
+ ( 4, False(fun () -> Float.is_finite Float.nan));
+ ( 5, True (fun () -> Float.is_infinite Float.infinity));
+ ( 6, False(fun () -> Float.is_infinite 1.));
+ ( 7, False(fun () -> Float.is_infinite Float.nan));
+ ( 8, True (fun () -> Float.is_nan Float.nan));
+ ( 9, False(fun () -> Float.is_nan 1.));
+ (10, False(fun () -> Float.is_nan neg_infinity));
+ (11, True (fun () -> Float.is_integer 1.));
+ (12, True (fun () -> Float.is_integer (-1e10)));
+ (13, False(fun () -> Float.is_integer 1.5));
+ (14, False(fun () -> Float.is_integer Float.infinity));
+ (15, False(fun () -> Float.is_integer Float.nan));
+
+ (16, Equal((fun () -> Float.trunc 1.5), 1.));
+ (17, Equal((fun () -> Float.trunc (-1.5)), -1.));
+ (18, Equal(Float.((fun () -> trunc infinity), infinity)));
+ (19, Equal(Float.(((fun () -> trunc neg_infinity), neg_infinity))));
+ (20, True (fun () -> Float.(is_nan(trunc nan))));
+
+ (21, Equal((fun () -> Float.round 0.5), 1.));
+ (22, Equal((fun () -> Float.round (-0.5)), -1.));
+ (23, Equal((fun () -> Float.round 1.5), 2.));
+ (24, Equal((fun () -> Float.round (-1.5)), -2.));
+ (25, let x = 0x1.0000000000001p52 in (* x + 0.5 rounds to x +. 1. *)
+ Equal((fun () -> Float.round x), x));
+ (26, Equal((fun () -> Float.round (Float.next_after 0.5 0.)), 0.));
+
+ (27, Equal(Float.((fun () -> round infinity), infinity)));
+ (28, Equal(Float.((fun () -> round neg_infinity), neg_infinity)));
+ (29, True (fun () -> Float.(is_nan(round nan))));
+
+ (30, Equal((fun () -> Float.next_after 0x1.FFFFFFFFFFFFFp-2 1.), 0.5));
+ (31, Equal((fun () -> Float.next_after 0x1.FFFFFFFFFFFFFp-2 0.), 0x1.FFFFFFFFFFFFEp-2));
+ (32, Equal(Float.((fun () -> next_after 0x1.FFFFFFFFFFFFFp-2 infinity), 0.5)));
+ (33, Equal(Float.((fun () -> next_after 0x1.FFFFFFFFFFFFFp-2 neg_infinity), 0x1.FFFFFFFFFFFFEp-2)));
+ (34, Equal((fun () -> Float.next_after 1. 1.), 1.));
+ (35, True (fun () -> Float.(is_nan(next_after nan 1.))));
+ (36, True (fun () -> Float.(is_nan(next_after 3. nan))));
+
+ (37, Equal(Float.((fun () -> succ 0x1.FFFFFFFFFFFFFp-2), 0.5)));
+ (38, Equal(Float.((fun () -> pred 0.5), 0x1.FFFFFFFFFFFFFp-2)));
+ (39, True (Float.(fun () -> succ 0. > 0.)));
+ (40, True (Float.(fun () -> pred 0. < 0.)));
+ (41, Equal(Float.((fun () -> succ max_float), infinity)));
+ (42, Equal(Float.((fun () -> pred (-. max_float)), neg_infinity)));
+ (43, True (Float.(fun () -> succ 0. < min_float)));
+ (44, Equal(Float.((fun () -> succ infinity), infinity)));
+ (45, Equal(Float.((fun () -> pred neg_infinity), neg_infinity)));
+ (46, True (Float.(fun () -> is_nan(succ nan))));
+ (47, True (Float.(fun () -> is_nan(pred nan))));
+
+ (48, False(fun () -> Float.sign_bit 1.));
+ (49, True (fun () -> Float.sign_bit (-1.)));
+ (50, False(fun () -> Float.sign_bit 0.));
+ (51, True (fun () -> Float.sign_bit (-0.)));
+ (52, False(fun () -> Float.sign_bit infinity));
+ (53, True (fun () -> Float.sign_bit neg_infinity));
+
+ (54, Equal((fun () -> Float.min 1. 2.), 1.));
+ (55, Equal((fun () -> Float.min 2. 1.), 1.));
+ (56, True (fun () -> Float.(is_nan(min 1. nan))));
+ (57, True (fun () -> Float.(is_nan(min nan 2.))));
+ (58, True (fun () -> Float.(is_nan(min nan nan))));
+ (59, Equal((fun () -> 1. /. Float.min (-0.) (+0.)), neg_infinity));
+ (60, Equal((fun () -> 1. /. Float.min (+0.) (-0.)), neg_infinity));
+
+ (61, Equal((fun () -> Float.max 1. 2.), 2.));
+ (62, Equal((fun () -> Float.max 2. 1.), 2.));
+ (63, True (fun () -> Float.(is_nan(max 1. nan))));
+ (64, True (fun () -> Float.(is_nan(max nan 2.))));
+ (65, True (fun () -> Float.(is_nan(max nan nan))));
+ (66, Equal((fun () -> 1. /. Float.max (-0.) (+0.)), infinity));
+ (67, Equal((fun () -> 1. /. Float.max (+0.) (-0.)), infinity));
+
+ (68, Pair ((fun () -> Float.min_max 1. 2.), (1., 2.)));
+ (69, Pair ((fun () -> Float.min_max 2. 1.), (1., 2.)));
+ (70, True (fun () -> Float.(is_nan2(min_max 1. nan))));
+ (71, True (fun () -> Float.(is_nan2(min_max nan 2.))));
+ (72, True (fun () -> Float.(is_nan2(min_max nan nan))));
+ (73, Pair ((fun () -> let x, y = Float.min_max (-0.) (+0.) in
+ (1. /. x, 1. /. y)), (neg_infinity, infinity)));
+ (74, Pair ((fun () -> let x, y = Float.min_max (+0.) (-0.) in
+ (1. /. x, 1. /. y)), (neg_infinity, infinity)));
+
+ (75, Equal((fun () -> Float.min_num 1. 2.), 1.));
+ (76, Equal(Float.((fun () -> min_num 1. nan), 1.)));
+ (77, Equal(Float.((fun () -> min_num nan 2.), 2.)));
+ (78, True (fun () -> Float.(is_nan(min_num nan nan))));
+ (79, Equal((fun () -> 1. /. Float.min_num (-0.) (+0.)), neg_infinity));
+ (80, Equal((fun () -> 1. /. Float.min_num (+0.) (-0.)), neg_infinity));
+
+ (81, Equal((fun () -> Float.max_num 1. 2.), 2.));
+ (82, Equal(Float.((fun () -> max_num 1. nan), 1.)));
+ (83, Equal(Float.((fun () -> max_num nan 2.), 2.)));
+ (84, True (fun () -> Float.(is_nan(max_num nan nan))));
+ (85, Equal((fun () -> 1. /. Float.max_num (-0.) (+0.)), infinity));
+ (86, Equal((fun () -> 1. /. Float.max_num (+0.) (-0.)), infinity));
+
+ (87, Pair ((fun () -> Float.min_max_num 1. 2.), (1., 2.)));
+ (88, Pair ((fun () -> Float.min_max_num 2. 1.), (1., 2.)));
+ (89, Pair ((fun () -> Float.min_max_num 1. nan), (1., 1.)));
+ (90, Pair ((fun () -> Float.min_max_num nan 1.), (1., 1.)));
+ (91, True (fun () -> Float.(is_nan2(min_max_num nan nan))));
+ (92, Pair ((fun () -> let x, y = Float.min_max_num (-0.) (+0.) in
+ (1. /. x, 1. /. y)), (neg_infinity, infinity)));
+ (93, Pair ((fun () -> let x, y = Float.min_max_num (+0.) (-0.) in
+ (1. /. x, 1. /. y)), (neg_infinity, infinity)));
+]
+
let () =
- assert(Float.is_finite 1.);
- assert(Float.is_finite Float.pi);
- assert(not(Float.is_finite Float.infinity));
- assert(not(Float.is_finite Float.nan));
- assert(Float.is_infinite Float.infinity);
- assert(not(Float.is_infinite 1.));
- assert(not(Float.is_infinite Float.nan));
- assert(Float.is_nan Float.nan);
- assert(not(Float.is_nan 1.));
- assert(not(Float.is_nan neg_infinity));
- assert(Float.is_integer 1.);
- assert(Float.is_integer (-1e10));
- assert(not(Float.is_integer 1.5));
- assert(not(Float.is_integer Float.infinity));
- assert(not(Float.is_integer Float.nan));
-
- assert(Float.trunc 1.5 = 1.);
- assert(Float.trunc (-1.5) = -1.);
- assert(Float.(trunc infinity = infinity));
- assert(Float.(trunc neg_infinity = neg_infinity));
- assert(Float.(is_nan(trunc nan)));
-
- assert(Float.round 0.5 = 1.);
- assert(Float.round (-0.5) = -1.);
- assert(Float.round 1.5 = 2.);
- assert(Float.round (-1.5) = -2.);
- assert(let x = 0x1.0000000000001p52 in (* x + 0.5 rounds to x +. 1. *)
- Float.round x = x);
- assert(Float.round (Float.next_after 0.5 0.) = 0.);
-
- assert(Float.(round infinity = infinity));
- assert(Float.(round neg_infinity = neg_infinity));
- assert(Float.(is_nan(round nan)));
-
- assert(Float.next_after 0x1.FFFFFFFFFFFFFp-2 1. = 0.5);
- assert(Float.next_after 0x1.FFFFFFFFFFFFFp-2 0. = 0x1.FFFFFFFFFFFFEp-2);
- assert(Float.(next_after 0x1.FFFFFFFFFFFFFp-2 infinity = 0.5));
- assert(Float.(next_after 0x1.FFFFFFFFFFFFFp-2 neg_infinity
- = 0x1.FFFFFFFFFFFFEp-2));
- assert(Float.next_after 1. 1. = 1.);
- assert(Float.(is_nan(next_after nan 1.)));
- assert(Float.(is_nan(next_after 3. nan)));
-
- assert(Float.(succ 0x1.FFFFFFFFFFFFFp-2 = 0.5));
- assert(Float.(pred 0.5 = 0x1.FFFFFFFFFFFFFp-2));
- assert(Float.(succ 0. > 0.));
- assert(Float.(pred 0. < 0.));
- assert(Float.(succ max_float = infinity));
- assert(Float.(pred (-. max_float) = neg_infinity));
- assert(Float.(succ 0. < min_float));
- assert(Float.(succ infinity = infinity));
- assert(Float.(pred neg_infinity = neg_infinity));
- assert(Float.(is_nan(succ nan)));
- assert(Float.(is_nan(pred nan)));
-
- assert(not(Float.sign_bit 1.));
- assert(Float.sign_bit (-1.));
- assert(not(Float.sign_bit 0.));
- assert(Float.sign_bit (-0.));
- assert(not(Float.sign_bit infinity));
- assert(Float.sign_bit neg_infinity);
-
- assert(Float.min 1. 2. = 1.);
- assert(Float.min 2. 1. = 1.);
- assert(Float.(is_nan(min 1. nan)));
- assert(Float.(is_nan(min nan 2.)));
- assert(Float.(is_nan(min nan nan)));
- assert(1. /. Float.min (-0.) (+0.) = neg_infinity);
- assert(1. /. Float.min (+0.) (-0.) = neg_infinity);
-
- assert(Float.max 1. 2. = 2.);
- assert(Float.max 2. 1. = 2.);
- assert(Float.(is_nan(max 1. nan)));
- assert(Float.(is_nan(max nan 2.)));
- assert(Float.(is_nan(max nan nan)));
- assert(1. /. Float.max (-0.) (+0.) = infinity);
- assert(1. /. Float.max (+0.) (-0.) = infinity);
-
- assert(Float.min_max 1. 2. = (1., 2.));
- assert(Float.min_max 2. 1. = (1., 2.));
- let is_nan2 (x, y) = Float.is_nan x && Float.is_nan y in
- assert(Float.(is_nan2(min_max 1. nan)));
- assert(Float.(is_nan2(min_max nan 2.)));
- assert(Float.(is_nan2(min_max nan nan)));
- assert(let x, y = Float.min_max (-0.) (+0.) in
- 1. /. x = neg_infinity && 1. /. y = infinity);
- assert(let x, y = Float.min_max (+0.) (-0.) in
- 1. /. x = neg_infinity && 1. /. y = infinity);
-
- assert(Float.min_num 1. 2. = 1.);
- assert(Float.(min_num 1. nan = 1.));
- assert(Float.(min_num nan 2. = 2.));
- assert(Float.(is_nan(min_num nan nan)));
- assert(1. /. Float.min_num (-0.) (+0.) = neg_infinity);
- assert(1. /. Float.min_num (+0.) (-0.) = neg_infinity);
-
- assert(Float.max_num 1. 2. = 2.);
- assert(Float.(max_num 1. nan = 1.));
- assert(Float.(max_num nan 2. = 2.));
- assert(Float.(is_nan(max_num nan nan)));
- assert(1. /. Float.max_num (-0.) (+0.) = infinity);
- assert(1. /. Float.max_num (+0.) (-0.) = infinity);
-
- assert(Float.min_max_num 1. 2. = (1., 2.));
- assert(Float.min_max_num 2. 1. = (1., 2.));
- assert(Float.min_max_num 1. nan = (1., 1.));
- assert(Float.min_max_num nan 1. = (1., 1.));
- assert(Float.(is_nan2(min_max_num nan nan)));
- assert(let x, y = Float.min_max_num (-0.) (+0.) in
- 1. /. x = neg_infinity && 1. /. y = infinity);
- assert(let x, y = Float.min_max_num (+0.) (-0.) in
- 1. /. x = neg_infinity && 1. /. y = infinity);
-;;
-
-let () = print_endline "OK"
+ let f (n, test) =
+ match test with
+ | True p ->
+ Printf.printf "%03d: %s\n%!" n (if p () then "OK" else "FAIL")
+ | False p ->
+ Printf.printf "%03d: %s\n%!" n (if p () then "FAIL" else "OK")
+ | Equal (f, result) ->
+ let v = f () in
+ if v = result then
+ Printf.printf "%03d: OK\n%!" n
+ else
+ Printf.printf "%03d: FAIL (%h returned instead of %h)\n%!" n v result
+ | Pair (f, ((l', r') as result)) ->
+ let (l, r) as v = f () in
+ if v = result then
+ Printf.printf "%03d: OK\n%!" n
+ else
+ Printf.printf "%03d: FAIL ((%h, %h) returned instead of (%h, %h))\n%!" n l r l' r'
+ in
+ List.iter f cases
-OK
+001: OK
+002: OK
+003: OK
+004: OK
+005: OK
+006: OK
+007: OK
+008: OK
+009: OK
+010: OK
+011: OK
+012: OK
+013: OK
+014: OK
+015: OK
+016: OK
+017: OK
+018: OK
+019: OK
+020: OK
+021: OK
+022: OK
+023: OK
+024: OK
+025: OK
+026: OK
+027: OK
+028: OK
+029: OK
+030: OK
+031: OK
+032: OK
+033: OK
+034: OK
+035: OK
+036: OK
+037: OK
+038: OK
+039: OK
+040: OK
+041: OK
+042: OK
+043: OK
+044: OK
+045: OK
+046: OK
+047: OK
+048: OK
+049: OK
+050: OK
+051: OK
+052: OK
+053: OK
+054: OK
+055: OK
+056: OK
+057: OK
+058: OK
+059: OK
+060: OK
+061: OK
+062: OK
+063: OK
+064: OK
+065: OK
+066: OK
+067: OK
+068: OK
+069: OK
+070: OK
+071: OK
+072: OK
+073: OK
+074: OK
+075: OK
+076: OK
+077: OK
+078: OK
+079: OK
+080: OK
+081: OK
+082: OK
+083: OK
+084: OK
+085: OK
+086: OK
+087: OK
+088: OK
+089: OK
+090: OK
+091: OK
+092: OK
+093: OK
assert (Int.of_string "" = None); *)
()
+let test_min_max () =
+ assert (Int.max 2 3 = 3);
+ assert (Int.min 2 3 = 2)
+
+
let tests () =
test_consts ();
test_arith ();
test_compare ();
test_float_conv ();
test_string_conv ();
+ test_min_max ();
()
let () =
assert (Int64.of_string "" = None); *)
()
+let test_min_max () =
+ assert (Int64.max 2L 3L = 3L);
+ assert (Int64.min 2L 3L = 2L)
+
let tests () =
test_consts ();
test_arith ();
test_compare ();
test_float_conv ();
test_string_conv ();
+ test_min_max ();
()
let () =
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(* expect-tests currently do not collect I/O,
+ so we emulate I/O by collecting output in a "log" *)
+let logger () =
+ let log = ref [] in
+ let show_log v = List.rev !log, v in
+ let log v = log := v :: !log in
+ log, show_log
+[%%expect{|
+val logger : unit -> ('a -> unit) * ('b -> 'a list * 'b) = <fun>
+|}]
+
+let _ =
+ let log, show_log = logger () in
+ let x = lazy (log "x"; 41) in
+ let y =
+ log "map";
+ Lazy.map (fun n -> log "y"; n+1) x in
+ log "force y";
+ show_log (Lazy.force y)
+;;
+[%%expect{|
+- : string list * int = (["map"; "force y"; "x"; "y"], 42)
+|}]
+
+let _ =
+ let log, show_log = logger () in
+ let x = lazy (log "x"; 41) in
+ let y =
+ log "map_val";
+ Lazy.map_val (fun n -> log "y"; n+1) x in
+ assert (not (Lazy.is_val y));
+ log "force y";
+ show_log (Lazy.force y)
+;;
+[%%expect{|
+- : string list * int = (["map_val"; "force y"; "x"; "y"], 42)
+|}]
+
+let _ =
+ let log, show_log = logger () in
+ let x = lazy (log "x"; 41) in
+ log "force x";
+ let () = ignore (Lazy.force x) in
+ let y =
+ log "map_val";
+ Lazy.map_val (fun n -> log "y"; n+1) x in
+ assert (Lazy.is_val y);
+ log "y is val";
+ show_log (Lazy.force y)
+;;
+[%%expect{|
+- : string list * int = (["force x"; "x"; "map_val"; "y"; "y is val"], 42)
+|}]
--- /dev/null
+(* TEST
+*)
+
+(* A basic chi-square test to detect simple errors in the Random module. *)
+
+(* Accumulate [n] samples from function [f] and check the chi-square.
+ Only the low 8 bits of the result of [f] are sampled. *)
+
+let chisquare n f =
+ let r = 256 in
+ let freq = Array.make r 0 in
+ for i = 0 to n - 1 do
+ let t = f () land 0xFF in
+ freq.(t) <- freq.(t) + 1
+ done;
+ let expected = float n /. float r in
+ let t =
+ Array.fold_left
+ (fun s x -> let d = float x -. expected in d *. d +. s)
+ 0.0 freq in
+ let chi2 = t /. expected in
+ let degfree = float r -. 1.0 in
+ (* The degree of freedom is high, so we approximate as a normal
+ distribution with mean equal to degfree and variance 2 * degfree.
+ Four sigmas correspond to a 99.9968% confidence interval.
+ (Without the approximation, the confidence interval seems to be 99.986%.)
+ *)
+ chi2 <= degfree +. 4.0 *. sqrt (2.0 *. degfree)
+
+let test name f =
+ if not (chisquare 100_000 f)
+ then Printf.printf "%s: suspicious result\n%!" name
+
+let _ =
+ test "Random.bits (bits 0-7)"
+ Random.bits;
+ test "Random.bits (bits 12-19)"
+ (fun () -> Random.bits() lsr 12);
+ test "Random.bits (bits 22-29)"
+ (fun () -> Random.bits() lsr 22);
+ test "Random.int 2^26 (bits 0-7)"
+ (fun () -> Random.int (1 lsl 26));
+ test "Random.int 2^26 (bits 18-25)"
+ (fun () -> Random.int (1 lsl 26) lsr 18);
+ test "Random.int (256 * p) / p"
+ (fun () -> Random.int (256 * 853187) / 853187);
+ test "Random.float 1.0 (first 8 bits)"
+ (fun () -> int_of_float (Random.float 1.0 *. 256.0));
+ test "Random.float 1.0 (next 8 bits)"
+ (fun () -> int_of_float (Random.float 1.0 *. 65536.0));
+ test "Random.int32 2^30 (bits 0-7)"
+ (fun () -> Int32.to_int (Random.int32 0x40000000l));
+ test "Random.int32 2^30 (bits 20-27)"
+ (fun () -> Int32.(to_int (shift_right (Random.int32 0x40000000l) 20)));
+ test "Random.int32 (256 * p) / p"
+ (let p = 7048673l in
+ fun () -> Int32.(to_int (div (Random.int32 (mul 256l p)) p)));
+ test "Random.int64 2^60 (bits 0-7)"
+ (fun () -> Int64.to_int (Random.int64 0x1000000000000000L));
+ test "Random.int64 2^60 (bits 30-37)"
+ (fun () -> Int64.(to_int (shift_right (Random.int64 0x1000000000000000L)
+ 30)));
+ test "Random.int64 2^60 (bits 52-59)"
+ (fun () -> Int64.(to_int (shift_right (Random.int64 0x1000000000000000L)
+ 52)));
+ test "Random.int64 (256 * p) / p"
+ (let p = 16430454264262693L in
+ fun () -> Int64.(to_int (div (Random.int64 (mul 256L p)) p)));
+ if Sys.int_size >= 32 then begin
+ test "Random.full_int 2^30 (bits 0-7)"
+ (fun () -> Random.full_int (1 lsl 30));
+ test "Random.full_int 2^30 (bits 22-29)"
+ (fun () -> Random.full_int (1 lsl 30) lsr 22);
+ test "Random.full_int (256 * p) / p"
+ (let p = 7992689 in
+ fun () -> Random.full_int (256 * p) / p)
+ end;
+ if Sys.int_size >= 63 then begin
+ test "Random.full_int 2^60 (bits 0-7)"
+ (fun () -> Random.full_int (1 lsl 60));
+ test "Random.full_int 2^60 (bits 30-37)"
+ (fun () -> Random.full_int (1 lsl 60) lsr 30);
+ test "Random.full_int 2^60 (bits 52-59)"
+ (fun () -> Random.full_int (1 lsl 60) lsr 52);
+ test "Random.full_int (256 * P) / P"
+ (let p = Int64.to_int 17766642568158577L in
+ fun () -> Random.full_int (256 * p) / p)
+ end
--- /dev/null
+(* TEST *)
+
+(* Ensure that a bound which is negative on 31-bit OCaml but positive on 32-bit
+ OCaml produces the same result on 64-bit OCaml. *)
+let bound = 0x6FFFFFFF in
+if bound < 0 then (* 31-bit integers *)
+ print_endline "6beb775a"
+else (* 32 or 64-bit integers *)
+ let s = Random.State.make [| 42 |] in
+ Printf.printf "%x\n" (Random.State.full_int s bound)
modules = "tscanf2_io.ml"
* hasunix
include unix
-files = "tscanf2_worker.ml"
+readonly_files = "tscanf2_worker.ml"
reference = "${test_source_directory}/tscanf2.reference"
(* The bytcode test *)
()
;;
+(* concat *)
+let () =
+ assert (
+ List.concat [[1]; []; [2; 3];]
+ = (let (!?) = List.to_seq in
+ List.of_seq (Seq.concat !?[!?[1]; !?[]; !?[2; 3]])))
+
let () = print_endline "OK";;
(* TEST
- files = "mpr7769.txt"
+ readonly_files = "mpr7769.txt"
*)
let () =
--- /dev/null
+(* TEST
+*)
+
+let err x =
+ match Lazy.force x with
+ | exception Invalid_argument _ -> ()
+ | _ -> assert false
+
+let () =
+ let b = "\003\002\001\004\255" in
+ lazy (String.get_int8 b 5) |> err;
+ lazy (String.get_uint8 b 5) |> err;
+ assert(String.get_int8 b 0 = 3);
+ assert(String.get_int8 b 1 = 2);
+ assert(String.get_int8 b 2 = 1);
+ assert(String.get_int8 b 3 = 4);
+ assert(String.get_int8 b 4 = -1);
+ assert(String.get_uint8 b 0 = 3);
+ assert(String.get_uint8 b 1 = 2);
+ assert(String.get_uint8 b 2 = 1);
+ assert(String.get_uint8 b 3 = 4);
+ assert(String.get_uint8 b 4 = 255);
+ for i = 0 to 255 do
+ let s = Bytes.(let b = create 1 in set_uint8 b 0 i; unsafe_to_string b) in
+ assert (String.get_uint8 s 0 = i);
+ done;
+ for i = -128 to 127 do
+ let s = Bytes.(let b = create 1 in set_int8 b 0 i; unsafe_to_string b) in
+ assert (String.get_int8 s 0 = i);
+ done
+
+let () =
+ let b = "\xcd\xab\x12" in
+ assert(String.get_uint16_le b 0 = 0xabcd);
+ assert(String.get_uint16_le b 1 = 0x12ab);
+ assert(String.get_int16_le b 0 = 0xabcd - 0x10000);
+ assert(String.get_int16_le b 1 = 0x12ab);
+ assert(String.get_uint16_be b 1 = 0xab12);
+ assert(String.get_int16_be b 1 = 0xab12 - 0x10000);
+ for i = 0 to String.length b - 2 do
+ let x = String.get_int16_ne b i in
+ let f = if Sys.big_endian then String.get_int16_be else String.get_int16_le in
+ assert (x = f b i);
+
+ let x = String.get_uint16_ne b i in
+ let f = if Sys.big_endian then String.get_uint16_be else String.get_uint16_le in
+ assert (x = f b i)
+ done;
+ lazy (String.get_int16_le b 2) |> err;
+ lazy (String.get_int16_ne b 2) |> err;
+ lazy (String.get_int16_be b 2) |> err;
+ lazy (String.get_uint16_le b 2) |> err;
+ lazy (String.get_uint16_ne b 2) |> err;
+ lazy (String.get_uint16_be b 2) |> err;
+ for i = 0 to 0xffff do
+ let s = Bytes.(let b = create 3 in set_uint16_le b 0 i; unsafe_to_string b) in
+ assert (String.get_uint16_le s 0 = i);
+ let s = Bytes.(let b = create 3 in set_uint16_be b 0 i; unsafe_to_string b) in
+ assert (String.get_uint16_be s 0 = i);
+ let s = Bytes.(let b = create 3 in set_uint16_ne b 0 i; unsafe_to_string b) in
+ assert (String.get_uint16_ne s 0 = i);
+ assert (
+ (if Sys.big_endian then String.get_uint16_be else String.get_uint16_le)
+ s 0 = i);
+ done;
+ for i = -0x8000 to 0x7fff do
+ let s = Bytes.(let b = create 3 in set_int16_le b 0 i; unsafe_to_string b) in
+ assert (String.get_int16_le s 0 = i);
+ let s = Bytes.(let b = create 3 in set_int16_be b 0 i; unsafe_to_string b) in
+ assert (String.get_int16_be s 0 = i);
+ let s = Bytes.(let b = create 3 in set_int16_ne b 0 i; unsafe_to_string b) in
+ assert (String.get_int16_ne s 0 = i);
+ assert (
+ (if Sys.big_endian then String.get_int16_be else String.get_int16_le)
+ s 0 = i);
+ done
+
+let () =
+ let b = "\xef\xcd\xab\x89\x01\x00" in
+ assert (String.get_int32_le b 0 = 0x89abcdefl);
+ assert (String.get_int32_be b 0 = 0xefcdab89l);
+ assert (String.get_int32_le b 1 = 0x0189abcdl);
+ assert (String.get_int32_be b 1 = 0xcdab8901l);
+
+ for i = 0 to String.length b - 4 do
+ let x = String.get_int32_ne b i in
+ let f =
+ if Sys.big_endian then String.get_int32_be else String.get_int32_le
+ in
+ assert (x = f b i);
+ done;
+ lazy (String.get_int32_le b 3) |> err;
+ lazy (String.get_int32_ne b 3) |> err;
+ lazy (String.get_int32_be b 3) |> err;
+ ()
+
+
+let () =
+ let b = "\xfe\xdc\xba\x98\x76\x54\x32\x10\x01\x00" in
+ assert (String.get_int64_le b 0 = 0x1032547698badcfeL);
+ assert (String.get_int64_be b 0 = 0xfedcba9876543210L);
+ assert (String.get_int64_le b 1 = 0x011032547698badcL);
+ assert (String.get_int64_be b 1 = 0xdcba987654321001L);
+
+ for i = 0 to String.length b - 8 do
+ let x = String.get_int64_ne b i in
+ let f =
+ if Sys.big_endian then String.get_int64_be else String.get_int64_le
+ in
+ assert (x = f b i);
+ done;
+
+ lazy (String.get_int64_le b 3) |> err;
+ lazy (String.get_int64_ne b 3) |> err;
+ lazy (String.get_int64_be b 3) |> err;
+ ()
while !sz <= 0 do push big l; sz += Sys.max_string_length done;
try ignore (String.concat "" !l); assert false
with Invalid_argument _ -> ();
+ assert(String.starts_with ~prefix:"foob" "foobarbaz");
+ assert(String.starts_with ~prefix:"" "foobarbaz");
+ assert(String.starts_with ~prefix:"" "");
+ assert(not (String.starts_with ~prefix:"foobar" "bar"));
+ assert(not (String.starts_with ~prefix:"foo" ""));
+ assert(not (String.starts_with ~prefix:"fool" "foobar"));
+ assert(String.ends_with ~suffix:"baz" "foobarbaz");
+ assert(String.ends_with ~suffix:"" "foobarbaz");
+ assert(String.ends_with ~suffix:"" "");
+ assert(not (String.ends_with ~suffix:"foobar" "bar"));
+ assert(not (String.ends_with ~suffix:"foo" ""));
+ assert(not (String.ends_with ~suffix:"obaz" "foobar"));
end
--- /dev/null
+(* TEST *)
+
+let[@inline never] float_unboxing s f =
+ let x = Sys.opaque_identity (s +. 1.) in
+ let mw1 = Gc.minor_words () in
+ let mw2 = Gc.minor_words () in
+ f x;
+ let mw3 = Gc.minor_words () in
+ Printf.printf "unbox: %.0f\n" ((mw3 -. mw2) -. (mw2 -. mw1))
+
+let[@inline never] lifetimes () =
+ let final = ref false in
+ let go () =
+ let r = ref 42 in
+ Gc.finalise (fun _ -> final := true) r;
+ let f1 = !final in
+ Gc.full_major ();
+ let f2 = !final in
+ ignore (Sys.opaque_identity r);
+ (f1, f2) in
+ let (f1, f2) = go () in
+ Gc.full_major ();
+ let f3 = !final in
+ Printf.printf "lifetime: %b %b %b\n" f1 f2 f3
+
+let[@inline never] dead_alloc a =
+ let mw1 = Gc.minor_words () in
+ let mw2 = Gc.minor_words () in
+ ignore (Sys.opaque_identity (a, a));
+ let mw3 = Gc.minor_words () in
+ Printf.printf "dead: %.0f\n" ((mw3 -. mw2) -. (mw2 -. mw1))
+
+
+let () =
+ float_unboxing 50. (fun _ -> ());
+ lifetimes ();
+ dead_alloc 10
--- /dev/null
+unbox: 0
+lifetime: false false true
+dead: 3
* hassysthreads
include systhreads
-files = "sigint.c"
+readonly_files = "sigint.c"
** libunix (* excludes mingw32/64 and msvc32/64 *)
--- /dev/null
+(* TEST
+
+* hassysthreads
+include systhreads
+** bytecode
+** native
+
+*)
+
+let _ =
+ try Unix.utimes "does-not-exist" 0.0 0.0
+ with Unix.(Unix_error(ENOENT, _, _)) -> ()
* hassysthreads
include systhreads
-files = "sigint.c"
+readonly_files = "sigint.c"
** libunix (* excludes mingw32/64 and msvc32/64 *)
* hasunix
include unix
-files = "fdstatus_aux.c fdstatus_main.ml"
+readonly_files = "fdstatus_aux.c fdstatus_main.ml"
** libunix
*** setup-ocamlc.byte-build-env
(* TEST
-files = "reflector.ml"
+readonly_files = "reflector.ml"
* hasunix
** setup-ocamlc.byte-build-env
(* TEST
-files = "cmdline_prog.ml"
+readonly_files = "cmdline_prog.ml"
* hasunix
** setup-ocamlc.byte-build-env
(* TEST
* hasunix
include unix
-files = "utimes.txt"
+readonly_files = "utimes.txt"
** bytecode
** native
*)
(* TEST
-files = "reflector.ml"
+readonly_files = "reflector.ml"
* hasunix
** setup-ocamlc.byte-build-env
--- /dev/null
+(* TEST
+* hasunix
+include unix
+** bytecode
+** native
+*)
+
+let main () =
+ (* On Windows this tests that we strip \\?\ *)
+ let cwd = Sys.getcwd () in
+ assert (String.lowercase_ascii cwd = String.lowercase_ascii (Unix.realpath cwd));
+ Unix.mkdir "test_dir" 0o755;
+ close_out (open_out "test_dir/test_file");
+ let p0 = Unix.realpath "test_dir/.//test_file" in
+ let p1 = Unix.realpath "test_dir/../test_dir/test_file" in
+ assert (p0 = p1 &&
+ not (Filename.is_relative p0) &&
+ not (Filename.is_relative p1));
+ print_endline "Unix.realpath works with files";
+ let p2 = Unix.realpath "./test_dir/../test_dir/.." in
+ let p3 = Unix.realpath "." in
+ assert (p2 = p3 &&
+ not (Filename.is_relative p2) &&
+ not (Filename.is_relative p3));
+ print_endline "Unix.realpath works with directories";
+ ()
+
+let () = Unix.handle_unix_error main ()
--- /dev/null
+Unix.realpath works with files
+Unix.realpath works with directories
(* TEST
include unix
-flags += "-strict-sequence -safe-string -w A -warn-error A"
+flags += "-strict-sequence -safe-string -w +A-70 -warn-error +A"
modules = "stubs.c"
* libwin32unix
** bytecode
+++ /dev/null
-#cd "test"
-#directory "."
-#use "payload.ml"
+++ /dev/null
-let _ = 42
(* TEST
+subdirectories = "test"
+
* setup-ocaml-build-env
-** script
-script = "mkdir -p test"
-*** script
-script = "cp ${test_source_directory}/driver.ml test/"
-**** script
-script = "cp ${test_source_directory}/payload.ml test/"
-***** ocaml
+** ocaml
test_file = "test/driver.ml"
ocaml_script_as_argument = "true"
*)
--- /dev/null
+#cd "test"
+#directory "."
+#use "payload.ml"
--- /dev/null
+let _ = 42
Note that those tests are here to record this behavior and not to enshrine it.
*)
-[@@@warning "-10-18-8-5"];;
+[@@@warning "-non-unit-statement"];;
+[@@@warning "-not-principal"];;
+[@@@warning "-partial-match"];;
+[@@@warning "-ignored-partial-application"];;
+
type t = A | () and b = B : _ -> b;;
[%%expect{|
type t = A | ()
|}]
;;
+[@@@warning "-labels-omitted"];;
Clflags.strict_sequence := false;;
let f () = let g ~y = (raise Not_found : 'a) in
if false then ((assert false : 'a); g ()) else g ()
-File "aliases.ml", line 17, characters 12-13:
-17 | module A' = A (* missing a.cmi *)
+File "aliases.ml", line 14, characters 12-13:
+14 | module A' = A (* missing a.cmi *)
^
Warning 49 [no-cmi-file]: no cmi file was found in path for module A
-File "aliases.ml", line 18, characters 12-13:
-18 | module B' = B (* broken b.cmi *)
+File "aliases.ml", line 15, characters 12-13:
+15 | module B' = B (* broken b.cmi *)
^
Warning 49 [no-cmi-file]: no valid cmi file was found in path for module B. b.cmi
is not a compiled interface
(* TEST
flags = "-no-alias-deps"
compile_only = "true"
-files = "c.mli d.mli"
+readonly_files = "b.cmi c.mli d.mli"
* setup-ocamlc.byte-build-env
-** script
-script =
- "cp ${test_source_directory}/b.cmi.invalid ${test_build_directory}/b.cmi"
-*** ocamlc.byte
+** ocamlc.byte
all_modules = "c.mli d.mli aliases.ml"
-**** check-ocamlc.byte-output
-***** ocamlobjinfo
+*** check-ocamlc.byte-output
+**** ocamlobjinfo
program = "aliases.cmo"
-****** check-program-output
+***** check-program-output
*)
module A' = A (* missing a.cmi *)
--- /dev/null
+Not a valid cmi file
+++ /dev/null
-Not a valid cmi file
(* TEST
flags = "-no-alias-deps -w -49"
compile_only = "true"
-files = "a2235.ml lib__2235.ml lib2235.ml user_of_lib2235.ml"
+readonly_files = "a2235.ml lib__2235.ml lib2235.ml user_of_lib2235.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "lib__2235.ml"
(* TEST
+subdirectories = "fst intf snd"
+
compile_only = "true"
* setup-ocamlopt.byte-build-env
-** script
-script = "cp -r ${test_source_directory}/fst ${test_source_directory}/intf \
- ${test_source_directory}/snd ${test_build_directory}"
-*** ocamlopt.byte
+** ocamlopt.byte
flags = "-I intf -opaque"
all_modules = "intf/opaque_intf.mli"
-**** ocamlopt.byte
+*** ocamlopt.byte
flags = "-I intf"
all_modules = "intf/opaque_impl.mli intf/regular.mli"
-***** script
-script = "cp intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
- intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli fst"
-****** script
-script = "cp intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
- intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli snd"
-******* ocamlopt.byte
+**** copy
+src = "intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
+ intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli"
+dst = "fst/"
+***** copy
+src = "intf/opaque_intf.cmi intf/opaque_impl.cmi intf/regular.cmi \
+ intf/opaque_intf.mli intf/opaque_impl.mli intf/regular.mli"
+dst = "snd/"
+****** ocamlopt.byte
flags = "-I fst -opaque"
all_modules = "fst/opaque_impl.ml"
-******** ocamlopt.byte
+******* ocamlopt.byte
flags = "-I snd -opaque"
all_modules = "snd/opaque_impl.ml"
-********* ocamlopt.byte
+******** ocamlopt.byte
flags = "-I fst"
all_modules = "fst/opaque_intf.ml fst/regular.ml"
-********** ocamlopt.byte
+********* ocamlopt.byte
flags = "-I snd"
all_modules = "snd/opaque_intf.ml snd/regular.ml"
-*********** ocamlopt.byte
+********** ocamlopt.byte
flags = "-I fst"
all_modules = "test.ml"
(* ordinary compilation *)
-************ ocamlopt.byte
+*********** ocamlopt.byte
compile_only = "false"
all_modules = "fst/opaque_intf.cmx fst/opaque_impl.cmx fst/regular.cmx test.cmx"
program = "${test_build_directory}/p1.exe"
(* change to opaque interface *)
-************ ocamlopt.byte
+*********** ocamlopt.byte
compile_only = "false"
all_modules = "snd/opaque_intf.cmx fst/opaque_impl.cmx fst/regular.cmx test.cmx"
program = "${test_build_directory}/p2.exe"
(* change to opaque implementation *)
-************ ocamlopt.byte
+*********** ocamlopt.byte
compile_only = "false"
all_modules = "fst/opaque_intf.cmx snd/opaque_impl.cmx fst/regular.cmx test.cmx"
program = "${test_build_directory}/p3.exe"
(* change to non-opaque implementation *)
-************ ocamlopt.byte
+*********** ocamlopt.byte
compile_only = "false"
all_modules = "fst/opaque_intf.cmx fst/opaque_impl.cmx snd/regular.cmx test.cmx"
program = "${test_build_directory}/p4.exe"
* setup-ocamlc.byte-build-env
** ocamlc.byte
-flags = "-w a -output-complete-exe -ccopt -I${ocamlsrcdir}/runtime"
+flags = "-w -a -output-complete-exe -ccopt -I${ocamlsrcdir}/runtime"
program = "github9344"
*** run
program = "sh ${test_source_directory}/github9344.sh"
(* TEST
-files = "test.ml_stub.c"
+readonly_files = "test.ml_stub.c"
-* libunix
-** setup-ocamlc.byte-build-env
-*** ocamlc.byte
-flags = "-w a -output-complete-obj"
+* setup-ocamlc.byte-build-env
+** ocamlc.byte
+flags = "-w -a -output-complete-obj"
program = "test.ml.bc.${objext}"
-**** script
+*** script
script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_bc_stub.exe \
test.ml.bc.${objext} ${nativecc_libs} test.ml_stub.c"
output = "${compiler_output}"
-***** run
+**** run
program = "./test.ml_bc_stub.exe"
stdout = "program-output"
stderr = "program-output"
-** setup-ocamlopt.byte-build-env
-*** ocamlopt.byte
-flags = "-w a -output-complete-obj"
+* setup-ocamlopt.byte-build-env
+** ocamlopt.byte
+flags = "-w -a -output-complete-obj"
program = "test.ml.exe.${objext}"
-**** script
+*** script
script = "${mkexe} -I${ocamlsrcdir}/runtime -o test.ml_stub.exe \
test.ml.exe.${objext} ${bytecc_libs} test.ml_stub.c"
output = "${compiler_output}"
-***** run
+**** run
program = "./test.ml_stub.exe"
stdout = "program-output"
stderr = "program-output"
#include <caml/callback.h>
#include <caml/memory.h>
+#ifdef _WIN32
+int wmain(int argc, wchar_t ** argv){
+#else
int main(int argc, char ** argv){
+#endif
caml_startup(argv);
return 0;
(* TEST
-files = "puts.c"
+readonly_files = "puts.c"
use_runtime = "false"
* hasunix
include unix
** setup-ocamlc.byte-build-env
*** ocamlc.byte
-flags = "-w a -output-complete-exe puts.c -ccopt -I${ocamlsrcdir}/runtime"
+flags = "-w -a -output-complete-exe puts.c -ccopt -I${ocamlsrcdir}/runtime"
program = "test2"
**** run
program = "./test2"
let test = function
| (`A | `B) as x | `C -> ()
+
+(* Let-punning *)
+module M = struct
+ let (let*) x f = f x
+ let (and*) a b = (a, b)
+ let x = 1 and y = 2 and z = 3
+ let p =
+ let* x and* y and* z in (x,y,z)
+ let q =
+ let%foo x and y and z in (x,y,z)
+end
+
+let goober a = match a with C (type a b) y -> y
(* TEST
include ocamlcommon
- files = "source.ml"
+ readonly_files = "source.ml"
*)
(* (c) Alain Frisch / Lexifi *)
1 | [%%empty_type];;
^^^^^^^^^^
Error: broken invariant in parsetree: Type declarations cannot be empty.
+Line 2, characters 4-15:
+2 | [%%missing_rhs]
+ ^^^^^^^^^^^
+Error: broken invariant in parsetree: Module type substitution with no right hand side
(* TEST
- files="illegal_ppx.ml"
+ readonly_files = "illegal_ppx.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte with ocamlcommon
all_modules="illegal_ppx.ml"
let f = function [%record_with_functor_fields] -> ();;
[%%empty_let];;
[%%empty_type];;
+module type s = sig
+ [%%missing_rhs]
+end;;
pattern (extensions.ml[19,418+8]..[19,418+14])
Ppat_construct "Some" (extensions.ml[19,418+8]..[19,418+12])
Some
+ []
pattern (extensions.ml[19,418+13]..[19,418+14])
Ppat_var "y" (extensions.ml[19,418+13]..[19,418+14])
<when>
pattern (extensions.ml[20,445+12]..[20,445+17])
Ppat_construct "Bar" (extensions.ml[20,445+12]..[20,445+15])
Some
+ []
pattern (extensions.ml[20,445+16]..[20,445+17])
Ppat_var "x" (extensions.ml[20,445+16]..[20,445+17])
pattern (extensions.ml[20,445+20]..[20,445+25])
Ppat_construct "Baz" (extensions.ml[20,445+20]..[20,445+23])
Some
+ []
pattern (extensions.ml[20,445+24]..[20,445+25])
Ppat_var "x" (extensions.ml[20,445+24]..[20,445+25])
core_type (extensions.ml[20,445+31]..[20,445+44])
let empty_apply loc f =
H.Exp.apply ~loc f []
+let missing_rhs loc =
+ let name = Location.mkloc "T" loc in
+ let mtd = H.Mtd.mk ~loc name in
+ H.Sig.modtype_subst ~loc mtd
+
let empty_let loc = H.Str.value ~loc Asttypes.Nonrecursive []
let empty_type loc = H.Str.type_ ~loc Asttypes.Nonrecursive []
let functor_id loc = Location.mkloc
| Pstr_extension (({Location.txt="empty_type";loc},_),_) -> empty_type loc
| _ -> super.structure_item mapper stri
+let signature_item mapper stri = match stri.psig_desc with
+ | Psig_extension (({Location.txt="missing_rhs";loc},_),_) -> missing_rhs loc
+ | _ -> super.signature_item mapper stri
+
+
let () = M.register "illegal ppx" (fun _ ->
- { super with expr; pat; structure_item }
+ { super with expr; pat; structure_item; signature_item }
)
--- /dev/null
+(* TEST
+ flags = "-dsource"
+ * expect
+*)
+
+module type S = sig
+ type t
+ type t' := t
+end
+[%%expect {|
+
+module type S = sig type t type t' := t end;;
+module type S = sig type t end
+|}]
(* TEST
-files = "myppx.ml"
+readonly_files = "myppx.ml"
include ocamlcommon
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
+ flags="-w +48"
*)
external ( @@ ) : ('a -> 'b) -> 'a -> 'b = "%apply"
h @@ g @@ f @@ 3; (* 37 *)
add 4 @@ g @@ f @@ add 3 @@ add 2 @@ 3; (* 260 *)
]
+
+(* PR#10081 *)
+let bump ?(cap = 100) x = min cap (x + 1)
+let _f x = bump @@ x (* no warning 48 *)
+
+(* Abstract functions *)
+let _ =
+ let module A:sig
+ type f
+ type x
+ val succ: f
+ val zero:x
+ external (@@): f -> x -> int = "%apply"
+ end = struct
+ type f = int -> int
+ type x = int
+ let succ = succ
+ let zero = 0
+ external (@@): f -> x -> int = "%apply"
+ end in
+ A.(succ @@ zero)
(* TEST
+ flags="-w +48"
*)
external ( |> ) : 'a -> ('a -> 'b) -> 'b = "%revapply"
3 |> f |> g |> h; (* 37 *)
3 |> add 2 |> add 3 |> f |> g |> add 4; (* 260 *)
]
+
+
+(* PR#10081 *)
+let bump ?(cap = 100) x = min cap (x + 1)
+let _f x = x |> bump (* no warning 48 *)
+
+(* PR#10081 *)
+type t = A | B
+type s = A | B
+let _f (x : t) = x |> function A -> 0 | B -> 1
+
+(* Abstract functions *)
+let _ =
+ let module A:sig
+ type f
+ type x
+ val succ: f
+ val zero:x
+ external (|>): x -> f -> int = "%revapply"
+ end = struct
+ type f = int -> int
+ type x = int
+ let succ = succ
+ let zero = 0
+ external (|>): x -> f -> int = "%revapply"
+ end in
+ A.(zero |> succ)
(* TEST
-files = "a.ml b.ml b2.ml"
+readonly_files = "a.ml b.ml b2.ml"
+subdirectories = "dir"
* setup-ocamlopt.byte-build-env
-** script
-script = "mkdir -p dir"
-*** script
-script = "cp ${test_source_directory}/dir/c.ml dir/"
-**** ocamlopt.byte
+** ocamlopt.byte
module = "a.ml"
-***** ocamlopt.byte
+*** ocamlopt.byte
module = "b.ml"
-****** ocamlopt.byte
+**** ocamlopt.byte
module = "b2.ml"
-******* script
-script = "cp b.cmx b.cmi b2.cmx b2.cmi dir/"
-******** cd
+***** copy
+src = "b.cmx b.cmi b2.cmx b2.cmi"
+dst = "dir/"
+****** cd
cwd = "dir"
-********* ocamlopt.byte
+******* ocamlopt.byte
module = "c.ml"
flags = "-w -58"
-********** check-ocamlopt.byte-output
+******** check-ocamlopt.byte-output
*)
--- /dev/null
+(* TEST *)
+
+type t = A | B of (int -> int)
+
+let p = 1 + 1
+
+let rec b = B g
+and g n =
+ let b' = b in
+ match b' with
+ | A -> n + p
+ | B f -> f n
--- /dev/null
+(* TEST *)
+
+(* Compaction crash when there is only one heap chunk and it is fully used. *)
+let c = ref []
+
+let () =
+ for i = 0 to 25000 do
+ c := 0 :: !c;
+ Gc.compact ()
+ done
(* TEST
- files = "cmis_on_file_system.ml cmis_on_file_system_companion.mli"
+ readonly_files = "cmis_on_file_system.ml cmis_on_file_system_companion.mli"
* setup-ocamlc.byte-build-env
** ocamlc.byte
compile_only = "true"
(* TEST
-flags = "-w a"
+flags = "-w -a"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w a"
+flags = "-w -a"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-files = "foo.ml gen_cached_cmi.ml input.ml"
+readonly_files = "foo.ml gen_cached_cmi.ml input.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "foo.ml"
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module C = struct
+ class c = object end
+end
+
+module R = struct
+ include C
+ type c
+end
+[%%expect {|
+module C : sig class c : object end end
+module R : sig type c end
+|}]
+
+
+module CT = struct
+ include C
+ class type c = object end
+end
+[%%expect {|
+module CT : sig class type c = object end end
+|}]
+
+
+module P = struct
+ type t = private < .. >
+end
+
+module M = struct
+ include P
+ type t = A
+end
+[%%expect {|
+module P : sig type t = private < .. > end
+module M : sig type t = A end
+|}]
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module M/237 by M/254
+Error: Illegal shadowing of included module M/236 by M/253
Line 2, characters 2-11:
- Module M/237 came from this include
+ Module M/236 came from this include
Line 3, characters 2-26:
- The value ignore has no valid type if M/237 is shadowed
+ The value ignore has no valid type if M/236 is shadowed
|}]
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included module type T/324 by T/341
+Error: Illegal shadowing of included module type T/322 by T/339
Line 2, characters 2-11:
- Module type T/324 came from this include
+ Module type T/322 came from this include
Line 3, characters 2-39:
- The module F has no valid type if T/324 is shadowed
+ The module F has no valid type if T/322 is shadowed
|}]
module type Extension = sig
Line 4, characters 2-11:
4 | include S
^^^^^^^^^
-Error: Illegal shadowing of included type ext/360 by ext/377
+Error: Illegal shadowing of included type ext/357 by ext/374
Line 2, characters 2-11:
- Type ext/360 came from this include
+ Type ext/357 came from this include
Line 3, characters 14-16:
- The extension constructor C2 has no valid type if ext/360 is shadowed
+ The extension constructor C2 has no valid type if ext/357 is shadowed
|}]
module type Class = sig
-----------
Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 18, characters 30-53
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 21, characters 30-76
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 26, characters 12-66
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 29, characters 30-60
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 32, characters 30-55
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 36, characters 12-62
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 39, characters 22-27
Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 41, characters 30-65
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 44, characters 30-69
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 47, characters 30-73
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 51, characters 30-43
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.get0 in file "callstacks.ml", line 54, characters 28-33
Called from Callstacks.getfloatfield in file "callstacks.ml", line 56, characters 30-47
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
-Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
+Raised by primitive operation at Stdlib__Marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 62, characters 12-87
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 65, characters 30-59
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 68, characters 37-43
Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 70, characters 30-49
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_list_literal in file "callstacks.ml", line 18, characters 30-53
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_pair in file "callstacks.ml", line 21, characters 30-76
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_record in file "callstacks.ml", line 26, characters 12-66
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_some in file "callstacks.ml", line 29, characters 30-60
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_array_literal in file "callstacks.ml", line 32, characters 30-55
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_float_array_literal in file "callstacks.ml", line 36, characters 12-62
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.do_alloc_unknown_array_literal in file "callstacks.ml", line 39, characters 22-27
Called from Callstacks.alloc_unknown_array_literal in file "callstacks.ml", line 41, characters 30-65
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_small_array in file "callstacks.ml", line 44, characters 30-69
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_large_array in file "callstacks.ml", line 47, characters 30-73
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_closure.(fun) in file "callstacks.ml", line 51, characters 30-43
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
No callstack
-----------
-Raised by primitive operation at Stdlib__marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
+Raised by primitive operation at Stdlib__Marshal.from_bytes in file "marshal.ml", line 61, characters 9-35
Called from Callstacks.alloc_unmarshal in file "callstacks.ml", line 62, characters 12-87
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.alloc_ref in file "callstacks.ml", line 65, characters 30-59
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
-----------
Raised by primitive operation at Callstacks.prod_floats in file "callstacks.ml", line 68, characters 37-43
Called from Callstacks.alloc_boxedfloat in file "callstacks.ml", line 70, characters 30-49
Called from Callstacks.test in file "callstacks.ml", line 92, characters 2-10
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Callstacks in file "callstacks.ml", line 99, characters 2-27
2: 0.42 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.42 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.42 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.01 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.01 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.01 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.83 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.83 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.83 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml", line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
OK
2: 0.42 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.42 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.42 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.01 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.01 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.01 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
2: 0.83 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 2-19
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
3: 0.83 false
Raised by primitive operation at Comballoc.f in file "comballoc.ml", line 14, characters 6-18
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
4: 0.83 true
Raised by primitive operation at Comballoc.f4 in file "comballoc.ml" (inlined), line 11, characters 11-20
Called from Comballoc.f in file "comballoc.ml", line 14, characters 13-17
Called from Comballoc.test in file "comballoc.ml", line 39, characters 25-48
-Called from Stdlib__list.iter in file "list.ml", line 110, characters 12-15
+Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15
Called from Comballoc in file "comballoc.ml", line 69, characters 2-35
OK
(* TEST
reference="${test_source_directory}/ellipses.reference"
output="ellipses.output"
- files="${test_source_directory}/ellipses.input"
+ readonly_files = "${test_source_directory}/ellipses.input"
script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${readonly_files} -o ${output}"
* hasstr
** native-compiler
*** shared-libraries
(* TEST
reference="${test_source_directory}/redirections.reference"
output="redirections.output"
- files="${test_source_directory}/redirections.input"
+ readonly_files = "${test_source_directory}/redirections.input"
script = "${ocamlrun} ${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${readonly_files} -o ${output}"
* hasstr
** native-compiler
*** shared-libraries
*** no-shared-libraries
**** script with unix,str
script = "${ocamlsrcdir}/tools/caml-tex \
- -repo-root ${ocamlsrcdir} ${files} -o ${output}"
+ -repo-root ${ocamlsrcdir} ${readonly_files} -o ${output}"
***** check-program-output
*)
--- /dev/null
+#include <stdio.h>
+#include <stdlib.h>
+
+int main()
+{
+ printf("Hello, world!\n");
+ return 0;
+}
--- /dev/null
+(* TEST
+readonly_files = "hello.c"
+* setup-ocamlopt.opt-build-env
+** script
+script = "mkdir outputdir"
+*** ocamlopt.opt
+all_modules = "hello.c"
+compile_only = "true"
+flags = "-o outputdir/hello.${objext}"
+**** file-exists
+file = "outputdir/hello.${objext}"
+*)
+
+(*
+ This test makes sure it is possible to specify the name of the output
+ object file when compiling a C file with the OCaml compiler.
+ The test does not need to contain any OCaml code.
+*)
--- /dev/null
+Options -c -o are incompatible with compiling multiple files
--- /dev/null
+(* TEST
+* setup-ocamlopt.opt-build-env
+** ocamlopt.opt
+all_modules = "foo.c bar.c"
+compile_only = "true"
+flags = "-o outputdir/baz.${objext}"
+ocamlopt_opt_exit_status = "2"
+*** check-ocamlopt.opt-output
+*)
+
+(*
+ This test makes sure that the -o option is rejected when trying to
+ compile several C files during the same invocatin of the OCaml compiler.
+ The test does not need to contain any OCaml code.
+*)
--- /dev/null
+don't know what to do with unknown-file
--- /dev/null
+(* TEST
+
+readonly_files = "unknown-file"
+
+* setup-ocamlc.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlc.byte
+all_modules = ""
+flags = "unknown-file"
+ocamlc_byte_exit_status = "2"
+*** script
+script = "grep 'know what to do with unknown-file' compiler-output.raw"
+output = "compiler-output"
+**** check-ocamlc.byte-output
+compiler_output = "compiler-output"
+
+* setup-ocamlopt.byte-build-env
+compiler_output = "compiler-output.raw"
+** ocamlopt.byte
+all_modules = ""
+flags = "unknown-file"
+ocamlopt_byte_exit_status = "2"
+*** script
+script = "grep 'know what to do with unknown-file' compiler-output.raw"
+output = "compiler-output"
+**** check-ocamlopt.byte-output
+compiler_output = "compiler-output"
+
+*)
+
+(*
+ This file is just a test driver, the test does not contain any
+ real OCaml code
+*)
+++ /dev/null
-don't know what to do with unknown-file
+++ /dev/null
-(* TEST
-
-files = "unknown-file"
-
-* setup-ocamlc.byte-build-env
-compiler_output = "compiler-output.raw"
-** ocamlc.byte
-all_modules = ""
-flags = "unknown-file"
-ocamlc_byte_exit_status = "2"
-*** script
-script = "grep 'know what to do with unknown-file' compiler-output.raw"
-output = "compiler-output"
-**** check-ocamlc.byte-output
-compiler_output = "compiler-output"
-
-* setup-ocamlopt.byte-build-env
-compiler_output = "compiler-output.raw"
-** ocamlopt.byte
-all_modules = ""
-flags = "unknown-file"
-ocamlopt_byte_exit_status = "2"
-*** script
-script = "grep 'know what to do with unknown-file' compiler-output.raw"
-output = "compiler-output"
-**** check-ocamlopt.byte-output
-compiler_output = "compiler-output"
-
-*)
-
-(* this file is just a test driver, the test does not contain real OCamlcode *)
(* TEST
include dynlink
-files = "host.ml plugin.ml"
+readonly_files = "host.ml plugin.ml"
libraries = ""
flags += " -g "
(* TEST
-files = "a.ml b.ml"
+readonly_files = "a.ml b.ml"
ocamldebug_script = "${test_source_directory}/input_script"
* debugger
** shared-libraries
(* TEST
flags += " -g "
ocamldebug_script = "${test_source_directory}/input_script"
-files = "printer.ml"
+readonly_files = "printer.ml"
include debugger
* debugger
** shared-libraries
--- /dev/null
+(* TEST
+ modules = "calc_parser.mly calc_lexer.mll"
+ ocamllex_flags = " -q "
+ ocamlyacc_flags = " -q "
+ readonly_files = "calc_input.txt"
+ stdin = "calc_input.txt"
+*)
+let _ =
+ try
+ let lexbuf = Lexing.from_channel stdin in
+ while true do
+ let result = Calc_parser.main Calc_lexer.token lexbuf in
+ print_int result; print_newline(); flush stdout
+ done
+ with Calc_lexer.Eof ->
+ exit 0
--- /dev/null
+7
+9
+-11
+-93
--- /dev/null
+1+2*3
+(1+2)*3
+-10-1
+63/2*-3
--- /dev/null
+{
+open Calc_parser (* The type token is defined in calc_parser.mli *)
+exception Eof
+}
+
+rule token = parse
+ [' ' '\t' '\r'] { token lexbuf } (* skip blanks *)
+ | ['\n' ] { EOL }
+ | ['0'-'9']+ as lxm { INT(int_of_string lxm) }
+ | '+' { PLUS }
+ | '-' { MINUS }
+ | '*' { TIMES }
+ | '/' { DIV }
+ | '(' { LPAREN }
+ | ')' { RPAREN }
+ | eof { raise Eof }
--- /dev/null
+%token <int> INT
+%token PLUS MINUS TIMES DIV
+%token LPAREN RPAREN
+%token EOL
+%left PLUS MINUS /* lowest precedence */
+%left TIMES DIV /* medium precedence */
+%nonassoc UMINUS /* highest precedence */
+%start main /* the entry point */
+%type <int> main
+%%
+main:
+ expr EOL { $1 }
+;
+expr:
+ INT { $1 }
+ | LPAREN expr RPAREN { $2 }
+ | expr PLUS expr { $1 + $3 }
+ | expr MINUS expr { $1 - $3 }
+ | expr TIMES expr { $1 * $3 }
+ | expr DIV expr { $1 / $3 }
+ | MINUS expr %prec UMINUS { - $2 }
+;
+++ /dev/null
-(* Auxiliaries for the parser. *)
-
-open Syntax
-
-let regexp_for_string s =
- let l = String.length s in
- if l = 0 then
- Epsilon
- else begin
- let re = ref(Characters [String.get s (l - 1)]) in
- for i = l - 2 downto 0 do
- re := Sequence(Characters [String.get s i], !re)
- done;
- !re
- end
-
-
-let char_class c1 c2 =
- let cl = ref [] in
- for i = Char.code c2 downto Char.code c1 do
- cl := Char.chr i :: !cl
- done;
- !cl
-
-
-let all_chars = char_class '\001' '\255'
-
-
-let rec subtract l1 l2 =
- match l1 with
- [] -> []
- | a::l -> if List.mem a l2 then subtract l l2 else a :: subtract l l2
+++ /dev/null
-/* The grammar for lexer definitions */
-
-%{
-open Syntax
-open Gram_aux
-
-(* test f' '"' *)
-let () =
- let f' = ignore in
- f' '"'
-
-(* test {|*)|}, {%foo|*)|} and {%%f.oo bar|*)|bar} *)
-(* test {%foo {%| *)
-
-let () = ignore {foo||foo}
-%}
-
-%token <string> Tident
-%token <char> Tchar
-%token <string> Tstring
-%token <Syntax.location> Taction
-%token Trule Tparse Tand Tequal Tend Tor Tunderscore Teof Tlbracket Trbracket
-%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash
-
-%left Tor
-%left CONCAT
-%nonassoc Tmaybe
-%left Tstar
-%left Tplus
-
-%start lexer_definition
-%type <Syntax.lexer_definition> lexer_definition
-
-%%
-
-lexer_definition:
- header Trule definition other_definitions Tend
- { Lexdef($1, $3::(List.rev $4)) }
-;
-header:
- Taction
- { $1 (* '"' test that ocamlyacc can
- handle comments correctly"*)" "(*" *) }
- |
- { Location(0,0) }
-;
-other_definitions:
- other_definitions Tand definition
- { $3::$1 }
- |
- { [] }
-;
-definition:
- Tident Tequal entry
- { ($1,$3) }
-;
-entry:
- Tparse case rest_of_entry
- { $2 :: List.rev $3 }
-;
-rest_of_entry:
- rest_of_entry Tor case
- { $3::$1 }
- |
- { [] }
-;
-case:
- regexp Taction
- { ($1,$2) }
-;
-regexp:
- Tunderscore
- { Characters all_chars }
- | Teof
- { Characters ['\000'] }
- | Tchar
- { Characters [$1] }
- | Tstring
- { regexp_for_string $1 }
- | Tlbracket char_class Trbracket
- { Characters $2 }
- | regexp Tstar
- { Repetition $1 }
- | regexp Tmaybe
- { Alternative($1, Epsilon) }
- | regexp Tplus
- { Sequence($1, Repetition $1) }
- | regexp Tor regexp
- { Alternative($1,$3) }
- | regexp regexp %prec CONCAT
- { Sequence($1,$2) }
- | Tlparen regexp Trparen
- { $2 }
-;
-char_class:
- Tcaret char_class1
- { subtract all_chars $2 }
- | char_class1
- { $1 }
-;
-char_class1:
- Tchar Tdash Tchar
- { char_class $1 $3 }
- | Tchar
- { [$1] }
- | char_class char_class %prec CONCAT
- { $1 @ $2 }
-;
-
-%%
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The lexical analyzer for lexer definitions. *)
-
-{
-open Syntax
-open Grammar
-open Scan_aux
-}
-
-rule main = parse
- [' ' '\010' '\013' '\009' ] +
- { main lexbuf }
- | "(*"
- { comment_depth := 1;
- comment lexbuf;
- main lexbuf }
- | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
- ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
- { match Lexing.lexeme lexbuf with
- "rule" -> Trule
- | "parse" -> Tparse
- | "and" -> Tand
- | "eof" -> Teof
- | s -> Tident s }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- Tstring(get_stored_string()) }
- | "'"
- { Tchar(char lexbuf) }
- | '{'
- { let n1 = Lexing.lexeme_end lexbuf in
- brace_depth := 1;
- let n2 = action lexbuf in
- Taction(Location(n1, n2)) }
- | '=' { Tequal }
- | ";;" { Tend }
- | '|' { Tor }
- | '_' { Tunderscore }
- | "eof" { Teof }
- | '[' { Tlbracket }
- | ']' { Trbracket }
- | '*' { Tstar }
- | '?' { Tmaybe }
- | '+' { Tplus }
- | '(' { Tlparen }
- | ')' { Trparen }
- | '^' { Tcaret }
- | '-' { Tdash }
- | eof
- { raise(Lexical_error "unterminated lexer definition") }
- | _
- { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
-
-and action = parse
- '{'
- { incr brace_depth;
- action lexbuf }
- | '}'
- { decr brace_depth;
- if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- action lexbuf }
- | '\''
- { let _ = char lexbuf in action lexbuf }
- | "(*"
- { comment_depth := 1;
- comment lexbuf;
- action lexbuf }
- | eof
- { raise (Lexical_error "unterminated action") }
- | _
- { action lexbuf }
-
-and string = parse
- '"'
- { () }
- | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
- { string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
- { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
- string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
- { store_string_char(char_for_decimal_code lexbuf 1);
- string lexbuf }
- | eof
- { raise(Lexical_error "unterminated string") }
- | _
- { store_string_char(Lexing.lexeme_char lexbuf 0);
- string lexbuf }
-
-and char = parse
- [^ '\\'] "'"
- { Lexing.lexeme_char lexbuf 0 }
- | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { char_for_decimal_code lexbuf 1 }
- | _
- { raise(Lexical_error "bad character constant") }
-
-and comment = parse
- "(*"
- { incr comment_depth; comment lexbuf }
- | "*)"
- { decr comment_depth;
- if !comment_depth = 0 then () else comment lexbuf }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- comment lexbuf }
- | eof
- { raise(Lexical_error "unterminated comment") }
- | _
- { comment lexbuf }
-;;
+++ /dev/null
-(* Compiling a lexer definition *)
-
-open Syntax
-
-(* Deep abstract syntax for regular expressions *)
-
-type regexp =
- Empty
- | Chars of int
- | Action of int
- | Seq of regexp * regexp
- | Alt of regexp * regexp
- | Star of regexp
-
-(* From shallow to deep syntax *)
-
-(***
-
-let print_char_class c =
- let print_interval low high =
- prerr_int low;
- if high - 1 > low then begin
- prerr_char '-';
- prerr_int (high-1)
- end;
- prerr_char ' ' in
- let rec print_class first next = function
- [] -> print_interval first next
- | c::l ->
- if char.code c = next
- then print_class first (next+1) l
- else begin
- print_interval first next;
- print_class (char.code c) (char.code c + 1) l
- end in
- match c with
- [] -> prerr_newline()
- | c::l -> print_class (char.code c) (char.code c + 1) l; prerr_newline()
-
-
-let rec print_regexp = function
- Empty -> prerr_string "Empty"
- | Chars n -> prerr_string "Chars "; prerr_int n
- | Action n -> prerr_string "Action "; prerr_int n
- | Seq(r1,r2) -> print_regexp r1; prerr_string "; "; print_regexp r2
- | Alt(r1,r2) ->
- prerr_string "("; print_regexp r1; prerr_string " | "; print_regexp r2;
- prerr_string ")"
- | Star r -> prerr_string "("; print_regexp r; prerr_string ")*"
-
-***)
-
-let chars = ref ([] : char list list)
-let chars_count = ref 0
-let actions = ref ([] : (int * location) list)
-let actions_count = ref 0
-
-let rec encode_regexp = function
- Epsilon -> Empty
- | Characters cl ->
- let n = !chars_count in
-(*** prerr_int n; prerr_char ' '; print_char_class cl; ***)
- chars := cl :: !chars;
- chars_count := !chars_count + 1;
- Chars(n)
- | Sequence(r1,r2) ->
- Seq(encode_regexp r1, encode_regexp r2)
- | Alternative(r1,r2) ->
- Alt(encode_regexp r1, encode_regexp r2)
- | Repetition r ->
- Star (encode_regexp r)
-
-
-let encode_casedef =
- List.fold_left
- (fun reg (expr,act) ->
- let act_num = !actions_count in
- actions_count := !actions_count + 1;
- actions := (act_num, act) :: !actions;
- Alt(reg, Seq(encode_regexp expr, Action act_num)))
- Empty
-
-
-let encode_lexdef (Lexdef(_, ld)) =
- chars := [];
- chars_count := 0;
- actions := [];
- actions_count := 0;
- let name_regexp_list =
- List.map (fun (name, casedef) -> (name, encode_casedef casedef)) ld in
-(* List.iter print_char_class chars; *)
- let chr = Array.of_list (List.rev !chars)
- and act = !actions in
- chars := [];
- actions := [];
- (chr, name_regexp_list, act)
-
-
-(* To generate directly a NFA from a regular expression.
- Confer Aho-Sethi-Ullman, dragon book, chap. 3 *)
-
-type transition =
- OnChars of int
- | ToAction of int
-
-
-let rec merge_trans l1 l2 =
- match (l1, l2) with
- ([], s2) -> s2
- | (s1, []) -> s1
- | ((OnChars n1 as t1) :: r1 as s1), ((OnChars n2 as t2) :: r2 as s2) ->
- if n1 = n2 then t1 :: merge_trans r1 r2 else
- if n1 < n2 then t1 :: merge_trans r1 s2 else
- t2 :: merge_trans s1 r2
- | ((ToAction n1 as t1) :: r1 as s1), ((ToAction n2 as t2) :: r2 as s2) ->
- if n1 = n2 then t1 :: merge_trans r1 r2 else
- if n1 < n2 then t1 :: merge_trans r1 s2 else
- t2 :: merge_trans s1 r2
- | ((OnChars n1 as t1) :: r1), ((ToAction n2) :: r2 as s2) ->
- t1 :: merge_trans r1 s2
- | ((ToAction n1) :: r1 as s1), ((OnChars n2 as t2) :: r2) ->
- t2 :: merge_trans s1 r2
-
-
-let rec nullable = function
- Empty -> true
- | Chars _ -> false
- | Action _ -> false
- | Seq(r1,r2) -> nullable r1 && nullable r2
- | Alt(r1,r2) -> nullable r1 || nullable r2
- | Star r -> true
-
-
-let rec firstpos = function
- Empty -> []
- | Chars pos -> [OnChars pos]
- | Action act -> [ToAction act]
- | Seq(r1,r2) -> if nullable r1
- then merge_trans (firstpos r1) (firstpos r2)
- else firstpos r1
- | Alt(r1,r2) -> merge_trans (firstpos r1) (firstpos r2)
- | Star r -> firstpos r
-
-
-let rec lastpos = function
- Empty -> []
- | Chars pos -> [OnChars pos]
- | Action act -> [ToAction act]
- | Seq(r1,r2) -> if nullable r2
- then merge_trans (lastpos r1) (lastpos r2)
- else lastpos r2
- | Alt(r1,r2) -> merge_trans (lastpos r1) (lastpos r2)
- | Star r -> lastpos r
-
-
-let followpos size name_regexp_list =
- let v = Array.make size [] in
- let fill_pos first = function
- OnChars pos -> v.(pos) <- merge_trans first v.(pos); ()
- | ToAction _ -> () in
- let rec fill = function
- Seq(r1,r2) ->
- fill r1; fill r2;
- List.iter (fill_pos (firstpos r2)) (lastpos r1)
- | Alt(r1,r2) ->
- fill r1; fill r2
- | Star r ->
- fill r;
- List.iter (fill_pos (firstpos r)) (lastpos r)
- | _ -> () in
- List.iter (fun (name, regexp) -> fill regexp) name_regexp_list;
- v
-
-
-let no_action = 0x3FFFFFFF
-
-let split_trans_set =
- List.fold_left
- (fun (act, pos_set as act_pos_set) trans ->
- match trans with
- OnChars pos -> (act, pos :: pos_set)
- | ToAction act1 -> if act1 < act then (act1, pos_set)
- else act_pos_set)
- (no_action, [])
-
-
-let memory = (Hashtbl.create 131 : (transition list, int) Hashtbl.t)
-let todo = ref ([] : (transition list * int) list)
-let next = ref 0
-
-let get_state st =
- try
- Hashtbl.find memory st
- with Not_found ->
- let nbr = !next in
- next := !next + 1;
- Hashtbl.add memory st nbr;
- todo := (st, nbr) :: !todo;
- nbr
-
-let rec map_on_states f =
- match !todo with
- [] -> []
- | (st,i)::r -> todo := r; let res = f st in (res,i) :: map_on_states f
-
-let number_of_states () = !next
-
-let goto_state = function
- [] -> Backtrack
- | ps -> Goto (get_state ps)
-
-
-let transition_from chars follow pos_set =
- let tr = Array.make 256 []
- and shift = Array.make 256 Backtrack in
- List.iter
- (fun pos ->
- List.iter
- (fun c ->
- tr.(Char.code c) <-
- merge_trans tr.(Char.code c) follow.(pos))
- chars.(pos))
- pos_set;
- for i = 0 to 255 do
- shift.(i) <- goto_state tr.(i)
- done;
- shift
-
-
-let translate_state chars follow state =
- match split_trans_set state with
- n, [] -> Perform n
- | n, ps -> Shift( (if n = no_action then No_remember else Remember n),
- transition_from chars follow ps)
-
-
-let make_dfa lexdef =
- let (chars, name_regexp_list, actions) =
- encode_lexdef lexdef in
-(**
- List.iter (fun (name, regexp) ->
- prerr_string name; prerr_string " = "; print_regexp regexp;
- prerr_newline())
- name_regexp_list;
-**)
- let follow =
- followpos (Array.length chars) name_regexp_list in
- let initial_states =
- List.map (fun (name, regexp) -> (name, get_state(firstpos regexp)))
- name_regexp_list in
- let states =
- map_on_states (translate_state chars follow) in
- let v =
- Array.make (number_of_states()) (Perform 0) in
- List.iter (fun (auto, i) -> v.(i) <- auto) states;
- (initial_states, v, actions)
+++ /dev/null
-14 shift/reduce conflicts, 2 reduce/reduce conflicts.
+++ /dev/null
-(* TEST
- modules = "syntax.ml gram_aux.ml grammar.mly scan_aux.ml scanner.mll \
- lexgen.ml output.ml"
- files = "input"
- arguments = "input"
- ocamllex_flags = " -q "
- ocamlyacc_flags = " -q "
- flags = " -w a "
-*)
-
-(* The lexer generator. Command-line parsing. *)
-
-open Syntax
-open Scanner
-open Grammar
-open Lexgen
-open Output
-
-let main () =
- if Array.length Sys.argv <> 2 then begin
- prerr_string "Usage: camllex <input file>\n";
- exit 2
- end;
- let source_name = Sys.argv.(1) in
- let dest_name =
- if Filename.check_suffix source_name ".mll" then
- Filename.chop_suffix source_name ".mll" ^ ".ml"
- else
- source_name ^ ".ml" in
- ic := open_in source_name;
-(* oc := open_out dest_name; *) ignore dest_name;
- oc := stdout;
- let lexbuf = Lexing.from_channel !ic in
- let (Lexdef(header,_) as def) =
- try
- Grammar.lexer_definition Scanner.main lexbuf
- with
- Parsing.Parse_error ->
- prerr_string "Syntax error around char ";
- prerr_int (Lexing.lexeme_start lexbuf);
- prerr_endline ".";
- exit 2
- | Scan_aux.Lexical_error s ->
- prerr_string "Lexical error around char ";
- prerr_int (Lexing.lexeme_start lexbuf);
- prerr_string ": ";
- prerr_string s;
- prerr_endline ".";
- exit 2 in
- let ((init, states, acts) as dfa) = make_dfa def in
- output_lexdef header dfa;
- close_in !ic;
- close_out !oc
-
-let _ = main(); exit 0
-
-
-(*****
-let main () =
- ic := stdin;
- oc := stdout;
- let lexbuf = lexing.from_channel ic in
- let (Lexdef(header,_) as def) =
- try
- grammar.lexer_definition scanner.main lexbuf
- with
- parsing.Parse_error x ->
- prerr_string "Syntax error around char ";
- prerr_int (lexing.lexeme_start lexbuf);
- prerr_endline ".";
- sys.exit 2
- | scan_aux.Lexical_error s ->
- prerr_string "Lexical error around char ";
- prerr_int (lexing.lexeme_start lexbuf);
- prerr_string ": ";
- prerr_string s;
- prerr_endline ".";
- sys.exit 2 in
- let ((init, states, acts) as dfa) = make_dfa def in
- output_lexdef header dfa
-
-****)
-
-(****
-let debug_scanner lexbuf =
- let tok = scanner.main lexbuf in
- begin match tok with
- Tident s -> prerr_string "Tident "; prerr_string s
- | Tchar c -> prerr_string "Tchar "; prerr_char c
- | Tstring s -> prerr_string "Tstring "; prerr_string s
- | Taction(Location(i1,i2)) ->
- prerr_string "Taction "; prerr_int i1; prerr_string "-";
- prerr_int i2
- | Trule -> prerr_string "Trule"
- | Tparse -> prerr_string "Tparse"
- | Tand -> prerr_string "Tand"
- | Tequal -> prerr_string "Tequal"
- | Tend -> prerr_string "Tend"
- | Tor -> prerr_string "Tor"
- | Tunderscore -> prerr_string "Tunderscore"
- | Teof -> prerr_string "Teof"
- | Tlbracket -> prerr_string "Tlbracket"
- | Trbracket -> prerr_string "Trbracket"
- | Tstar -> prerr_string "Tstar"
- | Tmaybe -> prerr_string "Tmaybe"
- | Tplus -> prerr_string "Tplus"
- | Tlparen -> prerr_string "Tlparen"
- | Trparen -> prerr_string "Trparen"
- | Tcaret -> prerr_string "Tcaret"
- | Tdash -> prerr_string "Tdash"
- end;
- prerr_newline();
- tok
-
-****)
+++ /dev/null
-66 states, 44 actions.
-
-open Syntax
-open Grammar
-open Scan_aux
-
-let rec action_43 lexbuf = (
- comment lexbuf )
-and action_42 lexbuf = (
- raise(Lexical_error "unterminated comment") )
-and action_41 lexbuf = (
- reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- comment lexbuf )
-and action_40 lexbuf = (
- decr comment_depth;
- if !comment_depth = 0 then () else comment lexbuf )
-and action_39 lexbuf = (
- incr comment_depth; comment lexbuf )
-and action_38 lexbuf = (
- raise(Lexical_error "bad character constant") )
-and action_37 lexbuf = (
- char_for_decimal_code lexbuf 1 )
-and action_36 lexbuf = (
- char_for_backslash (Lexing.lexeme_char lexbuf 1) )
-and action_35 lexbuf = (
- Lexing.lexeme_char lexbuf 0 )
-and action_34 lexbuf = (
- store_string_char(Lexing.lexeme_char lexbuf 0);
- string lexbuf )
-and action_33 lexbuf = (
- raise(Lexical_error "unterminated string") )
-and action_32 lexbuf = (
- store_string_char(char_for_decimal_code lexbuf 1);
- string lexbuf )
-and action_31 lexbuf = (
- store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
- string lexbuf )
-and action_30 lexbuf = (
- string lexbuf )
-and action_29 lexbuf = (
- () )
-and action_28 lexbuf = (
- action lexbuf )
-and action_27 lexbuf = (
- raise (Lexical_error "unterminated action") )
-and action_26 lexbuf = (
- comment_depth := 1;
- comment lexbuf;
- action lexbuf )
-and action_25 lexbuf = (
- let _ = char lexbuf in action lexbuf )
-and action_24 lexbuf = (
- reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- action lexbuf )
-and action_23 lexbuf = (
- decr brace_depth;
- if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf )
-and action_22 lexbuf = (
- incr brace_depth;
- action lexbuf )
-and action_21 lexbuf = (
- raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) )
-and action_20 lexbuf = (
- raise(Lexical_error "unterminated lexer definition") )
-and action_19 lexbuf = (
- Tdash )
-and action_18 lexbuf = (
- Tcaret )
-and action_17 lexbuf = (
- Trparen )
-and action_16 lexbuf = (
- Tlparen )
-and action_15 lexbuf = (
- Tplus )
-and action_14 lexbuf = (
- Tmaybe )
-and action_13 lexbuf = (
- Tstar )
-and action_12 lexbuf = (
- Trbracket )
-and action_11 lexbuf = (
- Tlbracket )
-and action_10 lexbuf = (
- Teof )
-and action_9 lexbuf = (
- Tunderscore )
-and action_8 lexbuf = (
- Tor )
-and action_7 lexbuf = (
- Tend )
-and action_6 lexbuf = (
- Tequal )
-and action_5 lexbuf = (
- let n1 = Lexing.lexeme_end lexbuf in
- brace_depth := 1;
- let n2 = action lexbuf in
- Taction(Location(n1, n2)) )
-and action_4 lexbuf = (
- Tchar(char lexbuf) )
-and action_3 lexbuf = (
- reset_string_buffer();
- string lexbuf;
- Tstring(get_stored_string()) )
-and action_2 lexbuf = (
- match Lexing.lexeme lexbuf with
- "rule" -> Trule
- | "parse" -> Tparse
- | "and" -> Tand
- | "eof" -> Teof
- | s -> Tident s )
-and action_1 lexbuf = (
- comment_depth := 1;
- comment lexbuf;
- main lexbuf )
-and action_0 lexbuf = (
- main lexbuf )
-and state_0 lexbuf =
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A' -> state_51 lexbuf
- | ' '|'\013'|'\n'|'\t' -> state_40 lexbuf
- | '|' -> action_8 lexbuf
- | '{' -> action_5 lexbuf
- | 'e' -> state_56 lexbuf
- | '_' -> state_55 lexbuf
- | '^' -> action_18 lexbuf
- | ']' -> action_12 lexbuf
- | '[' -> action_11 lexbuf
- | '?' -> action_14 lexbuf
- | '=' -> action_6 lexbuf
- | ';' -> state_48 lexbuf
- | '-' -> action_19 lexbuf
- | '+' -> action_15 lexbuf
- | '*' -> action_13 lexbuf
- | ')' -> action_17 lexbuf
- | '(' -> state_43 lexbuf
- | '\'' -> action_4 lexbuf
- | '"' -> action_3 lexbuf
- | '\000' -> action_20 lexbuf
- | _ -> action_21 lexbuf
-and state_1 lexbuf =
- match lexing.next_char lexbuf with
- '}' -> action_23 lexbuf
- | '{' -> action_22 lexbuf
- | '(' -> state_34 lexbuf
- | '\'' -> action_25 lexbuf
- | '"' -> action_24 lexbuf
- | '\000' -> action_27 lexbuf
- | _ -> action_28 lexbuf
-and state_2 lexbuf =
- match lexing.next_char lexbuf with
- '\\' -> state_24 lexbuf
- | '"' -> action_29 lexbuf
- | '\000' -> action_33 lexbuf
- | _ -> action_34 lexbuf
-and state_3 lexbuf =
- match lexing.next_char lexbuf with
- '\\' -> state_13 lexbuf
- | '\000' -> lexing.backtrack lexbuf
- | _ -> state_12 lexbuf
-and state_4 lexbuf =
- match lexing.next_char lexbuf with
- '*' -> state_9 lexbuf
- | '(' -> state_8 lexbuf
- | '"' -> action_41 lexbuf
- | '\000' -> action_42 lexbuf
- | _ -> action_43 lexbuf
-and state_8 lexbuf =
- Lexing.set_backtrack lexbuf action_43;
- match lexing.next_char lexbuf with
- '*' -> action_39 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_9 lexbuf =
- Lexing.set_backtrack lexbuf action_43;
- match lexing.next_char lexbuf with
- ')' -> action_40 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_12 lexbuf =
- Lexing.set_backtrack lexbuf action_38;
- match lexing.next_char lexbuf with
- '\'' -> action_35 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_13 lexbuf =
- Lexing.set_backtrack lexbuf action_38;
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_15 lexbuf
- | 't'|'r'|'n'|'b'|'\\'|'\'' -> state_14 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_14 lexbuf =
- match lexing.next_char lexbuf with
- '\'' -> action_36 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_15 lexbuf =
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_16 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_16 lexbuf =
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_17 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_17 lexbuf =
- match lexing.next_char lexbuf with
- '\'' -> action_37 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_24 lexbuf =
- Lexing.set_backtrack lexbuf action_34;
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_27 lexbuf
- | 't'|'r'|'n'|'b'|'\\'|'"' -> action_31 lexbuf
- | ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_25 lexbuf =
- Lexing.set_backtrack lexbuf action_30;
- match lexing.next_char lexbuf with
- ' '|'\026'|'\013'|'\012'|'\n'|'\t' -> state_25 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_27 lexbuf =
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> state_28 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_28 lexbuf =
- match lexing.next_char lexbuf with
- '9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0' -> action_32 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_34 lexbuf =
- Lexing.set_backtrack lexbuf action_28;
- match lexing.next_char lexbuf with
- '*' -> action_26 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_40 lexbuf =
- Lexing.set_backtrack lexbuf action_0;
- match lexing.next_char lexbuf with
- ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_43 lexbuf =
- Lexing.set_backtrack lexbuf action_16;
- match lexing.next_char lexbuf with
- '*' -> action_1 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_48 lexbuf =
- Lexing.set_backtrack lexbuf action_21;
- match lexing.next_char lexbuf with
- ';' -> action_7 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_51 lexbuf =
- Lexing.set_backtrack lexbuf action_2;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | '_' -> state_60 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_55 lexbuf =
- Lexing.set_backtrack lexbuf action_9;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_56 lexbuf =
- Lexing.set_backtrack lexbuf action_2;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | 'o' -> state_61 lexbuf
- | '_' -> state_60 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_59 lexbuf =
- Lexing.set_backtrack lexbuf action_2;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | '_' -> state_60 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_60 lexbuf =
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_61 lexbuf =
- Lexing.set_backtrack lexbuf action_2;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | 'f' -> state_62 lexbuf
- | '_' -> state_60 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_62 lexbuf =
- Lexing.set_backtrack lexbuf action_2;
- match lexing.next_char lexbuf with
- 'z'|'y'|'x'|'w'|'v'|'u'|'t'|'s'|'r'|'q'|'p'|'o'|'n'|'m'|'l'|'k'|'j'|'i'|'h'|'g'|'f'|'e'|'d'|'c'|'b'|'a'|'Z'|'Y'|'X'|'W'|'V'|'U'|'T'|'S'|'R'|'Q'|'P'|'O'|'N'|'M'|'L'|'K'|'J'|'I'|'H'|'G'|'F'|'E'|'D'|'C'|'B'|'A'|'9'|'8'|'7'|'6'|'5'|'4'|'3'|'2'|'1'|'0'|'\'' -> state_59 lexbuf
- | '_' -> state_60 lexbuf
- | _ -> lexing.backtrack lexbuf
-and state_65 lexbuf =
- Lexing.set_backtrack lexbuf action_0;
- match lexing.next_char lexbuf with
- ' '|'\013'|'\n'|'\t' -> state_65 lexbuf
- | _ -> lexing.backtrack lexbuf
-and main lexbuf =
- Lexing.init lexbuf;
- state_0 lexbuf
-
-and action lexbuf =
- Lexing.init lexbuf;
- state_1 lexbuf
-
-and string lexbuf =
- Lexing.init lexbuf;
- state_2 lexbuf
-
-and char lexbuf =
- Lexing.init lexbuf;
- state_3 lexbuf
-
-and comment lexbuf =
- Lexing.init lexbuf;
- state_4 lexbuf
+++ /dev/null
-(* Generating a DFA as a set of mutually recursive functions *)
-
-open Syntax
-
-let ic = ref stdin
-let oc = ref stdout
-
-(* 1- Generating the actions *)
-
-let copy_buffer = Bytes.create 1024
-
-let copy_chunk (Location(start,stop)) =
- seek_in !ic start;
- let tocopy = ref(stop - start) in
- while !tocopy > 0 do
- let m =
- input !ic copy_buffer 0 (min !tocopy (Bytes.length copy_buffer)) in
- output !oc copy_buffer 0 m;
- tocopy := !tocopy - m
- done
-
-
-let output_action (i,act) =
- output_string !oc ("action_" ^ Int.to_string i ^ " lexbuf = (\n");
- copy_chunk act;
- output_string !oc ")\nand "
-
-
-(* 2- Generating the states *)
-
-let states = ref ([||] : automata array)
-
-type occurrence =
- { mutable pos: int list;
- mutable freq: int }
-
-let enumerate_vect v =
- let env = ref [] in
- for pos = 0 to Array.length v - 1 do
- try
- let occ = List.assoc v.(pos) !env in
- occ.pos <- pos :: occ.pos;
- occ.freq <- occ.freq + 1
- with Not_found ->
- env := (v.(pos), {pos = [pos]; freq = 1 }) :: !env
- done;
- List.sort (fun (e1, occ1) (e2, occ2) -> compare occ2.freq occ1.freq) !env
-
-
-let output_move = function
- Backtrack ->
- output_string !oc "lexing.backtrack lexbuf"
- | Goto dest ->
- match !states.(dest) with
- Perform act_num ->
- output_string !oc ("action_" ^ Int.to_string act_num ^ " lexbuf")
- | _ ->
- output_string !oc ("state_" ^ Int.to_string dest ^ " lexbuf")
-
-
-(* Cannot use standard char_for_read because the characters to escape
- are not the same in CL6 and CL1999. *)
-
-let output_char_lit oc = function
- '\'' -> output_string oc "\\'"
- | '\\' -> output_string oc "\\\\"
- | '\n' -> output_string oc "\\n"
- | '\t' -> output_string oc "\\t"
- | c -> if Char.code c >= 32 && Char.code c < 128 then
- output_char oc c
- else begin
- let n = Char.code c in
- output_char oc '\\';
- output_char oc (Char.chr (48 + n / 100));
- output_char oc (Char.chr (48 + (n / 10) mod 10));
- output_char oc (Char.chr (48 + n mod 10))
- end
-
-let rec output_chars = function
- [] ->
- failwith "output_chars"
- | [c] ->
- output_string !oc "'";
- output_char_lit !oc (Char.chr c);
- output_string !oc "'"
- | c::cl ->
- output_string !oc "'";
- output_char_lit !oc (Char.chr c);
- output_string !oc "'|";
- output_chars cl
-
-let output_one_trans (dest, occ) =
- output_chars occ.pos;
- output_string !oc " -> ";
- output_move dest;
- output_string !oc "\n | "
-
-let output_all_trans trans =
- output_string !oc " match lexing.next_char lexbuf with\n ";
- match enumerate_vect trans with
- [] ->
- failwith "output_all_trans"
- | (default, _) :: rest ->
- List.iter output_one_trans rest;
- output_string !oc "_ -> ";
- output_move default;
- output_string !oc "\nand "
-
-let output_state state_num = function
- Perform i ->
- ()
- | Shift(what_to_do, moves) ->
- output_string !oc
- ("state_" ^ Int.to_string state_num ^ " lexbuf =\n");
- begin match what_to_do with
- No_remember -> ()
- | Remember i ->
- output_string !oc
- (" Lexing.set_backtrack lexbuf action_" ^
- Int.to_string i ^ ";\n")
- end;
- output_all_trans moves
-
-
-(* 3- Generating the entry points *)
-
-let rec output_entries = function
- [] -> failwith "output_entries"
- | (name,state_num) :: rest ->
- output_string !oc (name ^ " lexbuf =\n");
- output_string !oc " Lexing.init lexbuf;\n";
- output_string !oc (" state_" ^ Int.to_string state_num ^
- " lexbuf\n");
- match rest with
- [] -> ()
- | _ -> output_string !oc "\nand "; output_entries rest
-
-
-(* All together *)
-
-let output_lexdef header (initial_st, st, actions) =
- print_int (Array.length st); print_string " states, ";
- print_int (List.length actions); print_string " actions.";
- print_newline();
- copy_chunk header;
- output_string !oc "\nlet rec ";
- states := st;
- List.iter output_action actions;
- for i = 0 to Array.length st - 1 do
- output_state i st.(i)
- done;
- output_entries initial_st
+++ /dev/null
-(* Auxiliaries for the lexical analyzer *)
-
-let brace_depth = ref 0
-let comment_depth = ref 0
-
-exception Lexical_error of string
-
-let initial_string_buffer = Bytes.create 256
-let string_buff = ref initial_string_buffer
-let string_index = ref 0
-
-let reset_string_buffer () =
- string_buff := initial_string_buffer;
- string_index := 0
-
-
-let store_string_char c =
- begin
- if !string_index >= Bytes.length !string_buff then begin
- let new_buff = Bytes.create (Bytes.length !string_buff * 2) in
- Bytes.blit new_buff 0 !string_buff 0 (Bytes.length !string_buff);
- string_buff := new_buff
- end
- end;
- Bytes.unsafe_set !string_buff !string_index c;
- incr string_index
-
-let get_stored_string () =
- let s = Bytes.sub_string !string_buff 0 !string_index in
- string_buff := initial_string_buffer;
- s
-
-
-let char_for_backslash = function
- 'n' -> '\010' (* '\n' when bootstrapped *)
- | 't' -> '\009' (* '\t' *)
- | 'b' -> '\008' (* '\b' *)
- | 'r' -> '\013' (* '\r' *)
- | c -> c
-
-
-let char_for_decimal_code lexbuf i =
- Char.chr(100 * (Char.code(Lexing.lexeme_char lexbuf i) - 48) +
- 10 * (Char.code(Lexing.lexeme_char lexbuf (i+1)) - 48) +
- (Char.code(Lexing.lexeme_char lexbuf (i+2)) - 48))
+++ /dev/null
-(* The lexical analyzer for lexer definitions. *)
-
-{
-open Syntax
-open Grammar
-open Scan_aux
-}
-
-rule main = parse
- [' ' '\010' '\013' '\009' ] +
- { main lexbuf }
- | "(*"
- { comment_depth := 1;
- comment lexbuf;
- main lexbuf }
- | (['A'-'Z' 'a'-'z'] | '_' ['A'-'Z' 'a'-'z' '\'' '0'-'9'])
- ( '_' ? ['A'-'Z' 'a'-'z' ''' '0'-'9'] ) *
- { match Lexing.lexeme lexbuf with
- "rule" -> Trule
- | "parse" -> Tparse
- | "and" -> Tand
- | "eof" -> Teof
- | s -> Tident s }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- Tstring(get_stored_string()) }
- | "'"
- { Tchar(char lexbuf) }
- | '{'
- { let n1 = Lexing.lexeme_end lexbuf in
- brace_depth := 1;
- let n2 = action lexbuf in
- Taction(Location(n1, n2)) }
- | '=' { Tequal }
- | ";;" { Tend }
- | '|' { Tor }
- | '_' { Tunderscore }
- | "eof" { Teof }
- | '[' { Tlbracket }
- | ']' { Trbracket }
- | '*' { Tstar }
- | '?' { Tmaybe }
- | '+' { Tplus }
- | '(' { Tlparen }
- | ')' { Trparen }
- | '^' { Tcaret }
- | '-' { Tdash }
- | eof
- { raise(Lexical_error "unterminated lexer definition") }
- | _
- { raise(Lexical_error("illegal character " ^ Lexing.lexeme lexbuf)) }
-
-and action = parse
- '{'
- { incr brace_depth;
- action lexbuf }
- | '}'
- { decr brace_depth;
- if !brace_depth = 0 then Lexing.lexeme_start lexbuf else action lexbuf }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- action lexbuf }
- | '\''
- { let _ = char lexbuf in action lexbuf }
- | "(*"
- { comment_depth := 1;
- comment lexbuf;
- action lexbuf }
- | eof
- { raise (Lexical_error "unterminated action") }
- | _
- { action lexbuf }
-
-and string = parse
- '"'
- { () }
- | '\\' [' ' '\010' '\013' '\009' '\026' '\012'] +
- { string lexbuf }
- | '\\' ['\\' '"' 'n' 't' 'b' 'r']
- { store_string_char(char_for_backslash(Lexing.lexeme_char lexbuf 1));
- string lexbuf }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9']
- { store_string_char(char_for_decimal_code lexbuf 1);
- string lexbuf }
- | eof
- { raise(Lexical_error "unterminated string") }
- | _
- { store_string_char(Lexing.lexeme_char lexbuf 0);
- string lexbuf }
-
-and char = parse
- [^ '\\'] "'"
- { Lexing.lexeme_char lexbuf 0 }
- | '\\' ['\\' '\'' 'n' 't' 'b' 'r'] "'"
- { char_for_backslash (Lexing.lexeme_char lexbuf 1) }
- | '\\' ['0'-'9'] ['0'-'9'] ['0'-'9'] "'"
- { char_for_decimal_code lexbuf 1 }
- | _
- { raise(Lexical_error "bad character constant") }
-
-and comment = parse
- "(*"
- { incr comment_depth; comment lexbuf }
- | "*)"
- { decr comment_depth;
- if !comment_depth = 0 then () else comment lexbuf }
- | '"'
- { reset_string_buffer();
- string lexbuf;
- reset_string_buffer();
- comment lexbuf }
- | eof
- { raise(Lexical_error "unterminated comment") }
- | _
- { comment lexbuf }
+++ /dev/null
-(* The shallow abstract syntax *)
-
-type location =
- Location of int * int
-
-type regular_expression =
- Epsilon
- | Characters of char list
- | Sequence of regular_expression * regular_expression
- | Alternative of regular_expression * regular_expression
- | Repetition of regular_expression
-
-type lexer_definition =
- Lexdef of location * (string * (regular_expression * location) list) list
-
-(* Representation of automata *)
-
-type automata =
- Perform of int
- | Shift of automata_trans * automata_move array
-and automata_trans =
- No_remember
- | Remember of int
-and automata_move =
- Backtrack
- | Goto of int
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
ocaml_exit_status = "2"
* setup-ocaml-build-env
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
(* TEST
include tool-ocaml-lib
-flags = "-w a"
+flags = "-w -a"
ocaml_script_as_argument = "true"
* setup-ocaml-build-env
** ocaml
compiler_output = "compiler-output.raw"
** ocamlc.byte
all_modules = "test.ml"
-flags = "-warn-error A"
+flags = "-warn-error +A"
ocamlc_byte_exit_status = "2"
*** script
script = "sh ${test_source_directory}/check-error-cleanup.sh"
(* Regression test for MPR#7918 *)
let f () =
- (* -warn-error A will error with unused x below *)
+ (* -warn-error +A will error with unused x below *)
let x = 12 in
1
(* TEST
-files = "a.ml b.ml"
+readonly_files = "a.ml b.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "a.ml"
clean:
rm -f *.cm* lib.ml
-.SUFFIXES: .ml .cmo .cmx
-
-.ml.cmo:
+%.cmo: %.ml
$(OCAMLC) -c $<
-.ml.cmx:
+%.cmx: %.ml
$(OCAMLOPT) -c $<
clean:
rm -f *.cm* lib.ml
-.SUFFIXES: .ml .cmo .cmx
-
-.ml.cmo:
+%.cmo: %.ml
$(OCAMLC) -no-alias-deps -c $<
-.ml.cmx:
+%.cmx: %.ml
$(OCAMLOPT) -no-alias-deps -c $<
(* TEST
-files = "A.ml B.ml C.ml D.ml lib_impl.ml lib.mli"
+readonly_files = "A.ml B.ml C.ml D.ml lib_impl.ml lib.mli \
+ Makefile.build Makefile.build2"
-script = "sh ${test_source_directory}/setup-links.sh"
set sources = "A.ml B.ml C.ml D.ml"
set links = "LibA.ml LibB.ml LibC.ml LibD.ml"
set stdlib = "-nostdlib -I ${ocamlsrcdir}/stdlib"
* setup-ocamlc.byte-build-env
compiler_directory_suffix = ".depend.mk"
compiler_output = "${test_build_directory}/depend.mk"
-** script
-*** script
-script = "cp lib_impl.ml lib.ml"
-**** ocamlc.byte
+** copy
+src = "A.ml"
+dst = "LibA.ml"
+*** copy
+src = "B.ml"
+dst = "LibB.ml"
+**** copy
+src = "C.ml"
+dst = "LibC.ml"
+***** copy
+src = "D.ml"
+dst = "LibD.ml"
+****** copy
+src = "lib_impl.ml"
+dst = "lib.ml"
+******* ocamlc.byte
commandline = "-depend -as-map lib.ml lib.mli"
-***** ocamlc.byte
+******** ocamlc.byte
commandline = "-depend -map lib.ml -open Lib ${links}"
-****** check-ocamlc.byte-output
+********* check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/depend.mk.reference"
-******* hasunix
-******** script
-script = "cp ${test_source_directory}/Makefile.build Makefile"
-********* script
+********** hasunix
+*********** script
script = "rm -f ${links}"
-********** script
-script = "${MAKE} byte"
-*********** native-compiler
************ script
-script = "${MAKE} opt"
+script = "${MAKE} -f Makefile.build byte"
+************* native-compiler
+************** script
+script = "${MAKE} -f Makefile.build opt"
* setup-ocamlc.byte-build-env
compiler_directory_suffix = ".depend.mk2"
compiler_output = "${test_build_directory}/depend.mk2"
-** script
-*** ocamlc.byte
+** copy
+src = "A.ml"
+dst = "LibA.ml"
+*** copy
+src = "B.ml"
+dst = "LibB.ml"
+**** copy
+src = "C.ml"
+dst = "LibC.ml"
+***** copy
+src = "D.ml"
+dst = "LibD.ml"
+****** ocamlc.byte
commandline = "-depend -map lib.mli -open Lib ${links}"
-**** check-ocamlc.byte-output
+******* check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/depend.mk2.reference"
-***** hasunix
-****** script
+******** hasunix
+********* script
script = "rm -f ${links}"
-******* script
-script = "cp ${test_source_directory}/Makefile.build2 Makefile"
-******** script
-script = "${MAKE} byte"
-********* native-compiler
********** script
-script = "${MAKE} opt"
+script = "${MAKE} -f Makefile.build2 byte"
+*********** native-compiler
+************ script
+script = "${MAKE} -f Makefile.build2 opt"
* setup-ocamlc.byte-build-env
compiler_directory_suffix = ".depend.mod"
-** script
-*** script
-script = "cp lib_impl.ml lib.ml"
-**** ocamlc.byte
+** copy
+src = "A.ml"
+dst = "LibA.ml"
+*** copy
+src = "B.ml"
+dst = "LibB.ml"
+**** copy
+src = "C.ml"
+dst = "LibC.ml"
+***** copy
+src = "D.ml"
+dst = "LibD.ml"
+****** copy
+src = "lib_impl.ml"
+dst = "lib.ml"
+******* ocamlc.byte
commandline = "-depend -as-map -modules lib.ml lib.mli"
-***** ocamlc.byte
+******** ocamlc.byte
commandline = "-depend -modules -map lib.ml -open Lib ${links}"
-****** check-ocamlc.byte-output
+********* check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/depend.mod.reference"
* setup-ocamlc.byte-build-env
compiler_directory_suffix = ".depend.mod2"
-** script
-*** ocamlc.byte
+** copy
+src = "A.ml"
+dst = "LibA.ml"
+*** copy
+src = "B.ml"
+dst = "LibB.ml"
+**** copy
+src = "C.ml"
+dst = "LibC.ml"
+***** copy
+src = "D.ml"
+dst = "LibD.ml"
+****** ocamlc.byte
commandline = "-depend -modules -map lib.mli ${links}"
-**** check-ocamlc.byte-output
+******* check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/depend.mod2.reference"
* setup-ocamlc.byte-build-env
compiler_directory_suffix = ".depend.mod3"
-** script
-*** ocamlc.byte
+** copy
+src = "A.ml"
+dst = "LibA.ml"
+*** copy
+src = "B.ml"
+dst = "LibB.ml"
+**** copy
+src = "C.ml"
+dst = "LibC.ml"
+***** copy
+src = "D.ml"
+dst = "LibD.ml"
+****** ocamlc.byte
commandline = "-depend -modules -as-map -map lib.mli -open Lib ${links}"
-**** check-ocamlc.byte-output
+******* check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/depend.mod3.reference"
*)
+++ /dev/null
-#!/bin/sh
-for i in A B C D; do cp $i.ml Lib$i.ml; done
(* TEST
+subdirectories = "dir1 dir2"
+
* setup-ocamlc.byte-build-env
-** script
-script = "cp -R ${test_source_directory}/dir1 ${test_source_directory}/dir2 ."
-*** ocamlc.byte
+** ocamlc.byte
commandline = "-depend -slash -I dir1 -I dir2 a.ml"
-**** check-ocamlc.byte-output
+*** check-ocamlc.byte-output
compiler_reference = "${test_source_directory}/a.reference"
*)
<pre><span id="VALheterological"><span class="keyword">val</span> heterological</span> : <code class="type">unit</code></pre><div class="info ">
<div class="info-deprecated">
-<span class="warning">Deprecated.</span>since the start of time</div>
+<span class="warning">Deprecated. </span>since the start of time</div>
<ul class="info-attributes">
<li><b>Author(s):</b> yes</li>
<li><b>Before Time </b> not implemented</li>
--- /dev/null
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta name="viewport" content="width=device-width, initial-scale=1">
+<link rel="Start" href="index.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Entities" rel="Chapter" href="Entities.html"><title>Entities</title>
+</head>
+<body>
+<div class="navbar"> <a class="up" href="index.html" title="Index">Up</a>
+ </div>
+<h1>Module <a href="type_Entities.html">Entities</a></h1>
+
+<pre><span id="MODULEEntities"><span class="keyword">module</span> Entities</span>: <code class="code"><span class="keyword">sig</span></code> <a href="Entities.html">..</a> <code class="code"><span class="keyword">end</span></code></pre><hr width="100%">
+
+<pre><span id="TYPEul"><span class="keyword">type</span> <code class="type"></code>ul</span> </pre>
+
+
+<pre><span id="TYPEli"><span class="keyword">type</span> <code class="type"></code>li</span> </pre>
+
+
+<pre><span id="TYPEamp"><span class="keyword">type</span> <code class="type"></code>amp</span> </pre>
+
+
+<pre><span id="TYPEt"><span class="keyword">type</span> <code class="type">[< `A of & <a href="Entities.html#TYPEamp">amp</a> ]</code> t</span> = <</pre><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code> </code></td>
+<td align="left" valign="top" >
+<code><span id="TYPEELTt.ul">ul</span> : <code class="type">< li : [< `A of & <a href="Entities.html#TYPEamp">amp</a> ] as 'a ></code>;</code></td>
+
+</tr></table>
+>
+ </pre>
+
+</body></html>
--- /dev/null
+(* TEST
+ * ocamldoc with html
+*)
+
+type ul
+type li
+type amp
+type 'a t = <ul: <li:[<`A of &] as 'a> >
<td align="left" valign="top" >
<code> </code></td>
<td align="left" valign="top" >
-<code><span id="TYPEELTInline_records.F.even_more">even_more</span> : <code class="type">int -> int</code>;</code></td>
+<code><span id="TYPEELTInline_records.F.even_more">even_more</span> : <code class="type">int -> int</code>;</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
<p>Some field documentations for <code class="code"><span class="constructor">F</span></code></p>
<td align="left" valign="top" >
<code> </code></td>
<td align="left" valign="top" >
-<code><span id="TYPEELTInline_records.G.last">last</span> : <code class="type">int -> int</code>;</code></td>
+<code><span id="TYPEELTInline_records.G.last">last</span> : <code class="type">int -> int</code>;</code></td>
<td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
<div class="info-desc">
<p>The last and least field documentation</p>
<pre><span id="TYPEt"><span class="keyword">type</span> <code class="type"></code>t</span> = <code class="type">int</code> </pre>
-<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -> 'a -> int</code></pre></div>
+<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -> 'a -> int</code></pre></div>
<pre><code class="code"><span class="keyword">end</span></code><code class="code">)</code></pre></body></html>
flags = "-S start_from_emit.cmir-linear -save-ir-after scheduling"
module = "empty.ml"
ocamlopt_byte_exit_status = "0"
- ********* script
- script = "cp start_from_emit.cmir-linear expected.cmir_linear"
+ ********* copy
+ src = "start_from_emit.cmir-linear"
+ dst = "expected.cmir_linear"
********** check-ocamlopt.byte-output
*********** script
script = "cmp start_from_emit.cmir-linear expected.cmir_linear"
(* TEST
-files = "first_arg_fail.txt last_arg_fail.txt"
+readonly_files = "first_arg_fail.txt last_arg_fail.txt"
* setup-ocaml-build-env
(* TEST
- files = "error_highlighting_use1.ml \
- error_highlighting_use2.ml \
- error_highlighting_use3.ml \
- error_highlighting_use4.ml"
+ readonly_files = "error_highlighting_use1.ml \
+ error_highlighting_use2.ml \
+ error_highlighting_use3.ml \
+ error_highlighting_use4.ml"
* toplevel
*)
type t = T of t
|}]
#show t;;
-(* this output is INCORRECT, it should not use nonrec *)
+(* this output is CORRECT, it should not use nonrec *)
[%%expect{|
-type nonrec t = T of t
+type t = T of t
|}];;
type nonrec s = Foo of t;;
type nonrec s = Foo of t
|}];;
#show s;;
-(* this output is CORRECT, it uses nonrec *)
+(* this output is CORRECT, it elides the unnecessary nonrec keyword *)
[%%expect{|
-type nonrec s = Foo of t
+type s = Foo of t
|}];;
module M : sig type t val x : t end
|}];;
(* this output is CORRECT, it does not use 'rec' *)
-[%%expect{|
-|}];;
module rec M : sig type t val x : M.t end = struct type t = int let x = 0 end;;
-(* this output is strange, it is surprising to use M/2 here. *)
+(* this output is CORRECT . *)
[%%expect{|
-module rec M : sig type t val x : M/2.t end
+module rec M : sig type t val x : M.t end
|}];;
#show_module M;;
-(* this output is INCORRECT, it should use 'rec' *)
+(* this output is CORRECT *)
+[%%expect{|
+module rec M : sig type t val x : M.t end
+|}];;
+
+
+(* Indirect recursion *)
+
+type t
+type f = [ `A of t ]
+type t = X of u | Y of [ f | `B ] and u = Y of t;;
+
+[%%expect{|
+type t
+type f = [ `A of t ]
+type t = X of u | Y of [ `A of t/1 | `B ]
+and u = Y of t/2
+|}];;
+
+#show t;;
+(* this output is PARTIAL: t is mutually recursive with u *)
+[%%expect{|
+type nonrec t = X of u | Y of [ `A of t/2 | `B ]
+|}];;
+
+
+module rec M: sig type t = X of N.t end = M
+and N: sig type t = X of M.t end = N
+
+[%%expect{|
+module rec M : sig type t = X of N.t end
+and N : sig type t = X of M.t end
+|}];;
+
+(* this output is PARTIAL: M is mutually recursive with N *)
+#show M;;
[%%expect{|
-module M : sig type t val x : M.t end
+module M : sig type t = X of N.t end
|}];;
(* TEST
- files = "mod.ml"
+ readonly_files = "mod.ml"
* expect
*)
Exception: Not_found.
Raised at f in file "//toplevel//", line 2, characters 11-26
Called from g in file "//toplevel//", line 1, characters 11-15
-Called from Stdlib__fun.protect in file "fun.ml", line 33, characters 8-15
-Re-raised at Stdlib__fun.protect in file "fun.ml", line 38, characters 6-52
-Called from Toploop.load_lambda in file "toplevel/toploop.ml", line 212, characters 4-150
+Called from Stdlib__Fun.protect in file "fun.ml", line 33, characters 8-15
+Re-raised at Stdlib__Fun.protect in file "fun.ml", line 38, characters 6-52
+Called from Topeval.load_lambda in file "toplevel/byte/topeval.ml", line 89, characters 4-150
#show option;;
[%%expect {|
-type nonrec 'a option = None | Some of 'a
+type 'a option = None | Some of 'a
|}];;
#show Open_binary;;
#show open_flag;;
[%%expect {|
-type nonrec open_flag =
+type open_flag =
Open_rdonly
| Open_wronly
| Open_append
#show extensible;;
[%%expect {|
-type nonrec extensible = ..
+type extensible = ..
|}];;
type 'a t = ..;;
#show list;;
[%%expect {|
-type nonrec 'a list = [] | (::) of 'a * 'a list
+type 'a list = [] | (::) of 'a * 'a list
|}];;
type 'a t;;
#show t;;
[%%expect {|
type 'a t
-type nonrec 'a t
+type 'a t
|}];;
(function f param (apply f (field 0 param) (field 1 param)))
map =
(function f l
- (apply (field 18 (global Stdlib__list!)) (apply uncurry f) l)))
+ (apply (field 18 (global Stdlib__List!)) (apply uncurry f) l)))
(makeblock 0
(makeblock 0 (apply map gen_cmp vec) (apply map cmp vec))
(apply map
(apply f (field 0 param) (field 1 param)))
map =
(function f l
- (apply (field 18 (global Stdlib__list!))
+ (apply (field 18 (global Stdlib__List!))
(apply uncurry f) l)))
(makeblock 0
(makeblock 0 (apply map eta_gen_cmp vec)
--- /dev/null
+(* TEST *)
+
+(* Example from PR #10325.
+ This triggered a segfault in bytecode, but only if the code was not compiled
+ in debug mode (the offending code is actually in camlinternalOO.ml, and is
+ used only when optimising).
+ *)
+
+let x = object method g = "abc" end
+let s = (object method f = x#g end)#f
+let () = prerr_endline s
^^^^
Error: This variant expression is expected to have type unit
because it is in the result of a conditional with no else branch
- The constructor :: does not belong to type unit
+ There is no constructor :: within type unit
|}];;
(function
^^^^
Error: This variant expression is expected to have type unit
because it is in the result of a conditional with no else branch
- The constructor true does not belong to type unit
+ There is no constructor true within type unit
|}]
1 | let x: t = Alph;;
^^^^
Error: This variant expression is expected to have type t
- The constructor Alph does not belong to type t
+ There is no constructor Alph within type t
Hint: Did you mean Aleph or Alpha?
|}]
2 | let y : w = Alha;;
^^^^
Error: This variant expression is expected to have type M.w
- The constructor Alha does not belong to type M.w
+ There is no constructor Alha within type M.w
Hint: Did you mean Alpha?
|}]
1 | let z: t = Bet;;
^^^
Error: This variant expression is expected to have type t
- The constructor Bet does not belong to type t
+ There is no constructor Bet within type t
Hint: Did you mean Beth?
|}]
3 | let g = (Gamm:t);;
^^^^
Error: This variant expression is expected to have type t
- The constructor Gamm does not belong to type t
+ There is no constructor Gamm within type t
Hint: Did you mean Gamma?
|}];;
1 | raise Not_Found;;
^^^^^^^^^
Error: This variant expression is expected to have type exn
- The constructor Not_Found does not belong to type exn
+ There is no constructor Not_Found within type exn
Hint: Did you mean Not_found?
|}]
7 | let x: P.p = Alha;;
^^^^
Error: This variant expression is expected to have type P.p
- The constructor Alha does not belong to type x
+ There is no constructor Alha within type x
Hint: Did you mean Alpha?
|}]
3 | let y: N.s = T ;;
^
Error: This variant expression is expected to have type N.s
- The constructor T does not belong to type M.t
+ There is no constructor T within type M.t
|}]
(** Pattern matching *)
3 | raise Locl;;
^^^^
Error: This variant expression is expected to have type exn
- The constructor Locl does not belong to type exn
+ There is no constructor Locl within type exn
Hint: Did you mean Local?
|}]
(* TEST
- flags = "-w A -warn-error A"
+ flags = "-w +A-70 -warn-error +A"
*)
(* Example of algorithm parametrized with modules *)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type (_,_) eq = Refl : ('a,'a) eq;;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+|}]
+
+(* Both should fail *)
+let f (type a b) (w1 : (a, b -> b) eq) (w2 : (a, int -> int) eq) (g : a) =
+ let Refl = w1 in let Refl = w2 in g 3;;
+[%%expect{|
+Line 2, characters 37-40:
+2 | let Refl = w1 in let Refl = w2 in g 3;;
+ ^^^
+Error: This expression has type b = int
+ but an expression was expected of type 'a
+ This instance of int is ambiguous:
+ it would escape the scope of its equation
+|}]
+let f (type a b) (w1 : (a, b -> b) eq) (w2 : (a, int -> int) eq) (g : a) =
+ let Refl = w2 in let Refl = w1 in g 3;;
+[%%expect{|
+val f : ('a, 'b -> 'b) eq -> ('a, int -> int) eq -> 'a -> int = <fun>
+|}, Principal{|
+Line 2, characters 37-40:
+2 | let Refl = w2 in let Refl = w1 in g 3;;
+ ^^^
+Error: This expression has type int but an expression was expected of type 'a
+ This instance of int is ambiguous:
+ it would escape the scope of its equation
+|}]
+
+(* Ok *)
+let f (type a b) (w1 : (a, b -> b) eq) (w2 : (a, int -> int) eq) (g : a) : b =
+ let Refl = w2 in let Refl = w1 in g 3;;
+[%%expect{|
+val f : ('a, 'b -> 'b) eq -> ('a, int -> int) eq -> 'a -> 'b = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M : sig
+ type t
+ val x : t
+ val print : t -> unit
+end = struct
+ type t = string
+ let x = "hello"
+ let print = print_endline
+end
+
+type _ g = I : int g
+[%%expect{|
+module M : sig type t val x : t val print : t -> unit end
+type _ g = I : int g
+|}]
+
+let g (x : M.t) =
+ match x with I -> M.print I
+let () = g M.x
+[%%expect{|
+Line 2, characters 15-16:
+2 | match x with I -> M.print I
+ ^
+Error: This pattern matches values of type 'a g
+ but a pattern was expected which matches values of type M.t
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type _ ty = Int : int ty
+type dyn = Dyn : 'a ty * 'a -> dyn
+[%%expect{|
+type _ ty = Int : int ty
+type dyn = Dyn : 'a ty * 'a -> dyn
+|}]
+
+let ok1 = function Dyn (type a) (w, x : a ty * a) -> ignore (x : a)
+let ok2 = function Dyn (type a) (w, x : _ * a) -> ignore (x : a)
+[%%expect{|
+val ok1 : dyn -> unit = <fun>
+val ok2 : dyn -> unit = <fun>
+|}]
+
+let ko1 = function Dyn (type a) (w, x) -> ()
+[%%expect{|
+Line 1, characters 32-38:
+1 | let ko1 = function Dyn (type a) (w, x) -> ()
+ ^^^^^^
+Error: Existential types introduced in a constructor pattern
+ must be bound by a type constraint on the argument.
+|}]
+let ko1 = function Dyn (type a) (w, x : _) -> ()
+[%%expect{|
+Line 1, characters 40-41:
+1 | let ko1 = function Dyn (type a) (w, x : _) -> ()
+ ^
+Error: This type does not bind all existentials in the constructor:
+ type a. 'a ty * 'a
+|}]
+let ko2 = function Dyn (type a b) (a, x : a ty * b) -> ignore (x : b)
+[%%expect{|
+Line 1, characters 42-50:
+1 | let ko2 = function Dyn (type a b) (a, x : a ty * b) -> ignore (x : b)
+ ^^^^^^^^
+Error: This pattern matches values of type a ty * b
+ but a pattern was expected which matches values of type a ty * a
+ Type b is not compatible with type a
+|}]
+
+type u = C : 'a * ('a -> 'b list) -> u
+let f = function C (type a b) (x, f : _ * (a -> b list)) -> ignore (x : a)
+[%%expect{|
+type u = C : 'a * ('a -> 'b list) -> u
+val f : u -> unit = <fun>
+|}]
+
+let f = function C (type a) (x, f : a * (a -> a list)) -> ignore (x : a)
+[%%expect{|
+Line 1, characters 36-53:
+1 | let f = function C (type a) (x, f : a * (a -> a list)) -> ignore (x : a)
+ ^^^^^^^^^^^^^^^^^
+Error: This type does not bind all existentials in the constructor:
+ type a. a * (a -> a list)
+|}]
+
+(* with GADT unification *)
+type _ expr =
+ | Int : int -> int expr
+ | Add : (int -> int -> int) expr
+ | App : ('a -> 'b) expr * 'a expr -> 'b expr
+
+let rec eval : type t. t expr -> t = function
+ Int n -> n
+ | Add -> (+)
+ | App (type a) (f, x : _ * a expr) -> eval f (eval x : a)
+[%%expect{|
+type _ expr =
+ Int : int -> int expr
+ | Add : (int -> int -> int) expr
+ | App : ('a -> 'b) expr * 'a expr -> 'b expr
+val eval : 't expr -> 't = <fun>
+|}]
+
+let rec test : type a. a expr -> a = function
+ | Int (type b) (n : a) -> n
+ | Add -> (+)
+ | App (type b) (f, x : (b -> a) expr * _) -> test f (test x : b)
+[%%expect{|
+Line 2, characters 22-23:
+2 | | Int (type b) (n : a) -> n
+ ^
+Error: This type does not bind all existentials in the constructor: type b. a
+|}]
+
+(* Strange wildcard *)
+
+[@@@warning "-28"]
+let () =
+ match None with
+ | None (type a) (_ : a * int) -> ()
+ | Some _ -> ()
+[%%expect{|
+Line 4, characters 4-31:
+4 | | None (type a) (_ : a * int) -> ()
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The constructor None expects 0 argument(s),
+ but is applied here to 1 argument(s)
+|}]
+
+let () =
+ match None with
+ | None _ -> ()
+ | Some _ -> ()
+[%%expect{|
+|}]
+
+(* Also allow annotations on multiary constructors *)
+type ('a,'b) pair = Pair of 'a * 'b
+
+let f = function Pair (x, y : int * _) -> x + y
+[%%expect{|
+type ('a, 'b) pair = Pair of 'a * 'b
+val f : (int, int) pair -> int = <fun>
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type i = <m : 'c. 'c -> 'c >
+type ('a, 'b) j = <m : 'c. 'a -> 'b >
+type _ t = A : i t;;
+[%%expect{|
+type i = < m : 'c. 'c -> 'c >
+type ('a, 'b) j = < m : 'a -> 'b >
+type _ t = A : i t
+|}]
+
+let f (type a b) (y : (a, b) j t) : a -> b =
+ let A = y in fun x -> x;;
+[%%expect{|
+Line 2, characters 6-7:
+2 | let A = y in fun x -> x;;
+ ^
+Error: This pattern matches values of type i t
+ but a pattern was expected which matches values of type (a, b) j t
+ Type i = < m : 'c. 'c -> 'c > is not compatible with type
+ (a, b) j = < m : a -> b >
+ The method m has type 'c. 'c -> 'c, but the expected method type was
+ a -> b
+ The universal variable 'c would escape its scope
+|}]
+
+let g (type a b) (y : (a,b) j t option) =
+ let None = y in () ;;
+[%%expect{|
+val g : ('a, 'b) j t option -> unit = <fun>
+|}]
+
+module M = struct
+ type 'a d = D
+ type j = <m : 'c. 'c -> 'c d >
+end ;;
+let g (y : M.j t option) =
+ let None = y in () ;;
+[%%expect{|
+module M : sig type 'a d = D type j = < m : 'c. 'c -> 'c d > end
+val g : M.j t option -> unit = <fun>
+|}]
+
+module M = struct
+ type 'a d
+ type j = <m : 'c. 'c -> 'c d >
+end ;;
+let g (y : M.j t option) =
+ let None = y in () ;;
+[%%expect{|
+module M : sig type 'a d type j = < m : 'c. 'c -> 'c d > end
+Line 6, characters 2-20:
+6 | let None = y in () ;;
+ ^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some A
+val g : M.j t option -> unit = <fun>
+|}]
+
+module M = struct
+ type e
+ type 'a d
+ type i = <m : 'c. 'c -> 'c d >
+ type j = <m : 'c. 'c -> e >
+end ;;
+type _ t = A : M.i t
+let g (y : M.j t option) =
+ let None = y in () ;;
+[%%expect{|
+module M :
+ sig
+ type e
+ type 'a d
+ type i = < m : 'c. 'c -> 'c d >
+ type j = < m : 'c. 'c -> e >
+ end
+type _ t = A : M.i t
+Line 9, characters 2-20:
+9 | let None = y in () ;;
+ ^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some A
+val g : M.j t option -> unit = <fun>
+|}]
+
+module M = struct
+ type 'a d
+ type i = <m : 'c. 'c -> 'c d >
+ type 'a j = <m : 'c. 'c -> 'a >
+end ;;
+type _ t = A : M.i t
+(* Should warn *)
+let g (y : 'a M.j t option) =
+ let None = y in () ;;
+[%%expect{|
+module M :
+ sig
+ type 'a d
+ type i = < m : 'c. 'c -> 'c d >
+ type 'a j = < m : 'c. 'c -> 'a >
+ end
+type _ t = A : M.i t
+Line 9, characters 2-20:
+9 | let None = y in () ;;
+ ^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some A
+val g : 'a M.j t option -> unit = <fun>
+|}, Principal{|
+module M :
+ sig
+ type 'a d
+ type i = < m : 'c. 'c -> 'c d >
+ type 'a j = < m : 'c. 'c -> 'a >
+ end
+type _ t = A : M.i t
+File "_none_", line 1:
+Warning 18 [not-principal]: typing this pattern requires considering $0 and 'c M.d as equal.
+But the knowledge of these types is not principal.
+Line 9, characters 2-20:
+9 | let None = y in () ;;
+ ^^^^^^^^^^^^^^^^^^
+Warning 8 [partial-match]: this pattern-matching is not exhaustive.
+Here is an example of a case that is not matched:
+Some A
+val g : 'a M.j t option -> unit = <fun>
+|}]
+
+(* more examples by @lpw25 *)
+module M = struct
+ type a
+ type i = C of <m : 'c. 'c -> 'c >
+ type j = C of <m : 'c. 'c -> a >
+end
+type _ t = A : M.i t;;
+let f (y : M.j t) = match y with _ -> .;;
+[%%expect{|
+module M :
+ sig
+ type a
+ type i = C of < m : 'c. 'c -> 'c >
+ type j = C of < m : 'c. 'c -> a >
+ end
+type _ t = A : M.i t
+val f : M.j t -> 'a = <fun>
+|}]
+
+module M = struct
+ type a
+ type i = C of <m : 'c. 'c -> 'c -> 'c >
+ type j = C of <m : 'c. 'c -> a >
+end
+type _ t = A : M.i t;;
+let f (y : M.j t) = match y with _ -> .;;
+[%%expect{|
+module M :
+ sig
+ type a
+ type i = C of < m : 'c. 'c -> 'c -> 'c >
+ type j = C of < m : 'c. 'c -> a >
+ end
+type _ t = A : M.i t
+val f : M.j t -> 'a = <fun>
+|}]
+
+module M = struct
+ type 'a a
+ type i = C of <m : 'c. 'c -> 'c -> 'c >
+ type j = C of <m : 'c. 'c -> 'c a >
+end
+type _ t = A : M.i t;;
+let f (y : M.j t) = match y with _ -> .;;
+[%%expect{|
+module M :
+ sig
+ type 'a a
+ type i = C of < m : 'c. 'c -> 'c -> 'c >
+ type j = C of < m : 'c. 'c -> 'c a >
+ end
+type _ t = A : M.i t
+Line 7, characters 33-34:
+7 | let f (y : M.j t) = match y with _ -> .;;
+ ^
+Error: This match case could not be refuted.
+ Here is an example of a value that would reach it: A
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module M = struct
+ type _ rr = Soa : int rr
+ type b = B : 'a rr * 'a -> b
+end
+
+let test =
+ let M.(B (k, v)) = M.(B (Soa, 0)) in
+ match k, v with
+ | M.Soa, soa -> (soa : int)
+[%%expect{|
+module M : sig type _ rr = Soa : int rr type b = B : 'a rr * 'a -> b end
+val test : int = 0
+|}]
+
+let test =
+ let open M in
+ let B (k, v) = B (Soa, 0) in
+ match k, v with
+ | Soa, soa -> (soa : int)
+[%%expect{|
+val test : int = 0
+|}]
+
+type _ ty = Int : int ty
+type dyn = Dyn : 'a ty * 'a -> dyn
+[%%expect{|
+type _ ty = Int : int ty
+type dyn = Dyn : 'a ty * 'a -> dyn
+|}]
+
+let f String.(Dyn (type a) (w, x : a ty * a)) = ignore (x : a)
+[%%expect{|
+val f : dyn -> unit = <fun>
+|}]
[%%expect{|
type 'a t = 'a constraint 'a = [< `Bar | `Foo ]
type 'a s = 'a constraint 'a = [< `Bar | `Baz | `Foo > `Bar ]
-type 'a first = First : 'b t second -> ([< `Bar | `Foo ] as 'b) t first
+type 'a first = First : 'a t second -> ([< `Bar | `Foo ] as 'a) t first
and 'a second = Second : [< `Bar | `Baz | `Foo > `Bar ] s second
type aux = Aux : ([< `Bar | `Foo ] as 'a) t second * ('a -> int) -> aux
val it : [< `Bar | `Foo > `Bar ] = `Bar
^^
Error: This expression has type [< `Bar | `Foo > `Bar ]
but an expression was expected of type [< `Bar | `Foo ]
- The second variant type is bound to $Aux,
+ The second variant type is bound to $Aux_'a,
it may not allow the tag(s) `Bar
|}];;
Line 3, characters 26-31:
3 | | { x = (x : int); eq = Refl3 } -> x
^^^^^
-Warning 18 [not-principal]: typing this pattern requires considering M.t and N.t as equal.
+Warning 18 [not-principal]: typing this pattern requires considering M.t and int as equal.
But the knowledge of these types is not principal.
val foo : int foo -> int = <fun>
|}]
5 | let f = function A -> 1 | B -> 2
^
Error: This variant pattern is expected to have type a
- The constructor B does not belong to type a
+ There is no constructor B within type a
|}];;
module PR6849 = struct
Error: This expression has type < bar : int; foo : int; .. >
but an expression was expected of type 'a
The type constructor $1 would escape its scope
+|}, Principal{|
+Line 3, characters 2-26:
+3 | (x:<foo:int;bar:int;..>)
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This expression has type < bar : int; foo : int; .. >
+ but an expression was expected of type 'a
+ This instance of $1 is ambiguous:
+ it would escape the scope of its equation
|}];;
let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) : t =
;;
[%%expect{|
val g : 't -> 't int_foo -> 't int_bar -> 't * int * int = <fun>
+|}, Principal{|
+Line 3, characters 5-10:
+3 | x, x#foo, x#bar
+ ^^^^^
+Error: This expression has type int but an expression was expected of type 'a
+ This instance of int is ambiguous:
+ it would escape the scope of its equation
|}];;
(* PR#5554 *)
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module PR6505b :
sig
type 'o is_an_object = 'o constraint 'o = [> ]
- type ('a, 'b) abs = 'b constraint 'a = 'b is_an_object
- constraint 'b = [> ]
+ type ('a, 'o) abs = 'o constraint 'a = 'o is_an_object
+ constraint 'o = [> ]
val x : (([> `Foo of int ] as 'a) is_an_object, 'a is_an_object) abs
end
Line 6, characters 23-57:
Exception: Match_failure ("", 6, 23).
|}]
-
(* #9866, #9873 *)
type 'a t = 'b constraint 'a = 'b t;;
1 | type 'a t = <a : 'a; b : 'b> constraint <a : 'a; ..> = 'b t;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: A type variable is unbound in this type declaration.
-In method b: 'b the variable 'b is unbound
+ In method b: 'b the variable 'b is unbound
|}]
module rec M : sig type 'a t = 'b constraint 'a = 'b t end = M;;
type !'a t = 'b constraint 'a = 'b s
end
*)
+
+type 'a t = T
+ constraint 'a = int
+ constraint 'a = float
+[%%expect{|
+Line 3, characters 13-23:
+3 | constraint 'a = float
+ ^^^^^^^^^^
+Error: The type constraints are not consistent.
+ Type int is not compatible with type float
+|}]
+
+type ('a,'b) t = T
+ constraint 'a = int -> float
+ constraint 'b = bool -> char
+ constraint 'a = 'b
+[%%expect{|
+Line 4, characters 13-20:
+4 | constraint 'a = 'b
+ ^^^^^^^
+Error: The type constraints are not consistent.
+ Type int -> float is not compatible with type bool -> char
+ Type int is not compatible with type bool
+|}]
+
+class type ['a, 'b] a = object
+ constraint 'a = 'b
+ constraint 'a = int * int
+ constraint 'b = float * float
+end;;
+[%%expect{|
+Line 4, characters 2-31:
+4 | constraint 'b = float * float
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The class constraints are not consistent.
+ Type int * int is not compatible with type float * float
+ Type int is not compatible with type float
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type ('a, 'b) t constraint 'a = 'b
+[%%expect{|
+type ('b, 'a) t constraint 'a = 'b
+|}]
sig module A : functor (X : s) -> sig end end
In module A:
Modules do not match:
- functor (X : s/1) -> sig end
+ functor (X : s/1) -> ...
is not included in
- functor (X : s/2) -> sig end
- At position module A(X : <here>) : ...
- Modules do not match: s/2 is not included in s/1
+ functor (X : s/2) -> ...
+ Module types do not match:
+ s/1
+ does not include
+ s/2
Line 5, characters 6-19:
Definition of module type s/1
Line 2, characters 2-15:
does not match
class type c = object method m : t/1 end
The method m has type t/2 but is expected to have type t/1
- Type t/2 is not compatible with type t/1 = K.t
+ Type t/2 is not equal to type t/1 = K.t
Line 12, characters 4-10:
Definition of type t/1
Line 9, characters 2-8:
^^^^
Error: This expression has type bool but an expression was expected of type
([< `X of int & 'a ] as 'a) r
- Types for tag `X are incompatible
|}, Principal{|
type 'a r = 'a constraint 'a = [< `X of int & 'a ]
Line 3, characters 35-39:
3 | let f: 'a. 'a r -> 'a r = fun x -> true;;
^^^^
Error: This expression has type bool but an expression was expected of type
- ([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
- Types for tag `X are incompatible
+ ([< `X of 'b & 'a & 'c ] as 'a) r
|}]
let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
^^^^^^^^^^^^^^^^
Error: This expression has type int ref
but an expression was expected of type ([< `X of int & 'a ] as 'a) r
- Types for tag `X are incompatible
|}, Principal{|
Line 1, characters 35-51:
1 | let g: 'a. 'a r -> 'a r = fun x -> { contents = 0 };;
^^^^^^^^^^^^^^^^
Error: This expression has type int ref
but an expression was expected of type
- ([< `X of 'b & 'a & 'c & 'd & 'e ] as 'a) r
- Types for tag `X are incompatible
+ ([< `X of 'b & 'a & 'c ] as 'a) r
|}]
let h: 'a. 'a r -> _ = function true | false -> ();;
Error: This pattern matches values of type bool
but a pattern was expected which matches values of type
([< `X of int & 'a ] as 'a) r
- Types for tag `X are incompatible
|}]
Error: This pattern matches values of type int ref
but a pattern was expected which matches values of type
([< `X of int & 'a ] as 'a) r
- Types for tag `X are incompatible
|}]
(* TEST
-files = "mapping.ml range_intf.ml ranged_intf.ml range.ml ranged.ml"
+readonly_files = "mapping.ml range_intf.ml ranged_intf.ml range.ml ranged.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
flags = "-no-alias-deps -w -49 -o Pr8548__Mapping"
|}]
(* #9739
- Recursive occurence checks are only done on type variables.
+ Recursive occurrence checks are only done on type variables.
However, we are not guaranteed to still have a type variable when printing.
*)
Line 4, characters 7-29:
4 | x |> List.fold_left max 0 x
^^^^^^^^^^^^^^^^^^^^^^
-Error: This expression has type int but an expression was expected of type
- int list -> 'a
+Error: This expression has type int
+ This is not a function; it cannot be applied.
+|}]
+
+
+(* PR#8917
+ In nested recursive definitions, we have to remember all recursive items
+ under definitions, not just the last one
+ *)
+
+module RecMod = struct
+ module A= struct end
+ module type s = sig
+ module rec A: sig type t end
+ and B: sig type t = A.t end
+ end
+end
+[%%expect {|
+module RecMod :
+ sig
+ module A : sig end
+ module type s =
+ sig module rec A : sig type t end and B : sig type t = A.t end end
+ end
|}]
The types are not equal.
|}]
-type unboxed = d = {x:float} [@@unboxed]
+type mono = {foo:int}
+type unboxed = mono = {foo:int} [@@unboxed]
[%%expect{|
-Line 1, characters 0-40:
-1 | type unboxed = d = {x:float} [@@unboxed]
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This variant or record definition does not match that of type d
+type mono = { foo : int; }
+Line 2, characters 0-43:
+2 | type unboxed = mono = {foo:int} [@@unboxed]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type mono
Their internal representations differ:
this definition uses unboxed representation.
|}]
(* TEST
- files="empty_ppx.ml"
+ readonly_files = "empty_ppx.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte with ocamlcommon
all_modules="empty_ppx.ml"
--- /dev/null
+(* TEST
+ * expect
+*)
+
+type synonym = 'a -> 'a
+
+[%%expect{|
+Line 1, characters 15-17:
+1 | type synonym = 'a -> 'a
+ ^^
+Error: The type variable 'a is unbound in this type declaration.
+|}]
+
+type record = { contents: 'a }
+
+[%%expect{|
+Line 1, characters 26-28:
+1 | type record = { contents: 'a }
+ ^^
+Error: The type variable 'a is unbound in this type declaration.
+|}]
+
+type wrapper = Wrapper of 'a
+
+[%%expect{|
+Line 1, characters 26-28:
+1 | type wrapper = Wrapper of 'a
+ ^^
+Error: The type variable 'a is unbound in this type declaration.
+|}]
+
+(* This type secretly has a type variable in it *)
+type polyvariant = [> `C]
+
+[%%expect{|
+Line 1, characters 0-25:
+1 | type polyvariant = [> `C]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type variable is unbound in this type declaration.
+ In type [> `C ] as 'a the variable 'a is unbound
+|}]
+
+type 'a only_one = 'a * 'b
+
+[%%expect{|
+Line 1, characters 24-26:
+1 | type 'a only_one = 'a * 'b
+ ^^
+Error: The type variable 'b is unbound in this type declaration.
+|}]
+
+type extensible = ..
+type extensible += Extension of 'a
+
+[%%expect{|
+type extensible = ..
+Line 2, characters 32-34:
+2 | type extensible += Extension of 'a
+ ^^
+Error: The type variable 'a is unbound in this type declaration.
+|}]
The types are not equal.
|}]
-type unboxed = d = X of float [@@unboxed]
+type mono = Foo of float
+type unboxed = mono = Foo of float [@@unboxed]
[%%expect{|
-Line 1, characters 0-41:
-1 | type unboxed = d = X of float [@@unboxed]
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: This variant or record definition does not match that of type d
+type mono = Foo of float
+Line 2, characters 0-46:
+2 | type unboxed = mono = Foo of float [@@unboxed]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This variant or record definition does not match that of type mono
Their internal representations differ:
this definition uses unboxed representation.
|}]
(* TEST
-files = "foo.mli bar.mli baz.ml"
+readonly_files = "foo.mli bar.mli baz.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "foo.mli"
(* TEST
-files = "original.ml middle.ml"
+readonly_files = "original.ml middle.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "original.ml"
(* TEST
-files = "a.ml b.ml c.ml main.ml main_ok.ml"
+readonly_files = "a.ml b.ml c.ml main.ml main_ok.ml"
+subdirectories = "subdir"
* setup-ocamlc.byte-build-env
-** script
-script = "mkdir -p subdir"
-*** script
-script = "cp ${test_source_directory}/subdir/m.ml subdir"
-**** ocamlc.byte
+** ocamlc.byte
module = "subdir/m.ml"
-***** ocamlc.byte
+*** ocamlc.byte
flags = "-I subdir"
module = "a.ml"
-****** ocamlc.byte
+**** ocamlc.byte
module = "b.ml"
-******* ocamlc.byte
+***** ocamlc.byte
module = "c.ml"
-******** ocamlc.byte
+****** ocamlc.byte
flags = ""
module = "main_ok.ml"
-********* ocamlc.byte
+******* ocamlc.byte
module = "main.ml"
ocamlc_byte_exit_status = "2"
-********** check-ocamlc.byte-output
+******** check-ocamlc.byte-output
*)
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
--- /dev/null
+(* TEST
+ * expect
+*)
+
+
+
+module Root = struct
+ type u
+ and t = private < .. >
+end
+
+module Trunk = struct
+ include Root
+ type t = A
+ type u
+end
+
+module M: sig
+ module type s = module type of Trunk
+end = struct
+ module type s = sig
+ type t = A
+ type u
+ end
+end
+[%%expect {|
+module Root : sig type u and t = private < .. > end
+module Trunk : sig type t = A type u end
+module M : sig module type s = sig type t = A type u end end
+|}]
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -principal -w +18+19 -warn-error A "
+flags = " -principal -w +18+19 -warn-error +A "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
-File "pr7414_2_bad.ml", line 46, characters 28-34:
+File "pr7414_2_bad.ml", line 46, characters 22-35:
46 | let module Ignore = Force(Choose) in
- ^^^^^^
-Error: Signature mismatch:
- Modules do not match:
- functor () -> sig module Choice : T val r : '_weak1 list ref ref end
- is not included in
- functor () -> S
- At position functor () -> <here>
- Modules do not match:
- sig module Choice : T val r : '_weak1 list ref ref end
- is not included in
- S
- At position functor () -> <here>
- Values do not match:
- val r : '_weak1 list ref ref
- is not included in
- val r : Choice.t list ref ref
- File "pr7414_2_bad.ml", line 29, characters 2-31: Expected declaration
- File "pr7414_2_bad.ml", line 40, characters 8-9: Actual declaration
+ ^^^^^^^^^^^^^
+Error: Modules do not match:
+ functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in functor () -> S
+ Modules do not match:
+ sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in
+ S
+ Values do not match:
+ val r : '_weak1 list ref ref
+ is not included in
+ val r : Choice.t list ref ref
+ File "pr7414_2_bad.ml", line 29, characters 2-31: Expected declaration
+ File "pr7414_2_bad.ml", line 40, characters 8-9: Actual declaration
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
-File "pr7414_bad.ml", line 52, characters 22-28:
+File "pr7414_bad.ml", line 52, characters 16-29:
52 | module Ignore = Force(Choose)
- ^^^^^^
-Error: Signature mismatch:
- Modules do not match:
- functor () -> sig module Choice : T val r : '_weak1 list ref ref end
- is not included in
- functor () -> S
- At position functor () -> <here>
- Modules do not match:
- sig module Choice : T val r : '_weak1 list ref ref end
- is not included in
- S
- At position functor () -> <here>
- Values do not match:
- val r : '_weak1 list ref ref
- is not included in
- val r : Choice.t list ref ref
- File "pr7414_bad.ml", line 38, characters 2-31: Expected declaration
- File "pr7414_bad.ml", line 33, characters 6-7: Actual declaration
+ ^^^^^^^^^^^^^
+Error: Modules do not match:
+ functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in functor () -> S
+ Modules do not match:
+ sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in
+ S
+ Values do not match:
+ val r : '_weak1 list ref ref
+ is not included in
+ val r : Choice.t list ref ref
+ File "pr7414_bad.ml", line 38, characters 2-31: Expected declaration
+ File "pr7414_bad.ml", line 33, characters 6-7: Actual declaration
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a -no-alias-deps"
+flags = " -w -a -no-alias-deps"
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
does not match
module type A = sig module M = F(List) end
At position module type A = <here>
- Modules do not match:
+ Module types do not match:
sig module M = F(List) end
- is not included in
+ is not equal to
sig module M = F(List) end
At position module type A = sig module M : <here> end
Module F(List) cannot be aliased
;;
[%%expect{|
module type S =
- sig module rec A : sig type t = B/2.t end and B : sig type t end end
+ sig module rec A : sig type t = B.t end and B : sig type t end end
|}]
let f (module _ : S) = ()
Line 1, characters 9-22:
1 | type t = Set.Make(M).t
^^^^^^^^^^^^^
-Error: The type of M does not match Set.Make's parameter
- Modules do not match:
- sig type t = M.t val equal : 'a -> 'a -> bool end
- is not included in
- Set.OrderedType
- The value `compare' is required but not provided
- File "set.mli", line 55, characters 4-31: Expected declaration
+Error: Modules do not match:
+ sig type t = M.t val equal : 'a -> 'a -> bool end
+ is not included in Set.OrderedType
+ The value `compare' is required but not provided
+ File "set.mli", line 55, characters 4-31: Expected declaration
|} ]
Line 1, characters 9-15:
1 | type t = F(M).t
^^^^^^
-Error: The type of M does not match F's parameter
- Modules do not match:
- sig type t = M.t val equal : 'a -> 'a -> bool end
- is not included in
- sig type t = M.t val equal : unit end
- Values do not match:
- val equal : 'a -> 'a -> bool
- is not included in
- val equal : unit
+Error: Modules do not match:
+ sig type t = M.t val equal : 'a -> 'a -> bool end
+ is not included in sig type t = M.t val equal : unit end
+ Values do not match:
+ val equal : 'a -> 'a -> bool
+ is not included in
+ val equal : unit
|} ]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+
+
+module type a
+module type b
+module type c
+
+module type x = sig type x end
+module type y = sig type y end
+module type z = sig type z end
+
+
+module type empty = sig end
+
+module Empty = struct end
+module X: x = struct type x end
+module Y: y = struct type y end
+module Z: z = struct type z end
+module F(X:x)(Y:y)(Z:z) = struct end
+[%%expect {|
+module type a
+module type b
+module type c
+module type x = sig type x end
+module type y = sig type y end
+module type z = sig type z end
+module type empty = sig end
+module Empty : sig end
+module X : x
+module Y : y
+module Z : z
+module F : functor (X : x) (Y : y) (Z : z) -> sig end
+|}]
+
+
+module M = F(X)(Z)
+[%%expect {|
+Line 1, characters 11-18:
+1 | module M = F(X)(Z)
+ ^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ X Z
+ do not match these parameters:
+ functor (X : x) (Y : y) (Z : z) -> ...
+ 1. Module X matches the expected module type x
+ 2. An argument appears to be missing with module type y
+ 3. Module Z matches the expected module type z
+|}]
+
+module type f = functor (X:empty)(Y:empty) -> empty
+module F: f =
+ functor(X:empty)(Y:empty)(Z:empty) -> Empty
+[%%expect {|
+module type f = functor (X : empty) (Y : empty) -> empty
+Line 3, characters 9-45:
+3 | functor(X:empty)(Y:empty)(Z:empty) -> Empty
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ functor (X : empty) (Y : empty) (Z : empty) -> ...
+ is not included in
+ functor (X : empty) (Y : empty) -> ...
+ 1. Module types empty and empty match
+ 2. Module types empty and empty match
+ 3. An extra argument is provided of module type empty
+|}]
+
+module type f = functor (X:a)(Y:b) -> c
+module F:f = functor (X:a)(Y:b)(Z:c) -> Empty
+[%%expect {|
+module type f = functor (X : a) (Y : b) -> c
+Line 2, characters 21-45:
+2 | module F:f = functor (X:a)(Y:b)(Z:c) -> Empty
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ functor (X : a) (Y : b) (Z : c) -> ...
+ is not included in
+ functor (X : a) (Y : b) -> ...
+ 1. Module types a and a match
+ 2. Module types b and b match
+ 3. An extra argument is provided of module type c
+|}]
+
+module M : sig module F: functor (X:sig end) -> sig end end =
+ struct
+ module F(X:sig type t end) = struct end
+ end
+[%%expect {|
+Lines 2-4, characters 2-5:
+2 | ..struct
+3 | module F(X:sig type t end) = struct end
+4 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig module F : functor (X : sig type t end) -> sig end end
+ is not included in
+ sig module F : functor (X : sig end) -> sig end end
+ In module F:
+ Modules do not match:
+ functor (X : $S1) -> ...
+ is not included in
+ functor (X : sig end) -> ...
+ Module types do not match:
+ $S1 = sig type t end
+ does not include
+ sig end
+ The type `t' is required but not provided
+|}]
+
+module F(X:sig type t end) = struct end
+module M = F(struct type x end)
+[%%expect {|
+module F : functor (X : sig type t end) -> sig end
+Line 2, characters 11-31:
+2 | module M = F(struct type x end)
+ ^^^^^^^^^^^^^^^^^^^^
+Error: Modules do not match: sig type x end is not included in sig type t end
+ The type `t' is required but not provided
+|}]
+
+module F(X:sig type x end)(Y:sig type y end)(Z:sig type z end) = struct
+ type t = X of X.x | Y of Y.y | Z of Z.z
+end
+type u = F(X)(Z).t
+[%%expect {|
+module F :
+ functor (X : sig type x end) (Y : sig type y end) (Z : sig type z end) ->
+ sig type t = X of X.x | Y of Y.y | Z of Z.z end
+Line 4, characters 9-18:
+4 | type u = F(X)(Z).t
+ ^^^^^^^^^
+Error: The functor application F(X)(Z) is ill-typed.
+ These arguments:
+ X Z
+ do not match these parameters:
+ functor (X : ...) (Y : $T2) (Z : ...) -> ...
+ 1. Module X matches the expected module type
+ 2. An argument appears to be missing with module type
+ $T2 = sig type y end
+ 3. Module Z matches the expected module type
+|}]
+
+module F()(X:sig type t end) = struct end
+module M = F()()
+[%%expect {|
+module F : functor () (X : sig type t end) -> sig end
+Line 2, characters 11-16:
+2 | module M = F()()
+ ^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ () ()
+ do not match these parameters:
+ functor () (X : $T2) -> ...
+ 1. Module () matches the expected module type
+ 2. The functor was expected to be applicative at this position
+|}]
+
+module M: sig
+ module F: functor(X:sig type x end)(X:sig type y end) -> sig end
+end = struct
+ module F(X:sig type y end) = struct end
+end
+[%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | module F(X:sig type y end) = struct end
+5 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig module F : functor (X : sig type y end) -> sig end end
+ is not included in
+ sig
+ module F :
+ functor (X : sig type x end) (X : sig type y end) -> sig end
+ end
+ In module F:
+ Modules do not match:
+ functor (X : $S2) -> ...
+ is not included in
+ functor (X : $T1) (X : $T2) -> ...
+ 1. An argument appears to be missing with module type
+ $T1 = sig type x end
+ 2. Module types $S2 and $T2 match
+|}]
+
+
+module F(Ctx: sig
+ module type t
+ module type u
+ module X:t
+ module Y:u
+end) = struct
+ open Ctx
+ module F(A:t)(B:u) = struct end
+ module M = F(Y)(X)
+end
+[%%expect {|
+Line 9, characters 13-20:
+9 | module M = F(Y)(X)
+ ^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ Ctx.Y Ctx.X
+ do not match these parameters:
+ functor (A : Ctx.t) (B : Ctx.u) -> ...
+ 1. Modules do not match: Ctx.Y : Ctx.u is not included in Ctx.t
+ 2. Modules do not match: Ctx.X : Ctx.t is not included in Ctx.u
+|}]
+
+(** Too many arguments *)
+module Ord = struct type t = unit let compare _ _ = 0 end
+module M = Map.Make(Ord)(Ord)
+[%%expect {|
+module Ord : sig type t = unit val compare : 'a -> 'b -> int end
+Line 2, characters 11-29:
+2 | module M = Map.Make(Ord)(Ord)
+ ^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ Ord Ord
+ do not match these parameters:
+ functor (Ord : Map.OrderedType) -> ...
+ 1. The following extra argument is provided
+ Ord : sig type t = unit val compare : 'a -> 'b -> int end
+ 2. Module Ord matches the expected module type Map.OrderedType
+|}]
+
+
+(** Dependent types *)
+(** Application side *)
+
+module F
+ (A:sig type x type y end)
+ (B:sig type x = A.x end)
+ (C:sig type y = A.y end)
+= struct end
+module K = struct include X include Y end
+module M = F(K)(struct type x = K.x end)( (* struct type z = K.y end *) )
+[%%expect {|
+module F :
+ functor (A : sig type x type y end) (B : sig type x = A.x end)
+ (C : sig type y = A.y end) -> sig end
+module K : sig type x = X.x type y = Y.y end
+Line 10, characters 11-73:
+10 | module M = F(K)(struct type x = K.x end)( (* struct type z = K.y end *) )
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ K $S2 ()
+ do not match these parameters:
+ functor (A : ...) (B : ...) (C : $T3) -> ...
+ 1. Module K matches the expected module type
+ 2. Module $S2 matches the expected module type
+ 3. The functor was expected to be applicative at this position
+|}]
+
+module M = F(K)(struct type y = K.y end)
+[%%expect {|
+Line 1, characters 11-40:
+1 | module M = F(K)(struct type y = K.y end)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ K $S3
+ do not match these parameters:
+ functor (A : ...) (B : $T2) (C : ...) -> ...
+ 1. Module K matches the expected module type
+ 2. An argument appears to be missing with module type
+ $T2 = sig type x = A.x end
+ 3. Module $S3 matches the expected module type
+|}]
+
+
+module M =
+ F
+ (struct include X include Y end)
+ (struct type x = K.x end)
+ (struct type yy = K.y end)
+[%%expect {|
+Lines 2-5, characters 2-30:
+2 | ..F
+3 | (struct include X include Y end)
+4 | (struct type x = K.x end)
+5 | (struct type yy = K.y end)
+Error: The functor application is ill-typed.
+ These arguments:
+ $S1 $S2 $S3
+ do not match these parameters:
+ functor (A : ...) (B : ...) (C : $T3) -> ...
+ 1. Module $S1 matches the expected module type
+ 2. Module $S2 matches the expected module type
+ 3. Modules do not match:
+ $S3 : sig type yy = K.y end
+ is not included in
+ $T3 = sig type y = A.y end
+ The type `y' is required but not provided
+|}]
+
+
+module M = struct
+ module N = struct
+ type x
+ type y
+ end
+end
+
+
+module Defs = struct
+ module X = struct type x = M.N.x end
+ module Y = struct type y = M.N.y end
+end
+module Missing_X = F(M.N)(Defs.Y)
+[%%expect {|
+module M : sig module N : sig type x type y end end
+module Defs :
+ sig module X : sig type x = M.N.x end module Y : sig type y = M.N.y end end
+Line 13, characters 19-33:
+13 | module Missing_X = F(M.N)(Defs.Y)
+ ^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ M.N Defs.Y
+ do not match these parameters:
+ functor (A : ...) (B : $T2) (C : ...) -> ...
+ 1. Module M.N matches the expected module type
+ 2. An argument appears to be missing with module type
+ $T2 = sig type x = A.x end
+ 3. Module Defs.Y matches the expected module type
+|}]
+
+module Too_many_Xs = F(M.N)(Defs.X)(Defs.X)(Defs.Y)
+[%%expect {|
+Line 1, characters 21-51:
+1 | module Too_many_Xs = F(M.N)(Defs.X)(Defs.X)(Defs.Y)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ M.N Defs.X Defs.X Defs.Y
+ do not match these parameters:
+ functor (A : ...) (B : ...) (C : ...) -> ...
+ 1. Module M.N matches the expected module type
+ 2. The following extra argument is provided
+ Defs.X : sig type x = M.N.x end
+ 3. Module Defs.X matches the expected module type
+ 4. Module Defs.Y matches the expected module type
+|}]
+
+
+module X = struct type x = int end
+module Y = struct type y = float end
+module Missing_X_bis = F(struct type x = int type y = float end)(Y)
+[%%expect {|
+module X : sig type x = int end
+module Y : sig type y = float end
+Line 3, characters 23-67:
+3 | module Missing_X_bis = F(struct type x = int type y = float end)(Y)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ $S1 Y
+ do not match these parameters:
+ functor (A : ...) (B : $T2) (C : ...) -> ...
+ 1. Module $S1 matches the expected module type
+ 2. An argument appears to be missing with module type
+ $T2 = sig type x = A.x end
+ 3. Module Y matches the expected module type
+|}]
+
+module Too_many_Xs_bis = F(struct type x = int type y = float end)(X)(X)(Y)
+[%%expect {|
+Line 1, characters 25-75:
+1 | module Too_many_Xs_bis = F(struct type x = int type y = float end)(X)(X)(Y)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ $S1 X X Y
+ do not match these parameters:
+ functor (A : ...) (B : ...) (C : ...) -> ...
+ 1. Module $S1 matches the expected module type
+ 2. The following extra argument is provided X : sig type x = int end
+ 3. Module X matches the expected module type
+ 4. Module Y matches the expected module type
+|}]
+
+
+(** Inclusion side *)
+module type f =
+ functor(A:sig type x type y end)(B:sig type x = A.x end)(C:sig type y = A.y end)
+ -> sig end
+module F: f = functor (A:sig include x include y end)(Z:sig type y = A.y end) -> struct end
+[%%expect {|
+module type f =
+ functor (A : sig type x type y end) (B : sig type x = A.x end)
+ (C : sig type y = A.y end) -> sig end
+Line 4, characters 22-91:
+4 | module F: f = functor (A:sig include x include y end)(Z:sig type y = A.y end) -> struct end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ functor (A : $S1) (Z : $S3) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) (C : $T3) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. An argument appears to be missing with module type
+ $T2 = sig type x = A.x end
+ 3. Module types $S3 and $T3 match
+|}]
+
+
+module type f =
+ functor(B:sig type x type y type u=x type v=y end)(Y:sig type yu = Y of B.u end)(Z:sig type zv = Z of B.v end)
+ -> sig end
+module F: f = functor (X:sig include x include y end)(Z:sig type zv = Z of X.y end) -> struct end
+[%%expect {|
+module type f =
+ functor (B : sig type x type y type u = x type v = y end)
+ (Y : sig type yu = Y of B.u end) (Z : sig type zv = Z of B.v end) ->
+ sig end
+Line 4, characters 22-97:
+4 | module F: f = functor (X:sig include x include y end)(Z:sig type zv = Z of X.y end) -> struct end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ functor (X : $S1) (Z : $S3) -> ...
+ is not included in
+ functor (B : $T1) (Y : $T2) (Z : $T3) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. An argument appears to be missing with module type
+ $T2 = sig type yu = Y of B.u end
+ 3. Module types $S3 and $T3 match
+|}]
+
+
+(** Module type equalities *)
+
+module M: sig
+ module type S = sig type t end
+end = struct
+ module type S = sig type s type t end
+end;;
+[%%expect {|
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | module type S = sig type s type t end
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig module type S = sig type s type t end end
+ is not included in
+ sig module type S = sig type t end end
+ Module type declarations do not match:
+ module type S = sig type s type t end
+ does not match
+ module type S = sig type t end
+ The second module type is not included in the first
+ At position module type S = <here>
+ Module types do not match:
+ sig type t end
+ is not equal to
+ sig type s type t end
+ At position module type S = <here>
+ The type `s' is required but not provided
+|}]
+
+module M: sig
+ module type S = sig type t type u end
+end = struct
+ module type S = sig type t end
+end;;
+ [%%expect {|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | module type S = sig type t end
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig module type S = sig type t end end
+ is not included in
+ sig module type S = sig type t type u end end
+ Module type declarations do not match:
+ module type S = sig type t end
+ does not match
+ module type S = sig type t type u end
+ The first module type is not included in the second
+ At position module type S = <here>
+ Module types do not match:
+ sig type t end
+ is not equal to
+ sig type t type u end
+ At position module type S = <here>
+ The type `u' is required but not provided
+|}]
+
+
+(** Name collision test *)
+
+module F(X:x)(B:b)(Y:y) = struct type t end
+module M = struct
+ module type b
+ module G(P: sig module B:b end) = struct
+ open P
+ module U = F(struct type x end)(B)(struct type w end)
+ end
+end
+[%%expect {|
+module F : functor (X : x) (B : b) (Y : y) -> sig type t end
+Line 8, characters 15-57:
+8 | module U = F(struct type x end)(B)(struct type w end)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ $S1 P.B $S3
+ do not match these parameters:
+ functor (X : x) (B : b/2) (Y : y) -> ...
+ 1. Module $S1 matches the expected module type x
+ 2. Modules do not match:
+ P.B : b/1
+ is not included in
+ b/2
+ Line 5, characters 2-15:
+ Definition of module type b/1
+ Line 2, characters 0-13:
+ Definition of module type b/2
+ 3. Modules do not match: $S3 : sig type w end is not included in y
+|}]
+
+module F(X:a) = struct type t end
+module M = struct
+ module type a
+ module G(P: sig module X:a end) = struct
+ open P
+ type t = F(X).t
+ end
+end
+[%%expect {|
+module F : functor (X : a) -> sig type t end
+Line 6, characters 13-19:
+6 | type t = F(X).t
+ ^^^^^^
+Error: Modules do not match: a/1 is not included in a/2
+ Line 3, characters 2-15:
+ Definition of module type a/1
+ Line 1, characters 0-13:
+ Definition of module type a/2
+|}]
+
+
+
+module M: sig module F: functor(X:a)(Y:a) -> sig end end =
+ struct
+ module type aa = a
+ module type a
+ module F(X:aa)(Y:a) = struct end
+end
+[%%expect {|
+Lines 2-6, characters 1-3:
+2 | .struct
+3 | module type aa = a
+4 | module type a
+5 | module F(X:aa)(Y:a) = struct end
+6 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module type aa = a
+ module type a
+ module F : functor (X : aa) (Y : a) -> sig end
+ end
+ is not included in
+ sig module F : functor (X : a) (Y : a) -> sig end end
+ In module F:
+ Modules do not match:
+ functor (X : aa) (Y : a/1) -> ...
+ is not included in
+ functor (X : a/2) (Y : a/2) -> ...
+ 1. Module types aa and a/2 match
+ 2. Module types do not match:
+ a/1
+ does not include
+ a/2
+ Line 4, characters 2-15:
+ Definition of module type a/1
+ Line 1, characters 0-13:
+ Definition of module type a/2
+|}]
+
+module X: functor ( X: sig end) -> sig end = functor(X: Set.OrderedType) -> struct end
+[%%expect {|
+Line 1, characters 52-86:
+1 | module X: functor ( X: sig end) -> sig end = functor(X: Set.OrderedType) -> struct end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Signature mismatch:
+ Modules do not match:
+ functor (X : Set.OrderedType) -> ...
+ is not included in
+ functor (X : sig end) -> ...
+ Module types do not match:
+ Set.OrderedType
+ does not include
+ sig end
+ The type `t' is required but not provided
+ File "set.mli", line 52, characters 4-10: Expected declaration
+ The value `compare' is required but not provided
+ File "set.mli", line 55, characters 4-31: Expected declaration
+|}]
+
+(** Deeply nested errors *)
+
+
+module M: sig
+ module F: functor
+ (X:
+ functor(A: sig type xa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor(A: sig type ya end)(B:sig type yb end) -> sig end
+ )
+ (Z:
+ functor(A: sig type za end)(B:sig type zb end) -> sig end
+ ) -> sig end
+end = struct
+ module F
+ (X:
+ functor (A: sig type xa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor (A: sig type ya end)(B:sig type ybb end) -> sig end
+ )
+ (Z:
+ functor (A: sig type za end)(B:sig type zbb end) -> sig end
+ )
+ = struct end
+end
+[%%expect {|
+Lines 15-27, characters 6-3:
+15 | ......struct
+16 | module F
+17 | (X:
+18 | functor (A: sig type xa end)(B:sig type xz end) -> sig end
+19 | )
+...
+24 | functor (A: sig type za end)(B:sig type zbb end) -> sig end
+25 | )
+26 | = struct end
+27 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type ybb end) ->
+ sig end)
+ (Z : functor (A : sig type za end) (B : sig type zbb end) ->
+ sig end)
+ -> sig end
+ end
+ is not included in
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type yb end) ->
+ sig end)
+ (Z : functor (A : sig type za end) (B : sig type zb end) ->
+ sig end)
+ -> sig end
+ end
+ In module F:
+ Modules do not match:
+ functor (X : $S1) (Y : $S2) (Z : $S3) -> ...
+ is not included in
+ functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. Module types do not match:
+ $S2 =
+ functor (A : sig type ya end) (B : sig type ybb end) -> sig end
+ does not include
+ $T2 =
+ functor (A : sig type ya end) (B : sig type yb end) -> sig end
+ Modules do not match:
+ functor (A : $S1) (B : $S2) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. Module types do not match:
+ $S2 = sig type yb end
+ does not include
+ $T2 = sig type ybb end
+ The type `yb' is required but not provided
+ 3. Module types do not match:
+ $S3 =
+ functor (A : sig type za end) (B : sig type zbb end) -> sig end
+ does not include
+ $T3 =
+ functor (A : sig type za end) (B : sig type zb end) -> sig end
+ Modules do not match:
+ functor (A : $S1) (B : $S2) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) -> ...
+|}]
+
+
+module M: sig
+ module F: functor
+ (X:
+ functor(A: sig type xa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor(A: sig type ya end)(B:sig type yb end) -> sig end
+ )
+ (Z:
+ functor(A: sig type za end)(B:sig type zb end) -> sig end
+ ) -> sig end
+end = struct
+ module F
+ (X:
+ functor (A: sig type xa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor (A: sig type ya end)(B:sig type yb end) -> sig end
+ )
+ = struct end
+end
+[%%expect {|
+Lines 12-21, characters 6-3:
+12 | ......struct
+13 | module F
+14 | (X:
+15 | functor (A: sig type xa end)(B:sig type xz end) -> sig end
+16 | )
+17 | (Y:
+18 | functor (A: sig type ya end)(B:sig type yb end) -> sig end
+19 | )
+20 | = struct end
+21 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type yb end) ->
+ sig end)
+ -> sig end
+ end
+ is not included in
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type yb end) ->
+ sig end)
+ (Z : functor (A : sig type za end) (B : sig type zb end) ->
+ sig end)
+ -> sig end
+ end
+ In module F:
+ Modules do not match:
+ functor (X : $S1) (Y : $S2) -> ...
+ is not included in
+ functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. Module types $S2 and $T2 match
+ 3. An argument appears to be missing with module type
+ $T3 =
+ functor (A : sig type za end) (B : sig type zb end) -> sig end
+|}]
+
+module M: sig
+ module F: functor
+ (X:
+ functor(A: sig type xa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor(A: sig type ya end)(B:sig type yb end) -> sig end
+ )
+ (Z:
+ functor(A: sig type za end)(B:sig type zb end) -> sig end
+ ) -> sig end
+end = struct
+ module F
+ (X:
+ functor (A: sig type xaa end)(B:sig type xz end) -> sig end
+ )
+ (Y:
+ functor (A: sig type ya end)(B:sig type ybb end) -> sig end
+ )
+ (Z:
+ functor (A: sig type za end)(B:sig type zbb end) -> sig end
+ )
+ = struct end
+end
+[%%expect {|
+Lines 12-24, characters 6-3:
+12 | ......struct
+13 | module F
+14 | (X:
+15 | functor (A: sig type xaa end)(B:sig type xz end) -> sig end
+16 | )
+...
+21 | functor (A: sig type za end)(B:sig type zbb end) -> sig end
+22 | )
+23 | = struct end
+24 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xaa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type ybb end) ->
+ sig end)
+ (Z : functor (A : sig type za end) (B : sig type zbb end) ->
+ sig end)
+ -> sig end
+ end
+ is not included in
+ sig
+ module F :
+ functor
+ (X : functor (A : sig type xa end) (B : sig type xz end) ->
+ sig end)
+ (Y : functor (A : sig type ya end) (B : sig type yb end) ->
+ sig end)
+ (Z : functor (A : sig type za end) (B : sig type zb end) ->
+ sig end)
+ -> sig end
+ end
+ In module F:
+ Modules do not match:
+ functor (X : $S1) (Y : $S2) (Z : $S3) -> ...
+ is not included in
+ functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+ 1. Module types do not match:
+ $S1 =
+ functor (A : sig type xaa end) (B : sig type xz end) -> sig end
+ does not include
+ $T1 =
+ functor (A : sig type xa end) (B : sig type xz end) -> sig end
+ Modules do not match:
+ functor (A : $S1) (B : $S2) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) -> ...
+ 1. Module types do not match:
+ $S1 = sig type xa end
+ does not include
+ $T1 = sig type xaa end
+ The type `xa' is required but not provided
+ 2. Module types $S2 and $T2 match
+ 2. Module types do not match:
+ $S2 =
+ functor (A : sig type ya end) (B : sig type ybb end) -> sig end
+ does not include
+ $T2 =
+ functor (A : sig type ya end) (B : sig type yb end) -> sig end
+ Modules do not match:
+ functor (A : $S1) (B : $S2) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) -> ...
+ 3. Module types do not match:
+ $S3 =
+ functor (A : sig type za end) (B : sig type zbb end) -> sig end
+ does not include
+ $T3 =
+ functor (A : sig type za end) (B : sig type zb end) -> sig end
+ Modules do not match:
+ functor (A : $S1) (B : $S2) -> ...
+ is not included in
+ functor (A : $T1) (B : $T2) -> ...
+|}]
+
+module A: sig
+ module B: sig
+ module C: sig
+ module D: sig
+ module E: sig
+ module F: sig type x end -> sig type y end
+ -> sig type z end -> sig type w end -> sig end
+ end
+ end
+ end
+ end
+end = struct
+ module B = struct
+ module C = struct
+ module D = struct
+ module E = struct
+ module F(X:sig type x end)(Y:sig type y' end)
+ (W:sig type w end) = struct end
+ end
+ end
+ end
+ end
+end
+[%%expect {|
+Lines 12-23, characters 6-3:
+12 | ......struct
+13 | module B = struct
+14 | module C = struct
+15 | module D = struct
+16 | module E = struct
+...
+20 | end
+21 | end
+22 | end
+23 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module B :
+ sig
+ module C :
+ sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ functor (X : sig type x end)
+ (Y : sig type y' end) (W : sig type w end) ->
+ sig end
+ end
+ end
+ end
+ end
+ end
+ is not included in
+ sig
+ module B :
+ sig
+ module C :
+ sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ sig type x end -> sig type y end ->
+ sig type z end -> sig type w end -> sig end
+ end
+ end
+ end
+ end
+ end
+ In module B:
+ Modules do not match:
+ sig module C = B.C end
+ is not included in
+ sig
+ module C :
+ sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ sig type x end -> sig type y end ->
+ sig type z end -> sig type w end -> sig end
+ end
+ end
+ end
+ end
+ In module B.C:
+ Modules do not match:
+ sig module D = B.C.D end
+ is not included in
+ sig
+ module D :
+ sig
+ module E :
+ sig
+ module F :
+ sig type x end -> sig type y end -> sig type z end ->
+ sig type w end -> sig end
+ end
+ end
+ end
+ In module B.C.D:
+ Modules do not match:
+ sig module E = B.C.D.E end
+ is not included in
+ sig
+ module E :
+ sig
+ module F :
+ sig type x end -> sig type y end -> sig type z end ->
+ sig type w end -> sig end
+ end
+ end
+ In module B.C.D.E:
+ Modules do not match:
+ sig module F = B.C.D.E.F end
+ is not included in
+ sig
+ module F :
+ sig type x end -> sig type y end -> sig type z end ->
+ sig type w end -> sig end
+ end
+ In module B.C.D.E.F:
+ Modules do not match:
+ functor (X : $S1) (Y : $S3) (W : $S4) -> ...
+ is not included in
+ functor $T1 $T2 $T3 $T4 -> ...
+ 1. Module types $S1 and $T1 match
+ 2. An argument appears to be missing with module type
+ $T2 = sig type y end
+ 3. Module types do not match:
+ $S3 = sig type y' end
+ does not include
+ $T3 = sig type z end
+ 4. Module types $S4 and $T4 match
+|}]
+
+
+(** Ugly cases *)
+
+module type Arg = sig
+ module type A
+ module type Honorificabilitudinitatibus
+ module X: Honorificabilitudinitatibus
+ module Y: A
+end
+
+module F(A:Arg)
+= struct
+ open A
+ module G(X:A)(Y:A)(_:A)(Z:A) = struct end
+ type u = G(X)(Y)(X)(Y)(X).t
+end;;
+[%%expect {|
+module type Arg =
+ sig
+ module type A
+ module type Honorificabilitudinitatibus
+ module X : Honorificabilitudinitatibus
+ module Y : A
+ end
+Line 14, characters 11-29:
+14 | type u = G(X)(Y)(X)(Y)(X).t
+ ^^^^^^^^^^^^^^^^^^
+Error: The functor application G(X)(Y)(X)(Y)(X) is ill-typed.
+ These arguments:
+ A.X A.Y A.X A.Y A.X
+ do not match these parameters:
+ functor (X : A.A) (Y : A.A) A.A (Z : A.A) -> ...
+ 1. The following extra argument is provided
+ A.X : A.Honorificabilitudinitatibus
+ 2. Module A.Y matches the expected module type A.A
+ 3. Modules do not match:
+ A.X : A.Honorificabilitudinitatibus
+ is not included in
+ A.A
+ 4. Module A.Y matches the expected module type A.A
+ 5. Modules do not match:
+ A.X : A.Honorificabilitudinitatibus
+ is not included in
+ A.A
+|}]
+
+
+module type s = functor
+ (X: sig type when_ type shall type we type three type meet type again end)
+ (Y:sig type in_ val thunder:in_ val lightning: in_ type rain end)
+ (Z:sig type when_ type the type hurlyburly's type done_ end)
+ (Z:sig type when_ type the type battle's type lost type and_ type won end)
+ (W:sig type that type will type be type ere type the_ type set type of_ type sun end)
+ (S: sig type where type the type place end)
+ (R: sig type upon type the type heath end)
+-> sig end
+module F: s = functor
+ (X: sig type when_ type shall type we type tree type meet type again end)
+ (Y:sig type in_ val thunder:in_ val lightning: in_ type pain end)
+ (Z:sig type when_ type the type hurlyburly's type gone end)
+ (Z:sig type when_ type the type battle's type last type and_ type won end)
+ (W:sig type that type will type be type the type era type set type of_ type sun end)
+ (S: sig type where type the type lace end)
+ (R: sig type upon type the type heart end)
+ -> struct end
+[%%expect {|
+module type s =
+ functor
+ (X : sig
+ type when_
+ type shall
+ type we
+ type three
+ type meet
+ type again
+ end)
+ (Y : sig type in_ val thunder : in_ val lightning : in_ type rain end)
+ (Z : sig type when_ type the type hurlyburly's type done_ end)
+ (Z : sig
+ type when_
+ type the
+ type battle's
+ type lost
+ type and_
+ type won
+ end)
+ (W : sig
+ type that
+ type will
+ type be
+ type ere
+ type the_
+ type set
+ type of_
+ type sun
+ end)
+ (S : sig type where type the type place end)
+ (R : sig type upon type the type heath end) -> sig end
+Lines 11-18, characters 2-15:
+11 | ..(X: sig type when_ type shall type we type tree type meet type again end)
+12 | (Y:sig type in_ val thunder:in_ val lightning: in_ type pain end)
+13 | (Z:sig type when_ type the type hurlyburly's type gone end)
+14 | (Z:sig type when_ type the type battle's type last type and_ type won end)
+15 | (W:sig type that type will type be type the type era type set type of_ type sun end)
+16 | (S: sig type where type the type lace end)
+17 | (R: sig type upon type the type heart end)
+18 | -> struct end
+Error: Signature mismatch:
+ Modules do not match:
+ functor (X : $S1) (Y : $S2) (Z : $S3) (Z : $S4) (W : $S5) (S : $S6)
+ (R : $S7) -> ...
+ is not included in
+ functor (X : $T1) (Y : $T2) (Z : $T3) (Z : $T4) (W : $T5) (S : $T6)
+ (R : $T7) -> ...
+ 1. Module types do not match:
+ $S1 =
+ sig
+ type when_
+ type shall
+ type we
+ type tree
+ type meet
+ type again
+ end
+ does not include
+ $T1 =
+ sig
+ type when_
+ type shall
+ type we
+ type three
+ type meet
+ type again
+ end
+ The type `tree' is required but not provided
+ 2. Module types do not match:
+ $S2 =
+ sig type in_ val thunder : in_ val lightning : in_ type pain end
+ does not include
+ $T2 =
+ sig type in_ val thunder : in_ val lightning : in_ type rain end
+ 3. Module types do not match:
+ $S3 = sig type when_ type the type hurlyburly's type gone end
+ does not include
+ $T3 = sig type when_ type the type hurlyburly's type done_ end
+ 4. Module types do not match:
+ $S4 =
+ sig
+ type when_
+ type the
+ type battle's
+ type last
+ type and_
+ type won
+ end
+ does not include
+ $T4 =
+ sig
+ type when_
+ type the
+ type battle's
+ type lost
+ type and_
+ type won
+ end
+ 5. Module types do not match:
+ $S5 =
+ sig
+ type that
+ type will
+ type be
+ type the
+ type era
+ type set
+ type of_
+ type sun
+ end
+ does not include
+ $T5 =
+ sig
+ type that
+ type will
+ type be
+ type ere
+ type the_
+ type set
+ type of_
+ type sun
+ end
+ 6. Module types do not match:
+ $S6 = sig type where type the type lace end
+ does not include
+ $T6 = sig type where type the type place end
+ 7. Module types do not match:
+ $S7 = sig type upon type the type heart end
+ does not include
+ $T7 = sig type upon type the type heath end
+|}]
+
+
+(** Abstract module type woes *)
+
+
+module F(X:sig type witness module type t module M:t end) = X.M
+
+module PF = struct
+ type witness
+ module type t = module type of F
+ module M = F
+end
+
+module U = F(PF)(PF)(PF)
+[%%expect {|
+module F :
+ functor (X : sig type witness module type t module M : t end) -> X.t
+module PF :
+ sig
+ type witness
+ module type t =
+ functor (X : sig type witness module type t module M : t end) -> X.t
+ module M = F
+ end
+module U : PF.t
+|}]
+
+module W = F(PF)(PF)(PF)(PF)(PF)(F)
+[%%expect {|
+Line 1, characters 11-35:
+1 | module W = F(PF)(PF)(PF)(PF)(PF)(F)
+ ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ PF PF PF PF PF F
+ do not match these parameters:
+ functor (X : ...) (X : ...) (X : ...) (X : ...) (X : ...) (X : $T6)
+ -> ...
+ 1. Module PF matches the expected module type
+ 2. Module PF matches the expected module type
+ 3. Module PF matches the expected module type
+ 4. Module PF matches the expected module type
+ 5. Module PF matches the expected module type
+ 6. Modules do not match:
+ F :
+ functor (X : sig type witness module type t module M : t end) ->
+ X.t
+ is not included in
+ $T6 = sig type witness module type t module M : t end
+ Modules do not match:
+ functor (X : $S1) -> ...
+ is not included in
+ functor -> ...
+ An extra argument is provided of module type
+ $S1 = sig type witness module type t module M : t end
+|}]
+
+(** Divergent arities *)
+module type arg = sig type arg end
+module A = struct type arg end
+
+module Add_one' = struct
+ module M(_:arg) = A
+ module type t = module type of M
+end
+
+module Add_one = struct type witness include Add_one' end
+
+module Add_three' = struct
+ module M(_:arg)(_:arg)(_:arg) = A
+ module type t = module type of M
+end
+
+module Add_three = struct
+ include Add_three'
+ type witness
+end
+
+
+module Wrong_intro = F(Add_three')(A)(A)(A)
+[%%expect {|
+module type arg = sig type arg end
+module A : sig type arg end
+module Add_one' :
+ sig
+ module M : arg -> sig type arg = A.arg end
+ module type t = arg -> sig type arg = A.arg end
+ end
+module Add_one :
+ sig
+ type witness
+ module M = Add_one'.M
+ module type t = arg -> sig type arg = A.arg end
+ end
+module Add_three' :
+ sig
+ module M : arg -> arg -> arg -> sig type arg = A.arg end
+ module type t = arg -> arg -> arg -> sig type arg = A.arg end
+ end
+module Add_three :
+ sig
+ module M = Add_three'.M
+ module type t = arg -> arg -> arg -> sig type arg = A.arg end
+ type witness
+ end
+Line 22, characters 21-43:
+22 | module Wrong_intro = F(Add_three')(A)(A)(A)
+ ^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ Add_three' A A A
+ do not match these parameters:
+ functor (X : $T1) arg arg arg -> ...
+ 1. Modules do not match:
+ Add_three' :
+ sig
+ module M = Add_three'.M
+ module type t = arg -> arg -> arg -> sig type arg = A.arg end
+ end
+ is not included in
+ $T1 = sig type witness module type t module M : t end
+ The type `witness' is required but not provided
+ 2. Module A matches the expected module type arg
+ 3. Module A matches the expected module type arg
+ 4. Module A matches the expected module type arg
+|}]
+
+module Choose_one = F(Add_one')(Add_three)(A)(A)(A)
+[%%expect {|
+Line 1, characters 20-51:
+1 | module Choose_one = F(Add_one')(Add_three)(A)(A)(A)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ Add_one' Add_three A A A
+ do not match these parameters:
+ functor (X : ...) arg arg arg -> ...
+ 1. The following extra argument is provided
+ Add_one' :
+ sig
+ module M = Add_one'.M
+ module type t = arg -> sig type arg = A.arg end
+ end
+ 2. Module Add_three matches the expected module type
+ 3. Module A matches the expected module type arg
+ 4. Module A matches the expected module type arg
+ 5. Module A matches the expected module type arg
+|}]
+
+(** Known lmitation: we choose the wrong environment without the
+ error on Add_one
+**)
+module Mislead_chosen_one = F(Add_one)(Add_three)(A)(A)(A)
+[%%expect {|
+Line 1, characters 28-58:
+1 | module Mislead_chosen_one = F(Add_one)(Add_three)(A)(A)(A)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ Add_one Add_three A A A
+ do not match these parameters:
+ functor (X : ...) arg arg arg -> ...
+ 1. The following extra argument is provided
+ Add_one :
+ sig
+ type witness = Add_one.witness
+ module M = Add_one'.M
+ module type t = arg -> sig type arg = A.arg end
+ end
+ 2. Module Add_three matches the expected module type
+ 3. Module A matches the expected module type arg
+ 4. Module A matches the expected module type arg
+ 5. Module A matches the expected module type arg
+|}]
+
+
+
+
+
+
+(** Hide your arity from the world *)
+
+module M: sig
+ module F:
+ functor (X:sig
+ type x
+ module type t =
+ functor
+ (Y:sig type y end)
+ (Z:sig type z end)
+ -> sig end
+ end) -> X.t
+end
+= struct
+ module F(X:sig type x end)(Z:sig type z end) = struct end
+end
+[%%expect {|
+Lines 14-16, characters 2-3:
+14 | ..struct
+15 | module F(X:sig type x end)(Z:sig type z end) = struct end
+16 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ functor (X : sig type x end) (Z : sig type z end) -> sig end
+ end
+ is not included in
+ sig
+ module F :
+ functor
+ (X : sig
+ type x
+ module type t =
+ functor (Y : sig type y end) (Z : sig type z end) ->
+ sig end
+ end)
+ -> X.t
+ end
+ In module F:
+ Modules do not match:
+ functor (X : $S1) (Z : $S3) -> ...
+ is not included in
+ functor (X : $T1) (Y : $T2) (Z : $T3) -> ...
+ 1. Module types $S1 and $T1 match
+ 2. An argument appears to be missing with module type
+ $T2 = sig type y end
+ 3. Module types $S3 and $T3 match
+|}]
+
+
+module M: sig
+ module F(X: sig
+ module type T
+ module type t = T -> T -> T
+ module M: t
+ end
+ )(_:X.T)(_:X.T): X.T
+end = struct
+ module F (Wrong: sig type wrong end)
+ (X: sig
+ module type t
+ module M: t
+ end) = (X.M : X.t)
+end
+[%%expect {|
+Lines 8-14, characters 6-3:
+ 8 | ......struct
+ 9 | module F (Wrong: sig type wrong end)
+10 | (X: sig
+11 | module type t
+12 | module M: t
+13 | end) = (X.M : X.t)
+14 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ functor (Wrong : sig type wrong end)
+ (X : sig module type t module M : t end) -> X.t
+ end
+ is not included in
+ sig
+ module F :
+ functor
+ (X : sig
+ module type T
+ module type t = T -> T -> T
+ module M : t
+ end)
+ -> X.T -> X.T -> X.T
+ end
+ In module F:
+ Modules do not match:
+ functor (Wrong : $S1) (X : $S2) X.T X.T -> ...
+ is not included in
+ functor (X : $T2) X.T X.T -> ...
+ 1. An extra argument is provided of module type
+ $S1 = sig type wrong end
+ 2. Module types $S2 and $T2 match
+ 3. Module types X/3.T and X/2.T match
+ 4. Module types X/3.T and X/2.T match
+|}]
+
+
+module M: sig
+ module F(_:sig end)(X:
+ sig
+ module type T
+ module type inner = sig
+ module type t
+ module M: t
+ end
+ module F(X: inner)(_:T -> T->T):
+ sig module type res = X.t end
+ module Y: sig
+ module type t = T -> T -> T
+ module M(X:T)(Y:T): T
+ end
+ end):
+ X.F(X.Y)(X.Y.M).res
+end = struct
+ module F(_:sig type wrong end) (X:
+ sig module type T end
+ )(Res: X.T)(Res: X.T)(Res: X.T) = Res
+end
+[%%expect {|
+Lines 17-21, characters 6-3:
+17 | ......struct
+18 | module F(_:sig type wrong end) (X:
+19 | sig module type T end
+20 | )(Res: X.T)(Res: X.T)(Res: X.T) = Res
+21 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig
+ module F :
+ sig type wrong end ->
+ functor (X : sig module type T end) (Res : X.T) (Res :
+ X.T) (Res : X.T)
+ -> X.T
+ end
+ is not included in
+ sig
+ module F :
+ sig end ->
+ functor
+ (X : sig
+ module type T
+ module type inner =
+ sig module type t module M : t end
+ module F :
+ functor (X : inner) -> (T -> T -> T) ->
+ sig module type res = X.t end
+ module Y :
+ sig
+ module type t = T -> T -> T
+ module M : functor (X : T) (Y : T) -> T
+ end
+ end)
+ -> X.F(X.Y)(X.Y.M).res
+ end
+ In module F:
+ Modules do not match:
+ functor (Arg : $S1) (X : $S2) (Res : X.T) (Res : X.T) (Res :
+ X.T) -> ...
+ is not included in
+ functor (sig end) (X : $T2) X.T X.T -> ...
+ 1. Module types do not match:
+ $S1 = sig type wrong end
+ does not include
+ sig end
+ The type `wrong' is required but not provided
+ 2. Module types $S2 and $T2 match
+ 3. An extra argument is provided of module type X/2.T
+ 4. Module types X/2.T and X/2.T match
+ 5. Module types X/2.T and X/2.T match
+|}]
+
+
+(** The price of Gluttony: gready update of environment leads to a non-optimal edit distance. *)
+
+module F(X:sig type t end)(Y:sig type t = Y of X.t end)(Z:sig type t = Z of X.t end) = struct end
+
+module X = struct type t = U end
+module Y = struct type t = Y of int end
+module Z = struct type t = Z of int end
+
+module Error=F(X)(struct type t = int end)(Y)(Z)
+[%%expect {|
+module F :
+ functor (X : sig type t end) (Y : sig type t = Y of X.t end)
+ (Z : sig type t = Z of X.t end) -> sig end
+module X : sig type t = U end
+module Y : sig type t = Y of int end
+module Z : sig type t = Z of int end
+Line 9, characters 13-48:
+9 | module Error=F(X)(struct type t = int end)(Y)(Z)
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application is ill-typed.
+ These arguments:
+ X ... Y Z
+ do not match these parameters:
+ functor (X : ...) (Y : $T3) (Z : $T4) -> ...
+ 1. Module X matches the expected module type
+ 2. The following extra argument is provided ... : sig type t = int end
+ 3. Modules do not match:
+ Y : sig type t = Y.t = Y of int end
+ is not included in
+ $T3 = sig type t = Y of X/2.t end
+ Type declarations do not match:
+ type t = Y.t = Y of int
+ is not included in
+ type t = Y of X.t
+ Constructors do not match:
+ Y of int
+ is not compatible with:
+ Y of X.t
+ The types are not equal.
+ Line 5, characters 0-32:
+ Definition of module X/1
+ 4. Modules do not match:
+ Z : sig type t = Z.t = Z of int end
+ is not included in
+ $T4 = sig type t = Z of X/2.t end
+ Type declarations do not match:
+ type t = Z.t = Z of int
+ is not included in
+ type t = Z of X.t
+ Constructors do not match:
+ Z of int
+ is not compatible with:
+ Z of X.t
+ The types are not equal.
+|}]
+
+(** Final state in the presence of extensions
+ Test provided by Leo White in
+ https://github.com/ocaml/ocaml/pull/9331#pullrequestreview-492359720
+*)
+
+module type A = sig type a end
+module A = struct type a end
+module type B = sig type b end
+module B = struct type b end
+
+module type ty = sig type t end
+module TY = struct type t end
+
+module type Ext = sig module type T module X : T end
+
+module AExt = struct module type T = A module X = A end
+module FiveArgsExt = struct
+ module type T = ty -> ty -> ty -> ty -> ty -> sig end
+ module X : T =
+ functor (_ : ty) (_ : ty) (_ : ty) (_ : ty) (_ : ty) -> struct end
+end
+
+module Bar (W : A) (X : Ext) (Y : B) (Z : Ext) = Z.X
+
+type fine = Bar(A)(FiveArgsExt)(B)(AExt).a
+[%%expect{|
+module type A = sig type a end
+module A : sig type a end
+module type B = sig type b end
+module B : sig type b end
+module type ty = sig type t end
+module TY : sig type t end
+module type Ext = sig module type T module X : T end
+module AExt : sig module type T = A module X = A end
+module FiveArgsExt :
+ sig module type T = ty -> ty -> ty -> ty -> ty -> sig end module X : T end
+module Bar : functor (W : A) (X : Ext) (Y : B) (Z : Ext) -> Z.T
+type fine = Bar(A)(FiveArgsExt)(B)(AExt).a
+|}]
+
+type broken1 = Bar(B)(FiveArgsExt)(B)(AExt).a
+[%%expect{|
+Line 1, characters 15-45:
+1 | type broken1 = Bar(B)(FiveArgsExt)(B)(AExt).a
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application Bar(B)(FiveArgsExt)(B)(AExt) is ill-typed.
+ These arguments:
+ B FiveArgsExt B AExt
+ do not match these parameters:
+ functor (W : A) (X : Ext) (Y : B) (Z : Ext) -> ...
+ 1. Modules do not match:
+ B : sig type b = B.b end
+ is not included in
+ A
+ The type `a' is required but not provided
+ 2. Module FiveArgsExt matches the expected module type Ext
+ 3. Module B matches the expected module type B
+ 4. Module AExt matches the expected module type Ext
+|}]
+
+type broken2 = Bar(A)(FiveArgsExt)(TY)(TY)(TY)(TY)(TY).a
+[%%expect{|
+Line 1, characters 15-56:
+1 | type broken2 = Bar(A)(FiveArgsExt)(TY)(TY)(TY)(TY)(TY).a
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The functor application Bar(A)(FiveArgsExt)(TY)(TY)(TY)(TY)(TY) is ill-typed.
+ These arguments:
+ A FiveArgsExt TY TY TY TY TY
+ do not match these parameters:
+ functor (W : A) (X : Ext) (Y : B) (Z : Ext) ty ty ty ty ty -> ...
+ 1. Module A matches the expected module type A
+ 2. An argument appears to be missing with module type Ext
+ 3. An argument appears to be missing with module type B
+ 4. Module FiveArgsExt matches the expected module type Ext
+ 5. Module TY matches the expected module type ty
+ 6. Module TY matches the expected module type ty
+ 7. Module TY matches the expected module type ty
+ 8. Module TY matches the expected module type ty
+ 9. Module TY matches the expected module type ty
+|}]
^^
Error: Signature mismatch:
Modules do not match:
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> ...
is not included in
- functor () -> sig end
+ functor () -> ...
+ The functor was expected to be generative at this position
|}];;
module F3 () = struct end;;
module F4 : functor (X : sig end) -> sig end = F3;; (* fail *)
^^
Error: Signature mismatch:
Modules do not match:
- functor () -> sig end
+ functor () -> ...
is not included in
- functor (X : sig end) -> sig end
+ functor (X : sig end) -> ...
+ The functor was expected to be applicative at this position
|}];;
(* tests for shortened functor notation () *)
module type a =
sig module type b = sig val x : int val y : int end end
At position module type a = <here>
- Modules do not match:
+ Module types do not match:
sig module type b = sig val y : int val x : int end end
- is not included in
+ is not equal to
sig module type b = sig val x : int val y : int end end
At position module type a = <here>
Module type declarations do not match:
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(********************************** Equality **********************************)
+
+module M : sig
+ type ('a, 'b) t = 'a * 'b
+end = struct
+ type ('a, 'b) t = 'a * 'a
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type ('a, 'b) t = 'a * 'a
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('a, 'b) t = 'a * 'a end
+ is not included in
+ sig type ('a, 'b) t = 'a * 'b end
+ Type declarations do not match:
+ type ('a, 'b) t = 'a * 'a
+ is not included in
+ type ('a, 'b) t = 'a * 'b
+|}];;
+
+module M : sig
+ type ('a, 'b) t = 'a * 'a
+end = struct
+ type ('a, 'b) t = 'a * 'b
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type ('a, 'b) t = 'a * 'b
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type ('a, 'b) t = 'a * 'b end
+ is not included in
+ sig type ('a, 'b) t = 'a * 'a end
+ Type declarations do not match:
+ type ('a, 'b) t = 'a * 'b
+ is not included in
+ type ('a, 'b) t = 'a * 'a
+|}];;
+
+module M : sig
+ type t = <m : 'b. 'b * ('b * <m:'c. 'c * 'bar> as 'bar)>
+end = struct
+ type t = <m : 'a. 'a * ('a * 'foo)> as 'foo
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <m : 'a. 'a * ('a * 'foo)> as 'foo
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < m : 'a. 'a * ('a * 'b) > as 'b end
+ is not included in
+ sig type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > end
+ Type declarations do not match:
+ type t = < m : 'a. 'a * ('a * 'b) > as 'b
+ is not included in
+ type t = < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) >
+|}];;
+
+type s = private < m : int; .. >;;
+[%%expect{|
+type s = private < m : int; .. >
+|}];;
+
+module M : sig
+ type t = s
+end = struct
+ type t = <m : int>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <m : int>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < m : int > end
+ is not included in
+ sig type t = s end
+ Type declarations do not match:
+ type t = < m : int >
+ is not included in
+ type t = s
+|}];;
+
+module M : sig
+ type t = <m : int>
+end = struct
+ type t = s
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = s
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = s end
+ is not included in
+ sig type t = < m : int > end
+ Type declarations do not match:
+ type t = s
+ is not included in
+ type t = < m : int >
+|}];;
+
+module M : sig
+ type t =
+ | Foo of (int)*float
+end = struct
+ type t =
+ | Foo of (int*int)*float
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of (int*int)*float
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of (int * int) * float end
+ is not included in
+ sig type t = Foo of int * float end
+ Type declarations do not match:
+ type t = Foo of (int * int) * float
+ is not included in
+ type t = Foo of int * float
+ Constructors do not match:
+ Foo of (int * int) * float
+ is not compatible with:
+ Foo of int * float
+ The types are not equal.
+|}];;
+
+module M : sig
+ type t = (int * float)
+end = struct
+ type t = (int * float * int)
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = (int * float * int)
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = int * float * int end
+ is not included in
+ sig type t = int * float end
+ Type declarations do not match:
+ type t = int * float * int
+ is not included in
+ type t = int * float
+|}];;
+
+module M : sig
+ type t = <n : int; m : float>
+end = struct
+ type t = <n : int; f : float>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <n : int; f : float>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < f : float; n : int > end
+ is not included in
+ sig type t = < m : float; n : int > end
+ Type declarations do not match:
+ type t = < f : float; n : int >
+ is not included in
+ type t = < m : float; n : int >
+|}];;
+
+module M : sig
+ type t = <n : int; m : float>
+end = struct
+ type t = <n : int>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <n : int>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < n : int > end
+ is not included in
+ sig type t = < m : float; n : int > end
+ Type declarations do not match:
+ type t = < n : int >
+ is not included in
+ type t = < m : float; n : int >
+|}];;
+
+module M4 : sig
+ type t = <n : int; m : float * int>
+end = struct
+ type t = <n : int; m : int>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <n : int; m : int>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < m : int; n : int > end
+ is not included in
+ sig type t = < m : float * int; n : int > end
+ Type declarations do not match:
+ type t = < m : int; n : int >
+ is not included in
+ type t = < m : float * int; n : int >
+|}];;
+
+module M4 : sig
+ type t =
+ | Foo of [`Foo of string | `Bar of string]
+end = struct
+ type t =
+ | Foo of [`Bar of string]
+end;;
+[%%expect{|
+Lines 4-7, characters 6-3:
+4 | ......struct
+5 | type t =
+6 | | Foo of [`Bar of string]
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = Foo of [ `Bar of string ] end
+ is not included in
+ sig type t = Foo of [ `Bar of string | `Foo of string ] end
+ Type declarations do not match:
+ type t = Foo of [ `Bar of string ]
+ is not included in
+ type t = Foo of [ `Bar of string | `Foo of string ]
+ Constructors do not match:
+ Foo of [ `Bar of string ]
+ is not compatible with:
+ Foo of [ `Bar of string | `Foo of string ]
+ The types are not equal.
+|}];;
+
+module M : sig
+ type t = private [`C of int]
+end = struct
+ type t = private [`C]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [`C]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [ `C ] end
+ is not included in
+ sig type t = private [ `C of int ] end
+ Type declarations do not match:
+ type t = private [ `C ]
+ is not included in
+ type t = private [ `C of int ]
+|}];;
+
+module M : sig
+ type t = private [`C]
+end = struct
+ type t = private [`C of int]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [`C of int]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [ `C of int ] end
+ is not included in
+ sig type t = private [ `C ] end
+ Type declarations do not match:
+ type t = private [ `C of int ]
+ is not included in
+ type t = private [ `C ]
+|}];;
+
+module M : sig
+ type t = [`C of [< `A] | `C of [`A]]
+end = struct
+ type t = [`C of [< `A | `B] | `C of [`A]]
+end;;
+[%%expect{|
+module M : sig type t = [ `C of [ `A ] ] end
+|}];;
+
+module M : sig
+ type t = private [> `A of int]
+end = struct
+ type t = private [`A of int]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [`A of int]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [ `A of int ] end
+ is not included in
+ sig type t = private [> `A of int ] end
+ Type declarations do not match:
+ type t = private [ `A of int ]
+ is not included in
+ type t = private [> `A of int ]
+|}];;
+
+module M : sig
+ type t = private [`A of int]
+end = struct
+ type t = private [> `A of int]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [> `A of int]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [> `A of int ] end
+ is not included in
+ sig type t = private [ `A of int ] end
+ Type declarations do not match:
+ type t = private [> `A of int ]
+ is not included in
+ type t = private [ `A of int ]
+|}];;
+
+module M : sig
+ type 'a t = [> `A of int | `B of int] as 'a
+end = struct
+ type 'a t = [> `A of int] as 'a
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type 'a t = [> `A of int] as 'a
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type 'a t = 'a constraint 'a = [> `A of int ] end
+ is not included in
+ sig type 'a t = 'a constraint 'a = [> `A of int | `B of int ] end
+ Type declarations do not match:
+ type 'a t = 'a constraint 'a = [> `A of int ]
+ is not included in
+ type 'a t = 'a constraint 'a = [> `A of int | `B of int ]
+|}];;
+
+module M : sig
+ type 'a t = [> `A of int] as 'a
+end = struct
+ type 'a t = [> `A of int | `C of float] as 'a
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type 'a t = [> `A of int | `C of float] as 'a
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type 'a t = 'a constraint 'a = [> `A of int | `C of float ] end
+ is not included in
+ sig type 'a t = 'a constraint 'a = [> `A of int ] end
+ Type declarations do not match:
+ type 'a t = 'a constraint 'a = [> `A of int | `C of float ]
+ is not included in
+ type 'a t = 'a constraint 'a = [> `A of int ]
+|}];;
+
+module M : sig
+ type t = [`C of [< `A | `B] | `C of [`A]]
+end = struct
+ type t = [`C of [< `A] | `C of [`A]]
+end;;
+[%%expect{|
+module M : sig type t = [ `C of [ `A ] ] end
+|}];;
+
+module M : sig
+ type t = private [< `C]
+end = struct
+ type t = private [< `C of int&float]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `C of int&float]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `C of int & float ] end
+ is not included in
+ sig type t = private [< `C ] end
+ Type declarations do not match:
+ type t = private [< `C of int & float ]
+ is not included in
+ type t = private [< `C ]
+|}];;
+
+(********************************** Moregen ***********************************)
+
+module type T = sig
+ type t
+end
+module Int = struct
+ type t = int
+end
+module type S = sig
+ module Choice : T
+ val r : Choice.t list ref ref
+end
+module Force (X : functor () -> S) = struct end
+module Choose () = struct
+ module Choice =
+ (val (module Int : T))
+ let r = ref (ref [])
+end
+module Ignore = Force(Choose)
+[%%expect{|
+module type T = sig type t end
+module Int : sig type t = int end
+module type S = sig module Choice : T val r : Choice.t list ref ref end
+module Force : functor (X : functor () -> S) -> sig end
+module Choose :
+ functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+Line 17, characters 16-29:
+17 | module Ignore = Force(Choose)
+ ^^^^^^^^^^^^^
+Error: Modules do not match:
+ functor () -> sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in functor () -> S
+ Modules do not match:
+ sig module Choice : T val r : '_weak1 list ref ref end
+ is not included in
+ S
+ Values do not match:
+ val r : '_weak1 list ref ref
+ is not included in
+ val r : Choice.t list ref ref
+|}];;
+
+module O = struct
+ module type s
+ module M: sig
+ val f: (module s) -> unit
+ end = struct
+ module type s
+ let f (module X:s) = ()
+ end
+end;;
+[%%expect{|
+Lines 5-8, characters 8-5:
+5 | ........struct
+6 | module type s
+7 | let f (module X:s) = ()
+8 | end
+Error: Signature mismatch:
+ Modules do not match:
+ sig module type s val f : (module s) -> unit end
+ is not included in
+ sig val f : (module s) -> unit end
+ Values do not match:
+ val f : (module s/1) -> unit
+ is not included in
+ val f : (module s/2) -> unit
+ Line 6, characters 4-17:
+ Definition of module type s/1
+ Line 2, characters 2-15:
+ Definition of module type s/2
+|}];;
+
+module M : sig
+ val f : (<m : 'b. ('b * <m: 'c. 'c * 'bar> as 'bar)>) -> unit
+end = struct
+ let f (x : <m : 'a. ('a * 'foo)> as 'foo) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : <m : 'a. ('a * 'foo)> as 'foo) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : (< m : 'a. 'a * 'b > as 'b) -> unit end
+ is not included in
+ sig val f : < m : 'b. 'b * < m : 'c. 'c * 'a > as 'a > -> unit end
+ Values do not match:
+ val f : (< m : 'a. 'a * 'b > as 'b) -> unit
+ is not included in
+ val f : < m : 'b. 'b * < m : 'c. 'c * 'a > as 'a > -> unit
+|}];;
+
+type s = private < m : int; .. >;;
+
+module M : sig
+ val f : s -> s
+end = struct
+ let f (x : <m : int>) = x
+end;;
+[%%expect{|
+type s = private < m : int; .. >
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | let f (x : <m : int>) = x
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : < m : int > -> < m : int > end
+ is not included in
+ sig val f : s -> s end
+ Values do not match:
+ val f : < m : int > -> < m : int >
+ is not included in
+ val f : s -> s
+|}];;
+
+module M : sig
+ val x : 'a list ref
+end = struct
+ let x = ref []
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let x = ref []
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val x : '_weak2 list ref end
+ is not included in
+ sig val x : 'a list ref end
+ Values do not match:
+ val x : '_weak2 list ref
+ is not included in
+ val x : 'a list ref
+|}];;
+
+module M = struct let r = ref [] end;;
+type t;;
+module N : sig val r : t list ref end = M;;
+[%%expect{|
+module M : sig val r : '_weak3 list ref end
+type t
+Line 3, characters 40-41:
+3 | module N : sig val r : t list ref end = M;;
+ ^
+Error: Signature mismatch:
+ Modules do not match:
+ sig val r : '_weak3 list ref end
+ is not included in
+ sig val r : t list ref end
+ Values do not match:
+ val r : '_weak3 list ref
+ is not included in
+ val r : t list ref
+|}];;
+
+type (_, _) eq = Refl : ('a, 'a) eq;;
+
+module T : sig
+ type t
+ type s
+ val eq : (t, s) eq
+end = struct
+ type t = int
+ type s = int
+ let eq = Refl
+end;;
+
+module M = struct let r = ref [] end;;
+
+let foo p (e : (T.t, T.s) eq) (x : T.t) (y : T.s) =
+ match e with
+ | Refl ->
+ let z = if p then x else y in
+ let module N = struct
+ module type S = module type of struct let r = ref [z] end
+ end in
+ let module O : N.S = M in
+ ();;
+[%%expect{|
+type (_, _) eq = Refl : ('a, 'a) eq
+module T : sig type t type s val eq : (t, s) eq end
+module M : sig val r : '_weak4 list ref end
+Line 22, characters 25-26:
+22 | let module O : N.S = M in
+ ^
+Error: Signature mismatch:
+ Modules do not match:
+ sig val r : '_weak4 list ref end
+ is not included in
+ N.S
+ Values do not match:
+ val r : '_weak4 list ref
+ is not included in
+ val r : T.s list ref
+|}];;
+
+module M: sig
+ val f : int -> float
+end = struct
+ let f (x : 'a) = x
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : 'a) = x
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : 'a -> 'a end
+ is not included in
+ sig val f : int -> float end
+ Values do not match:
+ val f : 'a -> 'a
+ is not included in
+ val f : int -> float
+|}];;
+
+module M: sig
+ val f : (int * float * int) -> (int -> int)
+end = struct
+ let f (x : (int * int)) = x
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : (int * int)) = x
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : int * int -> int * int end
+ is not included in
+ sig val f : int * float * int -> int -> int end
+ Values do not match:
+ val f : int * int -> int * int
+ is not included in
+ val f : int * float * int -> int -> int
+|}];;
+
+module M: sig
+ val f : <m : int; n : float> -> <m : int; n : float>
+end = struct
+ let f (x : <m : int; f : float>) = x
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : <m : int; f : float>) = x
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : < f : float; m : int > -> < f : float; m : int > end
+ is not included in
+ sig val f : < m : int; n : float > -> < m : int; n : float > end
+ Values do not match:
+ val f : < f : float; m : int > -> < f : float; m : int >
+ is not included in
+ val f : < m : int; n : float > -> < m : int; n : float >
+|}];;
+
+module M : sig
+ val f : [`Foo] -> unit
+end = struct
+ let f (x : [ `Foo | `Bar]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [ `Foo | `Bar]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [ `Bar | `Foo ] -> unit end
+ is not included in
+ sig val f : [ `Foo ] -> unit end
+ Values do not match:
+ val f : [ `Bar | `Foo ] -> unit
+ is not included in
+ val f : [ `Foo ] -> unit
+|}];;
+
+module M : sig
+ val f : [>`Foo] -> unit
+end = struct
+ let f (x : [< `Foo]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [< `Foo]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [< `Foo ] -> unit end
+ is not included in
+ sig val f : [> `Foo ] -> unit end
+ Values do not match:
+ val f : [< `Foo ] -> unit
+ is not included in
+ val f : [> `Foo ] -> unit
+|}];;
+
+module M : sig
+ val f : [< `Foo | `Bar] -> unit
+end = struct
+ let f (x : [< `Foo]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [< `Foo]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [< `Foo ] -> unit end
+ is not included in
+ sig val f : [< `Bar | `Foo ] -> unit end
+ Values do not match:
+ val f : [< `Foo ] -> unit
+ is not included in
+ val f : [< `Bar | `Foo ] -> unit
+|}];;
+
+module M : sig
+ val f : < m : [< `Foo]> -> unit
+end = struct
+ let f (x : < m : 'a. [< `Foo] as 'a >) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : < m : 'a. [< `Foo] as 'a >) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : < m : 'a. [< `Foo ] as 'a > -> unit end
+ is not included in
+ sig val f : < m : [< `Foo ] > -> unit end
+ Values do not match:
+ val f : < m : 'a. [< `Foo ] as 'a > -> unit
+ is not included in
+ val f : < m : [< `Foo ] > -> unit
+|}];;
+
+module M : sig
+ val f : < m : 'a. [< `Foo] as 'a > -> unit
+end = struct
+ let f (x : < m : [`Foo]>) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : < m : [`Foo]>) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : < m : [ `Foo ] > -> unit end
+ is not included in
+ sig val f : < m : 'a. [< `Foo ] as 'a > -> unit end
+ Values do not match:
+ val f : < m : [ `Foo ] > -> unit
+ is not included in
+ val f : < m : 'a. [< `Foo ] as 'a > -> unit
+|}];;
+
+module M : sig
+ val f : [< `C] -> unit
+end = struct
+ let f (x : [< `C of int&float]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [< `C of int&float]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [< `C of int & float ] -> unit end
+ is not included in
+ sig val f : [< `C ] -> unit end
+ Values do not match:
+ val f : [< `C of int & float ] -> unit
+ is not included in
+ val f : [< `C ] -> unit
+|}];;
+
+module M : sig
+ val f : [`Foo] -> unit
+end = struct
+ let f (x : [`Foo of int]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [`Foo of int]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [ `Foo of int ] -> unit end
+ is not included in
+ sig val f : [ `Foo ] -> unit end
+ Values do not match:
+ val f : [ `Foo of int ] -> unit
+ is not included in
+ val f : [ `Foo ] -> unit
+|}];;
+
+module M : sig
+ val f : [`Foo of int] -> unit
+end = struct
+ let f (x : [`Foo]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [`Foo]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [ `Foo ] -> unit end
+ is not included in
+ sig val f : [ `Foo of int ] -> unit end
+ Values do not match:
+ val f : [ `Foo ] -> unit
+ is not included in
+ val f : [ `Foo of int ] -> unit
+|}];;
+
+module M : sig
+ val f : [< `Foo | `Bar | `Baz] -> unit
+end = struct
+ let f (x : [< `Foo | `Bar | `Baz]) = ()
+end;;
+[%%expect{|
+module M : sig val f : [< `Bar | `Baz | `Foo ] -> unit end
+|}];;
+
+module M : sig
+ val f : [< `Foo | `Bar | `Baz] -> unit
+end = struct
+ let f (x : [> `Foo | `Bar]) = ()
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | let f (x : [> `Foo | `Bar]) = ()
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig val f : [> `Bar | `Foo ] -> unit end
+ is not included in
+ sig val f : [< `Bar | `Baz | `Foo ] -> unit end
+ Values do not match:
+ val f : [> `Bar | `Foo ] -> unit
+ is not included in
+ val f : [< `Bar | `Baz | `Foo ] -> unit
+|}];;
+
+(******************************* Type manifests *******************************)
+
+module M : sig
+ type t = private [< `A | `B]
+end = struct
+ type t = [`C]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = [`C]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = [ `C ] end
+ is not included in
+ sig type t = private [< `A | `B ] end
+ Type declarations do not match:
+ type t = [ `C ]
+ is not included in
+ type t = private [< `A | `B ]
+|}];;
+
+module M : sig
+ type t = private [< `A | `B]
+end = struct
+ type t = private [> `A]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [> `A]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [> `A ] end
+ is not included in
+ sig type t = private [< `A | `B ] end
+ Type declarations do not match:
+ type t = private [> `A ]
+ is not included in
+ type t = private [< `A | `B ]
+|}];;
+
+module M : sig
+ type t = private [< `A | `B > `A]
+end = struct
+ type t = [`B]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = [`B]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = [ `B ] end
+ is not included in
+ sig type t = private [< `A | `B > `A ] end
+ Type declarations do not match:
+ type t = [ `B ]
+ is not included in
+ type t = private [< `A | `B > `A ]
+|}];;
+
+module M : sig
+ type t = private [> `A of int]
+end = struct
+ type t = [`A]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = [`A]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = [ `A ] end
+ is not included in
+ sig type t = private [> `A of int ] end
+ Type declarations do not match:
+ type t = [ `A ]
+ is not included in
+ type t = private [> `A of int ]
+|}];;
+
+module M : sig
+ type t = private [< `A of int]
+end = struct
+ type t = private [< `A of & int]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A of & int]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A of & int ] end
+ is not included in
+ sig type t = private [< `A of int ] end
+ Type declarations do not match:
+ type t = private [< `A of & int ]
+ is not included in
+ type t = private [< `A of int ]
+|}];;
+
+
+module M : sig
+ type t = private [< `A of int]
+end = struct
+ type t = private [< `A]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A ] end
+ is not included in
+ sig type t = private [< `A of int ] end
+ Type declarations do not match:
+ type t = private [< `A ]
+ is not included in
+ type t = private [< `A of int ]
+|}];;
+
+
+module M : sig
+ type t = private [< `A of int & float]
+end = struct
+ type t = private [< `A]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = private [< `A]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private [< `A ] end
+ is not included in
+ sig type t = private [< `A of int & float ] end
+ Type declarations do not match:
+ type t = private [< `A ]
+ is not included in
+ type t = private [< `A of int & float ]
+|}];;
+
+module M : sig
+ type t = private [> `A of int]
+end = struct
+ type t = [`A of float]
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = [`A of float]
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = [ `A of float ] end
+ is not included in
+ sig type t = private [> `A of int ] end
+ Type declarations do not match:
+ type t = [ `A of float ]
+ is not included in
+ type t = private [> `A of int ]
+|}];;
+
+module M : sig
+ type t = private <a : int; ..>
+end = struct
+ type t = <b : int>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <b : int>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < b : int > end
+ is not included in
+ sig type t = private < a : int; .. > end
+ Type declarations do not match:
+ type t = < b : int >
+ is not included in
+ type t = private < a : int; .. >
+|}];;
+
+module M : sig
+ type t = private <a : float; ..>
+end = struct
+ type t = <a : int>
+end;;
+[%%expect{|
+Lines 3-5, characters 6-3:
+3 | ......struct
+4 | type t = <a : int>
+5 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = < a : int > end
+ is not included in
+ sig type t = private < a : float; .. > end
+ Type declarations do not match:
+ type t = < a : int >
+ is not included in
+ type t = private < a : float; .. >
+|}];;
+
+type w = private float
+type q = private (int * w)
+type u = private (int * q)
+module M : sig (* Confussing error message :( *)
+ type t = private (int * (int * int))
+end = struct
+ type t = private u
+end;;
+[%%expect{|
+type w = private float
+type q = private int * w
+type u = private int * q
+Lines 6-8, characters 6-3:
+6 | ......struct
+7 | type t = private u
+8 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private u end
+ is not included in
+ sig type t = private int * (int * int) end
+ Type declarations do not match:
+ type t = private u
+ is not included in
+ type t = private int * (int * int)
+|}];;
+
+type w = float
+type q = (int * w)
+type u = private (int * q)
+module M : sig (* Confussing error message :( *)
+ type t = private (int * (int * int))
+end = struct
+ type t = private u
+end;;
+[%%expect{|
+type w = float
+type q = int * w
+type u = private int * q
+Lines 6-8, characters 6-3:
+6 | ......struct
+7 | type t = private u
+8 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private u end
+ is not included in
+ sig type t = private int * (int * int) end
+ Type declarations do not match:
+ type t = private u
+ is not included in
+ type t = private int * (int * int)
+|}];;
+
+type s = private int
+
+module M : sig
+ type t = private float
+end = struct
+ type t = private s
+end;;
+[%%expect{|
+type s = private int
+Lines 5-7, characters 6-3:
+5 | ......struct
+6 | type t = private s
+7 | end..
+Error: Signature mismatch:
+ Modules do not match:
+ sig type t = private s end
+ is not included in
+ sig type t = private float end
+ Type declarations do not match:
+ type t = private s
+ is not included in
+ type t = private float
+|}];;
and +'a abstract
module M :
sig
- type 'a user = 'a user = Foo of 'a abstract
- and 'a abstract = 'a abstract
+ type 'a user = 'a user = Foo of 'a abstract/1
+ and 'a abstract = 'a abstract/2
end
type 'a foo = 'a M.user
end
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(** Basic *)
+module type x = sig type t = int end
+
+module type t = sig
+ module type x
+ module M:x
+end
+
+module type t' = t with module type x = x
+[%%expect {|
+module type x = sig type t = int end
+module type t = sig module type x module M : x end
+module type t' = sig module type x = x module M : x end
+|}]
+
+module type t'' = t with module type x := x
+[%%expect {|
+module type t'' = sig module M : x end
+|}]
+
+module type t3 = t with module type x = sig type t end
+[%%expect {|
+module type t3 = sig module type x = sig type t end module M : x end
+|}]
+
+module type t4 = t with module type x := sig type t end
+[%%expect {|
+module type t4 = sig module M : sig type t end end
+|}]
+
+(** nested *)
+
+module type ENDO = sig
+ module Inner:
+ sig
+ module type T
+ module F: T -> T
+ end
+end
+module type ENDO_2 = ENDO with module type Inner.T = ENDO
+module type ENDO_2' = ENDO with module type Inner.T := ENDO
+[%%expect {|
+module type ENDO =
+ sig module Inner : sig module type T module F : T -> T end end
+module type ENDO_2 =
+ sig module Inner : sig module type T = ENDO module F : T -> T end end
+module type ENDO_2' = sig module Inner : sig module F : ENDO -> ENDO end end
+|}]
+
+
+module type S = sig
+ module M: sig
+ module type T
+ end
+ module N: M.T
+end
+module type R = S with module type M.T := sig end
+[%%expect {|
+module type S = sig module M : sig module type T end module N : M.T end
+module type R = sig module M : sig end module N : sig end end
+|}]
+
+
+(** Adding equalities *)
+
+module type base = sig type t = X of int | Y of float end
+
+module type u = sig
+ module type t = sig type t = X of int | Y of float end
+ module M: t
+end
+
+module type s = u with module type t := base
+[%%expect {|
+module type base = sig type t = X of int | Y of float end
+module type u =
+ sig module type t = sig type t = X of int | Y of float end module M : t end
+module type s = sig module M : base end
+|}]
+
+
+module type base = sig type t = X of int | Y of float end
+
+module type u = sig
+ type x
+ type y
+ module type t = sig type t = X of x | Y of y end
+ module M: t
+end
+
+module type r =
+ u with type x = int
+ and type y = float
+ and module type t = base
+[%%expect {|
+module type base = sig type t = X of int | Y of float end
+module type u =
+ sig
+ type x
+ type y
+ module type t = sig type t = X of x | Y of y end
+ module M : t
+ end
+module type r =
+ sig type x = int type y = float module type t = base module M : t end
+|}]
+
+module type r =
+ u with type x = int
+ and type y = float
+ and module type t := base
+[%%expect {|
+module type r = sig type x = int type y = float module M : base end
+|}]
+
+
+module type r =
+ u with type x := int
+ and type y := float
+ and module type t := base
+[%%expect {|
+module type r = sig module M : base end
+|}]
+
+(** error *)
+
+module type r =
+ u with module type t := base
+
+[%%expect {|
+Line 4, characters 2-30:
+4 | u with module type t := base
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: In this `with' constraint, the new definition of t
+ does not match its original definition in the constrained signature:
+ At position module type t = <here>
+ Module types do not match:
+ sig type t = X of x | Y of y end
+ is not equal to
+ base
+ At position module type t = <here>
+ Type declarations do not match:
+ type t = X of x | Y of y
+ is not included in
+ type t = X of int | Y of float
+ Constructors do not match:
+ X of x
+ is not compatible with:
+ X of int
+ The types are not equal.
+|}]
+
+(** First class module types require an identity *)
+
+module type fst = sig
+ module type t
+ val x: (module t)
+end
+
+module type ext
+module type fst_ext = fst with module type t = ext
+module type fst_ext = fst with module type t := ext
+[%%expect {|
+module type fst = sig module type t val x : (module t) end
+module type ext
+module type fst_ext = sig module type t = ext val x : (module t) end
+module type fst_ext = sig val x : (module ext) end
+|}]
+
+
+
+module type fst_erased = fst with module type t := sig end
+[%%expect {|
+Line 1, characters 25-58:
+1 | module type fst_erased = fst with module type t := sig end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This `with' constraint t := sig end makes a packed module ill-formed.
+|}]
+
+module type fst_ok = fst with module type t = sig end
+[%%expect {|
+module type fst_ok = sig module type t = sig end val x : (module t) end
+|}]
+
+module type S = sig
+ module M: sig
+ module type T
+ end
+ val x: (module M.T)
+end
+
+module type R = S with module type M.T := sig end
+[%%expect {|
+module type S = sig module M : sig module type T end val x : (module M.T) end
+Line 8, characters 16-49:
+8 | module type R = S with module type M.T := sig end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This `with' constraint M.T := sig end
+ makes a packed module ill-formed.
+|}]
+
+
+module type S = sig
+ module M: sig
+ module type T
+ val x: (module T)
+ end
+end
+
+module type R = S with module type M.T := sig end
+[%%expect {|
+module type S = sig module M : sig module type T val x : (module T) end end
+Line 8, characters 16-49:
+8 | module type R = S with module type M.T := sig end
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This `with' constraint T := sig end makes a packed module ill-formed.
+|}]
+
+
+(** local module type substitutions *)
+
+module type s = sig
+ module type u := sig type a type b type c end
+ module type r = sig type r include u end
+ module type s = sig include u type a = A end
+end
+[%%expect {|
+module type s =
+ sig
+ module type r = sig type r type a type b type c end
+ module type s = sig type b type c type a = A end
+ end
+|}]
+
+
+module type s = sig
+ module type u := sig type a type b type c end
+ module type wrong = sig type a include u end
+end
+[%%expect {|
+Line 3, characters 33-42:
+3 | module type wrong = sig type a include u end
+ ^^^^^^^^^
+Error: Multiple definition of the type name a.
+ Names must be unique in a given structure or signature.
+|}]
+
+module type fst = sig
+ module type t := sig end
+ val x: (module t)
+end
+[%%expect {|
+Line 3, characters 2-19:
+3 | val x: (module t)
+ ^^^^^^^^^^^^^^^^^
+Error: The module type t is not a valid type for a packed module:
+ it is defined as a local substitution for a non-path module type.
+|}]
+
+
+module type hidden = sig
+ module type t := sig type u end
+ include t
+ val x: (module t)
+ val x: int
+end
+[%%expect {|
+module type hidden = sig type u val x : int end
+|}]
sig module type S = sig type t = float val foo : t X.t end end
module N : sig module type S = sig type t = float val foo : int end end
|}]
+
+type 'a always_int = int
+module F (X : sig type t end) = struct type s = X.t always_int end
+module M = F (struct type t = T end)
+[%%expect{|
+type 'a always_int = int
+module F : functor (X : sig type t end) -> sig type s = X.t always_int end
+module M : sig type s = int end
+|}]
+
+module M = struct
+ module F (X : sig type t end) = X
+ module Not_ok = F (struct type t = private [< `A] end)
+end
+[%%expect{|
+module M :
+ sig
+ module F : functor (X : sig type t end) -> sig type t = X.t end
+ module Not_ok : sig type t end
+ end
+|}]
module IndirectPriv : sig type t end
|}]
+(* These two behave as though a functor was defined *)
+module DirectPrivEta =
+ (functor (X : sig end) -> Priv(X))(struct end);;
+[%%expect{|
+module DirectPrivEta : sig type t end
+|}]
+
+module DirectPrivEtaUnit =
+ (functor (_ : sig end) -> Priv)(struct end)(struct end);;
+[%%expect{|
+module DirectPrivEtaUnit : sig type t end
+|}]
+
(*** Test proposed by Jacques in
https://github.com/ocaml/ocaml/pull/1826#discussion_r194290729 ***)
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module type S = sig type t end
+module Res_ko =
+ (functor (X : S) -> X)(struct type t = int end)
+[%%expect{|
+module type S = sig type t end
+module Res_ko : sig type t = int end
+|}]
+
+module Res_ok2 =
+ (functor (X : S) -> struct include X end) (struct type t = int end)
+[%%expect{|
+module Res_ok2 : sig type t = int end
+|}]
+module Res_ok3 =
+ (functor (X : S) -> struct type t = X.t end) (struct type t = int end)
+[%%expect{|
+module Res_ok3 : sig type t = int end
+|}]
--- /dev/null
+(* TEST
+ * expect
+ *)
+
+module M :
+ sig type t = private [< `A | `B of string] end
+= struct type t = [`A|`B of string] end;;
+[%%expect{|
+module M : sig type t = private [< `A | `B of string ] end
+|}]
+
+module M = struct type header_item_tag =
+ [ `CO | `HD | `Other of string | `PG | `RG | `SQ ]
+end;;
+[%%expect{|
+module M :
+ sig
+ type header_item_tag = [ `CO | `HD | `Other of string | `PG | `RG | `SQ ]
+ end
+|}]
+
+module M' : sig type header_item_tag =
+ private [< `CO | `HD | `Other of string | `PG | `RG | `SQ ]
+end = M;;
+[%%expect{|
+module M' :
+ sig
+ type header_item_tag = private
+ [< `CO | `HD | `Other of string | `PG | `RG | `SQ ]
+ end
+|}]
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(**
+ Check the behavior of with constraints with respect to
+ ghost type items introduced for class and class types
+ *)
+
+module type s = sig
+ class type c = object method m: int end
+end with type c := <m : int >
+[%%expect {|
+Lines 6-8, characters 16-29:
+6 | ................sig
+7 | class type c = object method m: int end
+8 | end with type c := <m : int >
+Error: The signature constrained by `with' has no component named c
+|}]
+
+
+module type s = sig
+ class type ct = object method m: int end
+end with type ct := <m : int >
+[%%expect {|
+Lines 1-3, characters 16-30:
+1 | ................sig
+2 | class type ct = object method m: int end
+3 | end with type ct := <m : int >
+Error: The signature constrained by `with' has no component named ct
+|}]
+
+(** Check that we keep the same structure even after replacing a ghost item *)
+
+module type s = sig
+ type top
+ and t = private < .. >
+ and mid
+ and u = private < .. >
+ and v
+end with type t = private < .. >
+ with type u = private < .. >
+[%%expect {|
+module type s =
+ sig
+ type top
+ and t = private < .. >
+ and mid
+ and u = private < .. >
+ and v
+ end
+|}]
(* TEST
-files = "d.mli e.ml"
+readonly_files = "d.mli e.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "d.mli"
(* TEST
-files = "a.ml b.ml c.ml"
+readonly_files = "a.ml b.ml c.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "a.ml"
Type exp = < eval : (string, exp) Hashtbl.t -> expr >
is not compatible with type
expr = [ `Abs of string * expr | `App of expr * expr ]
+ Types for tag `App are incompatible
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
Type (id subject, id) observer = < notify : id subject -> id -> unit >
is not compatible with type
'a entity_container =
- < add_entity : (< destroy_subject : < add_observer : 'a
- entity_container ->
- 'f;
- .. >
- as 'e;
- .. >
- as 'd) ->
- 'f;
- notify : 'd -> id -> unit >
- Type entity = < destroy_subject : id subject; entity_id : id >
- is not compatible with type < destroy_subject : 'e; .. > as 'd
- Type
- id subject =
- < add_observer : (id subject, id) observer -> unit;
- notify_observers : id -> unit >
- is not compatible with type
- < add_observer : 'a entity_container -> 'f; .. > as 'e
- Type (id subject, id) observer = < notify : id subject -> id -> unit >
- is not compatible with type
- 'a entity_container =
- < add_entity : 'd -> 'f; notify : 'd -> id -> unit >
- The first object type has no method add_entity
+ < add_entity : 'a -> 'c; notify : 'a -> id -> unit >
+ Types for method add_observer are incompatible
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
Type 'a u t should be an instance of g t
|}];;
+(* Full unification trace reported for "Constraints are not satisfied in this type" *)
+type ('a,'b) t constraint 'a = 'b
+ constraint 'a = int
+ and 'a u = (float,string) t;;
+[%%expect {|
+Line 3, characters 13-29:
+3 | and 'a u = (float,string) t;;
+ ^^^^^^^^^^^^^^^^
+Error: Constraints are not satisfied in this type.
+ Type (float, string) t should be an instance of (int, int) t
+ Type float is not compatible with type int
+|}]
+
(* Example of wrong expansion *)
type 'a u = < m : 'a v > and 'a v = 'a list u;;
[%%expect {|
|}];;
(* pass typetexp, but fails during Typedecl.check_recursion *)
-type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
-and ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];;
-[%%expect {|
-Line 1, characters 0-71:
-1 | type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b]
- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: The definition of a contains a cycle:
- [> `B of ('a, 'b) b as 'b ] as 'a
+type ('a1, 'b1) ty1 = 'a1 -> unit constraint 'a1 = [> `V1 of ('a1, 'b1) ty2 as 'b1]
+and ('a2, 'b2) ty2 = 'b2 -> unit constraint 'b2 = [> `V2 of ('a2, 'b2) ty1 as 'a2];;
+[%%expect {|
+Line 1, characters 0-83:
+1 | type ('a1, 'b1) ty1 = 'a1 -> unit constraint 'a1 = [> `V1 of ('a1, 'b1) ty2 as 'b1]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: The definition of ty1 contains a cycle:
+ [> `V1 of ('a, 'b) ty2 as 'b ] as 'a
|}];;
(* PR#8359: expanding may change original in Ctype.unify2 *)
< m : 'left 'right. < left : 'left; right : 'right > pair >
but an expression was expected of type
< m : 'left 'right. < left : 'left; right : 'right > pair >
- Type < left : 'left; right : 'right > pair = 'a * 'b
- is not compatible with type < left : 'left0; right : 'right0 > pair
- The method left has type 'a, but the expected method type was 'left
- The universal variable 'left would escape its scope
+ Types for method m are incompatible
|}]
File "pr3918c.ml", line 24, characters 11-12:
24 | let f x = (x : 'a vlist :> 'b vlist)
^
-Error: This expression has type 'b Pr3918b.vlist = 'a
+Error: This expression has type 'b Pr3918b.vlist
but an expression was expected of type 'b Pr3918b.vlist
- The type variable 'a occurs inside ('d * 'c) Pr3918a.voption as 'c
(* TEST
-files = "pr3918a.mli pr3918b.mli"
+readonly_files = "pr3918a.mli pr3918b.mli"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "pr3918a.mli"
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
--- /dev/null
+(* TEST
+ * expect
+*)
+
+module A = struct type t = A | B let x = B end;;
+[%%expect{|
+module A : sig type t = A | B val x : t end
+|}]
+
+let test () =
+ match A.x with
+ | A as a -> `A_t a
+ | B when false -> `Onoes
+ | B -> if Random.bool () then `Onoes else `A_t B;;
+[%%expect{|
+val test : unit -> [> `A_t of A.t | `Onoes ] = <fun>
+|}, Principal{|
+Line 5, characters 49-50:
+5 | | B -> if Random.bool () then `Onoes else `A_t B;;
+ ^
+Error: Unbound constructor B
+|}]
+
+let test () =
+ match A.x with
+ | B when false -> `Onoes
+ | A as a -> `A_t a
+ | B -> if Random.bool () then `Onoes else `A_t B;;
+[%%expect{|
+val test : unit -> [> `A_t of A.t | `Onoes ] = <fun>
+|}, Principal{|
+Line 5, characters 49-50:
+5 | | B -> if Random.bool () then `Onoes else `A_t B;;
+ ^
+Error: Unbound constructor B
+|}]
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(** Error message for trying to make private a row type variable
+ that only exists syntactically *)
+
+type a = [`A | `C | `D]
+type b = [`B | `D | `E]
+type c = private [< a | b > `A `B `C `D `E]
+[%%expect {|
+type a = [ `A | `C | `D ]
+type b = [ `B | `D | `E ]
+Line 6, characters 0-43:
+6 | type c = private [< a | b > `A `B `C `D `E]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This private row type declaration is invalid.
+ The type expression on the right-hand side reduces to
+ [ `A | `B | `C | `D | `E ]
+ which does not have a free row type variable.
+ Hint: If you intended to define a private type abbreviation,
+ write explicitly
+ private [ `A | `B | `C | `D | `E ]
+|}]
+
+type u = private < x:int; .. > as 'a constraint 'a = < x: int > ;;
+[%%expect {|
+Line 1, characters 0-63:
+1 | type u = private < x:int; .. > as 'a constraint 'a = < x: int > ;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This private row type declaration is invalid.
+ The type expression on the right-hand side reduces to
+ < x : int >
+ which does not have a free row type variable.
+ Hint: If you intended to define a private type abbreviation,
+ write explicitly
+ private < x : int >
+|}]
+
+type u = private [> `A ] as 'a constraint 'a = [< `A ] ;;
+[%%expect {|
+Line 1, characters 0-54:
+1 | type u = private [> `A ] as 'a constraint 'a = [< `A ] ;;
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This private row type declaration is invalid.
+ The type expression on the right-hand side reduces to
+ [ `A ]
+ which does not have a free row type variable.
+ Hint: If you intended to define a private type abbreviation,
+ write explicitly
+ private [ `A ]
+|}]
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a "
+flags = " -w -a "
* setup-ocamlc.byte-build-env
** ocamlc.byte
*** check-ocamlc.byte-output
(* TEST
-flags = " -w a -rectypes "
+flags = " -w -a -rectypes "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a -rectypes "
+flags = " -w -a -rectypes "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = " -w a -rectypes "
+flags = " -w -a -rectypes "
ocamlc_byte_exit_status = "2"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-files = "a.ml"
+readonly_files = "a.ml"
* setup-ocamlc.byte-build-env
** ocamlc.byte
module = "a.ml"
(* TEST
- files = "largeFile.ml"
+ readonly_files = "largeFile.ml"
* setup-ocaml-build-env
** ocamlc.byte
compile_only = "true"
5 | let x : M.t = S
^
Error: This variant expression is expected to have type t
- The constructor S does not belong to type t
+ There is no constructor S within type t
|}]
module M = struct
Line 4, characters 9-10:
4 | and u3 = char
^
-Error: Syntax error: 'end' expected
-Line 2, characters 24-27:
-2 | module type Rejected3 = sig
- ^^^
- This 'sig' might be unmatched
+Error: Syntax error
Line 3, characters 7-13:
3 | type nonrec t := int
^^^^^^
val create : elt -> t
is not included in
val create : unit -> t
- File "test_functor.ml", line 5, characters 2-23: Expected declaration
+ File "test_loc_type_subst.ml", line 1, characters 11-47:
+ Expected declaration
File "test_functor.ml", line 5, characters 2-23: Actual declaration
File "test_loc_modtype_type_subst.ml", line 3, characters 15-42:
3 | module M : S = Test_functor.Apply (String)
val create : elt -> t
is not included in
val create : unit -> t
- File "test_functor.ml", line 5, characters 2-23: Expected declaration
+ File "test_loc_modtype_type_subst.ml", line 1, characters 16-52:
+ Expected declaration
File "test_functor.ml", line 5, characters 2-23: Actual declaration
(* TEST
-files = "test_functor.ml test_loc_modtype_type_eq.ml \
+readonly_files = "test_functor.ml test_loc_modtype_type_eq.ml \
test_loc_modtype_type_subst.ml test_loc_type_eq.ml \
test_loc_type_subst.ml mpr7852.mli"
* setup-ocamlc.byte-build-env
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
2 | | ((Val x, _) | (_, Val x)) when x < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 9.5)
+variable x may match different arguments. (See manual section 11.5)
val ambiguous_typical_example : expr * expr -> unit = <fun>
|}]
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when y -> ignore x
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 9.5)
+variable y may match different arguments. (See manual section 11.5)
val ambiguous__y : [> `B of 'a * bool option * bool option ] -> unit = <fun>
|}]
2 | | (`B (x, _, Some y) | `B (x, Some y, _)) when x < y -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 9.5)
+variable y may match different arguments. (See manual section 11.5)
val ambiguous__x_y : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
2 | | (`B (x, z, Some y) | `B (x, Some y, z)) when x < y || Some x = z -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables y,z may match different arguments. (See manual section 9.5)
+variables y,z may match different arguments. (See manual section 11.5)
val ambiguous__x_y_z : [> `B of 'a * 'a option * 'a option ] -> unit = <fun>
|}]
2 | | `A (`B (Some x, _) | `B (_, Some x)) when x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 9.5)
+variable x may match different arguments. (See manual section 11.5)
val ambiguous__in_depth :
[> `A of [> `B of bool option * bool option ] ] -> unit = <fun>
|}]
2 | ....`A ((`B (Some x, _) | `B (_, Some x)),
3 | (`C (Some y, Some _, _) | `C (Some y, _, Some _))).................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 9.5)
+variable x may match different arguments. (See manual section 11.5)
val ambiguous__first_orpat :
[> `A of
[> `B of 'a option * 'a option ] *
2 | ....`A ((`B (Some x, Some _, _) | `B (Some x, _, Some _)),
3 | (`C (Some y, _) | `C (_, Some y))).................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 9.5)
+variable y may match different arguments. (See manual section 11.5)
val ambiguous__second_orpat :
[> `A of
[> `B of 'a option * 'b option * 'c option ] *
2 | ..X (Z x,Y (y,0))
3 | | X (Z y,Y (x,_))
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 9.5)
+variables x,y may match different arguments. (See manual section 11.5)
val ambiguous__amoi : amoi -> int = <fun>
|}]
2 | ....(module M:S),_,(1,_)
3 | | _,(module M:S),(_,1)...................
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable M may match different arguments. (See manual section 9.5)
+variable M may match different arguments. (See manual section 11.5)
val ambiguous__module_variable :
(module S) * (module S) * (int * int) -> bool -> int = <fun>
|}]
2 | | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 9.5)
+variables x,y may match different arguments. (See manual section 11.5)
val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
<fun>
|}, Principal{|
2 | | A (x as z,(0 as y))|A (0 as y as z,x)|B (x,(y as z)) when g x (y+z) -> 1
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variables x,y may match different arguments. (See manual section 9.5)
+variables x,y may match different arguments. (See manual section 11.5)
val ambiguous_xy_but_not_ambiguous_z : (int -> int -> bool) -> t2 -> int =
<fun>
|}]
3 | | ((Val y, _) | (_, Val y)) when y < 0 -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable y may match different arguments. (See manual section 9.5)
+variable y may match different arguments. (See manual section 11.5)
val guarded_ambiguity : expr * expr -> unit = <fun>
|}]
4 | | ((Val x, _) | (_, Val x)) when pred x -> ()
^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 57 [ambiguous-var-in-pattern-guard]: Ambiguous or-pattern variables under guard;
-variable x may match different arguments. (See manual section 9.5)
+variable x may match different arguments. (See manual section 11.5)
val cmp : (a -> bool) -> a alg -> a alg -> unit = <fun>
|}]
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A-41-42-18"
+ flags = " -w +A-41-42-18"
* expect
*)
module T1 : sig end = struct
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* toplevel
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
(* TEST
- flags = " -w A "
+ flags = " -w +A "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
4 | let b : bar = {x=3; y=4}
^
Error: This record expression is expected to have type bar
- The field y does not belong to type bar
+ There is no field y within type bar
|}]
module M = struct type foo = {x:int;y:int} end;;
3 | let f r = ignore (r: foo); {r with x = 2; z = 3}
^
Error: This record expression is expected to have type M.foo
- The field z does not belong to type M.foo
+ There is no field z within type M.foo
|}]
module M = struct
include M
3 | let f r = ignore (r: foo); { r with x = 3; a = 4 }
^
Error: This record expression is expected to have type M.foo
- The field a does not belong to type M.foo
+ There is no field a within type M.foo
|}]
module F7 = struct
open M
4 | let r: other = {x=1; y=2}
^
Error: This record expression is expected to have type M.other
- The field x does not belong to type M.other
+ There is no field x within type M.other
|}]
module A = struct type t = {x: int} end
3 | let a : t = {x=1;yyz=2}
^^^
Error: This record expression is expected to have type t
- The field yyz does not belong to type t
+ There is no field yyz within type t
Hint: Did you mean yyy?
|}]
(* TEST
- flags = " -w A "
+ flags = " -w +A "
* expect
*)
(* TEST
- flags = " -w A -strict-sequence "
+ flags = " -w +A -strict-sequence "
* expect
*)
Warning 34 [unused-type-declaration]: unused type t.
module Unused_constructor_disable_warning : sig end
|}]
+
+
+module Unused_record : sig end = struct
+ type t = { a : int; b : int }
+ let foo (x : t) = x
+ let _ = foo
+end;;
+[%%expect {|
+Line 2, characters 13-21:
+2 | type t = { a : int; b : int }
+ ^^^^^^^^
+Warning 69 [unused-field]: unused record field a.
+Line 2, characters 22-29:
+2 | type t = { a : int; b : int }
+ ^^^^^^^
+Warning 69 [unused-field]: unused record field b.
+module Unused_record : sig end
+|}]
+
+module Unused_field : sig end = struct
+ type t = { a : int }
+ let foo () = { a = 0 }
+ let _ = foo
+end;;
+[%%expect {|
+Line 2, characters 13-20:
+2 | type t = { a : int }
+ ^^^^^^^
+Warning 69 [unused-field]: record field a is never read.
+(However, this field is used to build or mutate values.)
+module Unused_field : sig end
+|}]
+
+module Unused_field : sig end = struct
+ type t = { a : int; b : int; c : int }
+ let foo () = { a = 0; b = 0; c = 0 }
+ let bar x = x.a
+ let baz { c; _ } = c
+ let _ = foo, bar, baz
+end;;
+[%%expect {|
+Line 2, characters 22-30:
+2 | type t = { a : int; b : int; c : int }
+ ^^^^^^^^
+Warning 69 [unused-field]: record field b is never read.
+(However, this field is used to build or mutate values.)
+module Unused_field : sig end
+|}]
+
+module Unused_mutable_field : sig end = struct
+ type t = { a : int; mutable b : int }
+ let foo () = { a = 0; b = 0 }
+ let bar x = x.a, x.b
+ let _ = foo, bar
+end;;
+[%%expect {|
+Line 2, characters 22-37:
+2 | type t = { a : int; mutable b : int }
+ ^^^^^^^^^^^^^^^
+Warning 69 [unused-field]: mutable record field b is never mutated.
+module Unused_mutable_field : sig end
+|}]
+
+module Unused_field_exported_private : sig
+ type t = private { a : int }
+end = struct
+ type t = { a : int }
+end;;
+[%%expect {|
+module Unused_field_exported_private : sig type t = private { a : int; } end
+|}]
+
+module Unused_field_exported_private : sig
+ type t = private { a : int }
+end = struct
+ type t = { a : int }
+ let foo x = x.a
+ let _ = foo
+end;;
+[%%expect {|
+module Unused_field_exported_private : sig type t = private { a : int; } end
+|}]
+
+module Unused_mutable_field_exported_private : sig
+ type t = private { a : int; mutable b : int }
+end = struct
+ type t = { a : int; mutable b : int }
+ let foo () = { a = 0; b = 0 }
+ let _ = foo
+end;;
+[%%expect {|
+Line 4, characters 22-37:
+4 | type t = { a : int; mutable b : int }
+ ^^^^^^^^^^^^^^^
+Warning 69 [unused-field]: mutable record field b is never mutated.
+module Unused_mutable_field_exported_private :
+ sig type t = private { a : int; mutable b : int; } end
+|}]
(* TEST
-files = "common.mli common.ml test_common.c test_common.h"
+readonly_files = "common.mli common.ml test_common.c test_common.h"
* setup-ocamlopt.byte-build-env
** ocaml
(* TEST
script = "sh ${test_source_directory}/check-linker-version.sh"
-files = "mylib.mli mylib.ml stack_walker.c"
+readonly_files = "mylib.mli mylib.ml stack_walker.c"
* macos
** arch_amd64
(* TEST
-flags = "-w A"
+flags = "-w +A"
* bytecode
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* bytecode
* setup-ocamlc.byte-build-env
** ocamlc.byte
-flags = "-w a"
+flags = "-w -a"
module = "deprecated_module.mli"
*** ocamlc.byte
module = "deprecated_module.ml"
**** ocamlc.byte
-flags = "-w A"
+flags = "-w +A-70"
module = "deprecated_module_use.ml"
***** check-ocamlc.byte-output
--- /dev/null
+(* TEST
+ * expect
+*)
+
+(** Deprecated sequences of unsigned letters *)
+
+[@@@warning "fragile-math"]
+[%%expect {|
+Line 3, characters 0-27:
+3 | [@@@warning "fragile-math"]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert ocaml_deprecated_cli: Setting a warning with a sequence of lowercase or uppercase letters,
+like 'ath', is deprecated.
+Use the equivalent signed form: -f-r-a-g-i-l-e-m-a-t-h.
+Hint: Enabling or disabling a warning by its mnemonic name requires a + or - prefix.
+Hint: Did you make a spelling mistake when using a mnemonic name?
+|}]
+
+[@@@warning "ab-cdg+efh"]
+[%%expect {|
+Line 1, characters 0-25:
+1 | [@@@warning "ab-cdg+efh"]
+ ^^^^^^^^^^^^^^^^^^^^^^^^^
+Alert ocaml_deprecated_cli: Setting a warning with a sequence of lowercase or uppercase letters,
+like 'fh', is deprecated.
+Use the equivalent signed form: -a-b-c-d-g+e-f-h.
+Hint: Enabling or disabling a warning by its mnemonic name requires a + or - prefix.
+|}]
+
+
+(** -w "a+10..." and -w "A-10..." are still supported *)
+[@@@warning "a+1..20+50"]
+[%%expect {|
+|}]
+
+[@@@warning "A-3..14-56"]
+[%%expect {|
+|}]
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
- flags = "-w A"
+ flags = "-w +A-70"
* expect
*)
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
- flags = "-w A"
+ flags = "-w +A"
* expect
*)
^^^^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
|}];;
let () = try () with Match_failure ("Any",_,_) -> ();;
^^^^^^^^^^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
|}];;
let () = try () with Match_failure (_,0,_) -> ();;
^^^^^^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
|}];;
type t =
^^^^^^^^^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
val f : t -> unit = <fun>
|}];;
^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
val g : t -> unit = <fun>
|}];;
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 52 [fragile-literal-pattern]: Code should not depend on the actual values of
this constructor's arguments. They are only for information
-and may change in future versions. (See manual section 9.5)
+and may change in future versions. (See manual section 11.5)
val j : t -> unit = <fun>
|}];;
(* TEST
-flags = "-w A-60"
+flags = "-w +A-60-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
compile_only = "true"
* setup-ocamlc.byte-build-env
(* TEST
-flags = "-w A"
-files = "module_without_cmx.mli"
+flags = "-w +A-70"
+readonly_files = "module_without_cmx.mli"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
compile_only = "true"
* setup-ocamlc.byte-build-env
(* TEST
-flags = "-w A-67"
+flags = "-w +A-67"
* setup-ocamlc.byte-build-env
** ocamlc.byte
(* TEST
-flags = "-w A"
+flags = "-w +A-70"
* setup-ocamlopt.byte-build-env
** ocamlopt.byte
(* TEST
include unix
-flags += "-strict-sequence -safe-string -w A -warn-error A"
+flags += "-strict-sequence -safe-string -w +A -warn-error +A"
* windows-unicode
** toplevel
*)
.NOTPARALLEL:
-TOPDIR = ../..
+ROOTDIR = ../..
-COMPILERLIBSDIR = $(TOPDIR)/compilerlibs
+COMPILERLIBSDIR = $(ROOTDIR)/compilerlibs
RUNTIME_VARIANT ?=
ASPPFLAGS ?=
-include $(TOPDIR)/Makefile.tools
+include $(ROOTDIR)/Makefile.common
+include $(ROOTDIR)/Makefile.best_binaries
+
+STDLIBFLAGS = -nostdlib -I $(ROOTDIR)/stdlib
+OCAMLC ?= $(BEST_OCAMLC) $(STDLIBFLAGS)
+OCAMLOPT ?= $(BEST_OCAMLOPT) $(STDLIBFLAGS)
expect_MAIN=expect_test
expect_PROG=$(expect_MAIN)$(EXE)
expect_DIRS = parsing utils driver typing toplevel
-expect_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/,$(expect_DIRS))
+expect_OCAMLFLAGS = $(addprefix -I $(ROOTDIR)/,$(expect_DIRS))
expect_LIBS := $(addprefix $(COMPILERLIBSDIR)/,\
ocamlcommon ocamlbytecomp ocamltoplevel)
codegen_PROG = codegen$(EXE)
codegen_DIRS = parsing utils typing middle_end bytecomp lambda asmcomp
-codegen_OCAMLFLAGS = $(addprefix -I $(TOPDIR)/, $(codegen_DIRS)) -w +40 -g
+codegen_OCAMLFLAGS = $(addprefix -I $(ROOTDIR)/, $(codegen_DIRS)) -w +40 -g
codegen_LIBS = $(addprefix $(COMPILERLIBSDIR)/,\
ocamlcommon ocamloptcomp)
codegen_main.cmo: parsecmm.cmo
$(codegen_PROG): $(codegen_OBJECTS)
- $(OCAMLC) -o $@ $(codegen_LIBS:=.cma) $^
-
-parsecmm.mli parsecmm.ml: parsecmm.mly
- $(OCAMLYACC) -q parsecmm.mly
-
-lexcmm.ml: lexcmm.mll
- $(OCAMLLEX) -q lexcmm.mll
+ $(OCAMLC) -o $@ $(COMPFLAGS) $(codegen_LIBS:=.cma) $^
parsecmmaux.cmo: parsecmmaux.cmi
$(ASM) $@ $^ | tail -n +2
%.cmi: %.mli
- $(OCAMLC) -c $<
+ $(OCAMLC) $(COMPFLAGS) -c $<
%.cmo: %.ml
- $(OCAMLC) -c $<
+ $(OCAMLC) $(COMPFLAGS) -c $<
%.cmx: %.ml
- $(OCAMLOPT) -c $<
+ $(OCAMLOPT) $(COMPFLAGS) -c $<
%.$(O): %.S
$(ASPP) $(ASPPFLAGS) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $<
Emitaux.output_channel := open_out out_name
end; (* otherwise, stdout *)
Compilenv.reset "test";
+ Clflags.cmm_invariants := true;
Emit.begin_assembly();
let ic = open_in filename in
let lb = Lexing.from_channel ic in
let ppb = Format.formatter_of_buffer buf in
let out_functions = Format.pp_get_formatter_out_functions ppb () in
- List.iter (fun pp -> Format.pp_print_flush pp ()) pps;
+ List.iter ~f:(fun pp -> Format.pp_print_flush pp ()) pps;
let save =
- List.map (fun pp -> Format.pp_get_formatter_out_functions pp ()) pps
+ List.map ~f:(fun pp -> Format.pp_get_formatter_out_functions pp ()) pps
in
let restore () =
List.iter2
- (fun pp out_functions ->
+ ~f:(fun pp out_functions ->
Format.pp_print_flush pp ();
Format.pp_set_formatter_out_functions pp out_functions)
pps save
in
List.iter
- (fun pp -> Format.pp_set_formatter_out_functions pp out_functions)
+ ~f:(fun pp -> Format.pp_set_formatter_out_functions pp out_functions)
pps;
match f () with
| x -> restore (); x
ocamldep.cmx : \
../driver/makedepend.cmx
ocamlmklib.cmo : \
- ocamlmklibconfig.cmo \
../utils/misc.cmi \
../utils/config.cmi
ocamlmklib.cmx : \
- ocamlmklibconfig.cmx \
../utils/misc.cmx \
../utils/config.cmx
-ocamlmklibconfig.cmo :
-ocamlmklibconfig.cmx :
ocamlmktop.cmo : \
../utils/config.cmi \
../utils/ccomp.cmi
#* *
#**************************************************************************
-MAKEFLAGS := -r -R
ROOTDIR = ..
-
+# NOTE: it is important that OCAMLLEX is defined *before* Makefile.common
+# gets included, so that its definition here takes precedence
+# over the one there.
+OCAMLLEX ?= $(BOOT_OCAMLLEX)
include $(ROOTDIR)/Makefile.common
-DESTDIR ?=
# Setup GNU make variables storing per-target source and target,
# a list of installed tools, and a function to quote a filename for
# the shell.
-override installed_tools := ocamldep ocamlprof ocamlcp ocamloptp \
+installed_tools := ocamldep ocamlprof ocamlcp ocamloptp \
ocamlmktop ocamlmklib ocamlobjinfo
install_files :=
$(patsubst %.cmo,%.cmx,$(patsubst %.cma,%.cmxa,$1))
endef
-# $1 = target, $2 = OCaml object dependencies, $3 = other dependencies
-# There is a lot of subtle code here. The multiple layers of expansion
-# are due to `make`'s eval() function, which evaluates the string
-# passed to it as a makefile fragment. So it is crucial that variables
-# not get expanded too many times.
-define byte_and_opt_
-# This check is defensive programming
-$(and $(filter-out 1,$(words $1)),$(error \
- cannot build file with whitespace in name))
-$(call PROGRAM_SYNONYM, $1)
-
-$1$(EXE): $3 $2
- $$(CAMLC) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ $2
-
-$(call PROGRAM_SYNONYM, $1.opt)
-
-$1.opt$(EXE): $3 $$(call byte2native,$2)
- $$(CAMLOPT_CMD) $$(LINKFLAGS) -I $$(ROOTDIR) -o $$@ \
- $$(call byte2native,$2)
-
-all: $1
-
-opt.opt: $1.opt
-
-ifeq '$(filter $(installed_tools),$1)' '$1'
-install_files += $1
-endif
-clean::
- rm -f -- $1 $1.opt $1.exe $1.opt.exe
-
-endef
-
-# Escape any $ characters in the arguments and eval the result.
-define byte_and_opt
-$(eval $(call \
- byte_and_opt_,$(subst $$,$$$$,$1),$(subst $$,$$$$,$2),$(subst $$,$$$$,$3)))
-endef
-
CAMLC = $(BOOT_OCAMLC) -g -nostdlib -I $(ROOTDIR)/boot \
-use-prims $(ROOTDIR)/runtime/primitives -I $(ROOTDIR)
-CAMLOPT = $(CAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) -g -nostdlib -I $(ROOTDIR)/stdlib
-CAMLLEX = $(CAMLRUN) $(ROOTDIR)/boot/ocamllex
+CAMLOPT = $(OCAMLRUN) $(ROOTDIR)/ocamlopt$(EXE) \
+ -g -nostdlib -I $(ROOTDIR)/stdlib
INCLUDES = $(addprefix -I $(ROOTDIR)/,utils parsing typing bytecomp \
middle_end middle_end/closure middle_end/flambda \
middle_end/flambda/base_types driver toplevel \
file_formats lambda)
-COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48 -strict-sequence -warn-error A \
- -principal -safe-string -strict-formats -bin-annot $(INCLUDES)
+COMPFLAGS = -absname -w +a-4-9-41-42-44-45-48-70 -strict-sequence \
+-warn-error +A -principal -safe-string -strict-formats -bin-annot $(INCLUDES)
LINKFLAGS = $(INCLUDES)
VPATH := $(filter-out -I,$(INCLUDES))
+programs_byte := \
+ ocamldep ocamlprof ocamlcp ocamloptp ocamlmklib \
+ ocamlmktop ocamlcmt dumpobj ocamlobjinfo \
+ primreq stripdebug cmpbyt
+install_files += $(filter $(installed_tools), $(programs_byte))
+programs_opt := $(programs_byte:%=%.opt)
+
.PHONY: all allopt opt.opt # allopt and opt.opt are synonyms
+all: $(programs_byte)
+opt.opt: $(programs_opt)
allopt: opt.opt
+$(foreach program, $(programs_byte) $(programs_opt),\
+ $(eval $(call PROGRAM_SYNONYM,$(program))))
+
+$(programs_byte:%=%$(EXE)):
+ $(CAMLC) $(LINKFLAGS) -I $(ROOTDIR) -o $@ $(filter-out %.cmi,$^)
+
+$(programs_opt:%=%$(EXE)):
+ $(CAMLOPT_CMD) $(LINKFLAGS) -I $(ROOTDIR) -o $@ $(filter-out %.cmi,$^)
+
+clean::
+ rm -f $(programs_byte) $(programs_byte:%=%.exe)
+ rm -f $(programs_opt) $(programs_opt:%=%.exe)
+
# The dependency generator
-CAMLDEP_OBJ=ocamldep.cmo
-CAMLDEP_IMPORTS= \
+OCAMLDEP = \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
- $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma
-ocamldep$(EXE): LINKFLAGS += -compat-32
-$(call byte_and_opt,ocamldep,$(CAMLDEP_IMPORTS) $(CAMLDEP_OBJ),)
-ocamldep$(EXE): depend.cmi
-ocamldep.opt$(EXE): depend.cmi
+ $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+ ocamldep.cmo depend.cmi
-clean::
- rm -f ocamldep ocamldep.exe ocamldep.opt ocamldep.opt.exe
+ocamldep$(EXE): LINKFLAGS += -compat-32
+ocamldep$(EXE): $(OCAMLDEP)
+ocamldep.opt$(EXE): $(call byte2native, $(OCAMLDEP))
# The profiler
-CSLPROF=ocamlprof.cmo
-CSLPROF_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
+OCAMLPROF=config.cmo build_path_prefix_map.cmo misc.cmo identifiable.cmo \
numbers.cmo arg_helper.cmo clflags.cmo terminfo.cmo \
warnings.cmo location.cmo longident.cmo docstrings.cmo \
syntaxerr.cmo ast_helper.cmo \
camlinternalMenhirLib.cmo parser.cmo \
pprintast.cmo \
- lexer.cmo parse.cmo
+ lexer.cmo parse.cmo ocamlprof.cmo
-$(call byte_and_opt,ocamlprof,$(CSLPROF_IMPORTS) profiling.cmo $(CSLPROF),)
+ocamlprof$(EXE): $(OCAMLPROF)
+ocamlprof.opt$(EXE): $(call byte2native, $(OCAMLPROF))
+all: profiling.cmo
+opt.opt: profiling.cmx
-ocamlcp_cmos = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
- warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
- clflags.cmo local_store.cmo \
- terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
- main_args.cmo
+OCAMLCP = config.cmo build_path_prefix_map.cmo misc.cmo profile.cmo \
+ warnings.cmo identifiable.cmo numbers.cmo arg_helper.cmo \
+ clflags.cmo local_store.cmo \
+ terminfo.cmo location.cmo load_path.cmo ccomp.cmo compenv.cmo \
+ main_args.cmo
-$(call byte_and_opt,ocamlcp,$(ocamlcp_cmos) ocamlcp.cmo,)
-$(call byte_and_opt,ocamloptp,$(ocamlcp_cmos) ocamloptp.cmo,)
+ocamlcp$(EXE): $(OCAMLCP) ocamlcp.cmo
+ocamlcp.opt$(EXE): $(call byte2native, $(OCAMLCP) ocamlcp.cmo)
+ocamloptp$(EXE): $(OCAMLCP) ocamloptp.cmo
+ocamloptp.opt$(EXE): $(call byte2native, $(OCAMLCP) ocamloptp.cmo)
opt:: profiling.cmx
"$(INSTALL_LIBDIR)"
# To help building mixed-mode libraries (OCaml + C)
+OCAMLMKLIB = config.cmo build_path_prefix_map.cmo misc.cmo ocamlmklib.cmo
-$(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo \
- build_path_prefix_map.cmo misc.cmo ocamlmklib.cmo,)
-
-
-ocamlmklibconfig.ml: $(ROOTDIR)/Makefile.config Makefile
- (echo 'let bindir = "$(BINDIR)"'; \
- echo 'let supports_shared_libraries = $(SUPPORTS_SHARED_LIBRARIES)';\
- echo 'let default_rpath = "$(RPATH)"'; \
- echo 'let mksharedlibrpath = "$(MKSHAREDLIBRPATH)"'; \
- echo 'let toolpref = "$(TOOLPREF)"';) \
- > ocamlmklibconfig.ml
-
-beforedepend:: ocamlmklibconfig.ml
-
-clean::
- rm -f ocamlmklibconfig.ml
+ocamlmklib$(EXE): $(OCAMLMKLIB)
+ocamlmklib.opt$(EXE): $(call byte2native, $(OCAMLMKLIB))
# To make custom toplevels
-OCAMLMKTOP=ocamlmktop.cmo
-OCAMLMKTOP_IMPORTS=config.cmo build_path_prefix_map.cmo misc.cmo \
+OCAMLMKTOP=config.cmo build_path_prefix_map.cmo misc.cmo \
identifiable.cmo numbers.cmo arg_helper.cmo clflags.cmo \
- local_store.cmo load_path.cmo profile.cmo ccomp.cmo
+ local_store.cmo load_path.cmo profile.cmo ccomp.cmo ocamlmktop.cmo
-$(call byte_and_opt,ocamlmktop,$(OCAMLMKTOP_IMPORTS) $(OCAMLMKTOP),)
+ocamlmktop$(EXE): $(OCAMLMKTOP)
+ocamlmktop.opt$(EXE): $(call byte2native, $(OCAMLMKTOP))
# Converter olabl/ocaml 2.99 to ocaml 3
# Reading cmt files
-ocamlcmt_objects= \
+OCAMLCMT = \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
- \
ocamlcmt.cmo
-# Reading cmt files
-$(call byte_and_opt,ocamlcmt,$(ocamlcmt_objects),)
+ocamlcmt$(EXE): $(OCAMLCMT)
+ocamlcmt.opt$(EXE): $(call byte2native, $(OCAMLCMT))
install::
if test -f ocamlcmt.opt$(EXE); then \
DUMPOBJ= \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
- \
opnames.cmo dumpobj.cmo
-$(call byte_and_opt,dumpobj,$(DUMPOBJ),)
+dumpobj$(EXE): $(DUMPOBJ)
+dumpobj.opt$(EXE): $(call byte2native, $(DUMPOBJ))
make_opcodes := make_opcodes$(EXE)
$(CAMLC) $< -o $@
opnames.ml: $(ROOTDIR)/runtime/caml/instruct.h $(make_opcodes)
- $(ROOTDIR)/runtime/ocamlrun$(EXE) $(make_opcodes) -opnames < $< > $@
+ $(NEW_OCAMLRUN) $(make_opcodes) -opnames < $< > $@
clean::
rm -f opnames.ml make_opcodes make_opcodes.exe make_opcodes.ml
DEF_SYMBOL_PREFIX = '-Dsymbol_prefix="_"'
endif
-OBJINFO=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
- $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
- $(ROOTDIR)/compilerlibs/ocamlmiddleend.cma \
- objinfo.cmo
+OCAMLOBJINFO=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+ $(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
+ $(ROOTDIR)/compilerlibs/ocamlmiddleend.cma \
+ objinfo.cmo
-$(call byte_and_opt,ocamlobjinfo,$(OBJINFO),)
+ocamlobjinfo$(EXE): $(OCAMLOBJINFO)
+ocamlobjinfo.opt$(EXE): $(call byte2native, $(OCAMLOBJINFO))
-primreq=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+PRIMREQ=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
primreq.cmo
# Scan object files for required primitives
-$(call byte_and_opt,primreq,$(primreq),)
+primreq$(EXE): $(PRIMREQ)
+primreq.opt$(EXE): $(call byte2native, $(PRIMREQ))
LINTAPIDIFF=$(ROOTDIR)/compilerlibs/ocamlcommon.cmxa \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cmxa \
$(ROOTDIR)/compilerlibs/ocamlmiddleend.cmxa \
- $(ROOTDIR)/otherlibs/str/str.cmxa \
- lintapidiff.cmx
+ $(ROOTDIR)/otherlibs/str/str.cmxa \
+ lintapidiff.cmx
lintapidiff.opt$(EXE): INCLUDES+= -I $(ROOTDIR)/otherlibs/str
lintapidiff.opt$(EXE): $(LINTAPIDIFF)
# Copy a bytecode executable, stripping debug info
-stripdebug=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
+STRIPDEBUG=$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
stripdebug.cmo
-$(call byte_and_opt,stripdebug,$(stripdebug),)
+stripdebug$(EXE): $(STRIPDEBUG)
+stripdebug.opt$(EXE): $(call byte2native, $(STRIPDEBUG))
# Compare two bytecode executables
$(ROOTDIR)/compilerlibs/ocamlbytecomp.cma \
cmpbyt.cmo
-$(call byte_and_opt,cmpbyt,$(CMPBYT),)
+cmpbyt$(EXE): $(CMPBYT)
+cmpbyt.opt$(EXE): $(call byte2native, $(CMPBYT))
caml_tex_files := \
$(ROOTDIR)/compilerlibs/ocamlcommon.cma \
$(ROOTDIR)/otherlibs/$(UNIXLIB)/unix.cma \
caml_tex.ml
+# checkstack tool
+
+checkstack$(EXE): checkstack.$(O)
+ $(MKEXE) $(OUTPUTEXE)$@ $<
+
#Scan latex files, and run ocaml code examples
caml_tex := caml-tex$(EXE)
+# caml-tex uses str.cma and unix.cma and so must be compiled with
+# $(ROOTDIR)/ocamlc not $(ROOTDIR)/boot/ocamlc since the boot
+# compiler does not necessarily have the correct shared library
+# configuration.
$(caml_tex): INCLUDES += $(addprefix -I $(ROOTDIR)/otherlibs/,str $(UNIXLIB))
$(caml_tex): $(caml_tex_files)
- $(ROOTDIR)/runtime/ocamlrun$(EXE) $(ROOTDIR)/ocamlc$(EXE) -nostdlib \
- -I $(ROOTDIR)/stdlib $(LINKFLAGS) -linkall \
- -o $@ -no-alias-deps $^
+ $(OCAMLRUN) $(ROOTDIR)/ocamlc$(EXE) -nostdlib -I $(ROOTDIR)/stdlib \
+ $(LINKFLAGS) -linkall -o $@ -no-alias-deps $^
# we need str and unix which depend on the bytecode version of other tools
# thus we delay building caml-tex to the opt.opt stage
# Common stuff
-%.ml: %.mll
- $(CAMLLEX) $(OCAMLLEX_FLAGS) $<
-
%.cmo: %.ml
$(CAMLC) -c $(COMPFLAGS) - $<
# Remove the autom4te.cache directory to make sure we start in a clean state
rm -rf autom4te.cache
-autoconf --force --warnings=all,error
+${1-autoconf} --force --warnings=all,error
# Allow pre-processing of configure arguments for Git check-outs
# The sed call removes dra27's copyright on the whole configure script...
(* *)
(**************************************************************************)
-[@@@warning "a-40-6"]
+[@@@warning "+a-4-6-40..42-44-48"]
open StdLabels
open Str
let buffer = Buffer.create 100 in
let rec read_toplevel_stdout () =
match Unix.select[stdout_out][][] 0. with
- | [a], _, _ ->
+ | [_a], _, _ ->
let n = Unix.read stdout_out b 0 size in
Buffer.add_subbytes buffer b 0 n;
if n = size then read_toplevel_stdout ()
}
}
- BEGIN { state = "(first line)"; }
+ BEGIN { state = "(first line)"; in_recipe = 0; in_continuation = 0; }
- match($0, /\t/) {
+ # Makefile recipe automaton
+
+ # in_continuation == 1 if the line ends with a backslash
+ # in_recipe is:
+ # 0 - not in a recipe
+ # 1 - target line scanned, but not yet seen first recipe line
+ # 2 - scanning recipe lines
+
+ # Non-recipe line
+ match($0, /^[^\t#] *[^# ]/) {
+ if (!in_continuation) {
+ if (!match($0, /^(ifn?eq|else|endif)/)) {
+ in_recipe = 0;
+ }
+ }
+ }
+
+ # target: or target:: line
+ match($0, /^[^#]*[^:#]::?($|[^=])/) {
+ if (!in_continuation) {
+ in_recipe = 1;
+ }
+ }
+
+ match($0, /^\t[^\t]+$/) {
+ if (in_recipe == 0 \
+ || in_recipe == 1 && in_continuation \
+ || is_err("makefile-whitespace")) {
+ err("tab", "TAB character(s)");
+ } else {
+ ++ counts["makefile-whitespace"];
+ in_recipe = 2;
+ }
+ }
+
+ match($0, /.$/) {
+ in_continuation = (substr($0, length($0)) == "\\");
+ }
+
+ match($0, /.\t/) {
err("tab", "TAB character(s)");
t = utf8_decode($0);
if (more_columns(t, 80)){
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+set -e
+
+# Hygiene Checks: Ensure that all the .depend files are up-to-date.
+
+MSG='make alldepend is a no-op'
+
+make alldepend
+
+# note: we cannot use $? as (set -e) may be set globally,
+# and disabling it locally is not worth the hassle.
+# note: we ignore the whitespace in case different C dependency
+# detectors use different indentation styles.
+if git diff --ignore-all-space --quiet --exit-code **.depend; then
+ echo -e "$MSG: \e[32mYES\e[0m"
+else
+ echo -e "$MSG: \e[31mNO\e[0m"
+ echo "CheckDepend: failure with the following differences:"
+ git --no-pager diff --ignore-all-space **.depend
+ cat<<EOF
+------------------------------------------------------------------------
+This should be fixable by just running make alldepend after building the
+compiler.
+------------------------------------------------------------------------
+EOF
+ exit 1
+fi
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+set -e
+
+# Hygiene Checks: check that Changes has been updated in PRs
+# One of the following must be true:
+# - A commit in the PR alters the Changes file
+# - A commit in the PR contains a line like 'No change needed' ($REGEX below)
+# - The no-change-entry-needed label is applied to the PR (handled in YAML)
+
+# We need all the commits in the PR to be available
+. tools/ci/actions/deepen-fetch.sh
+
+MSG='Check Changes has been updated'
+COMMIT_RANGE="$MERGE_BASE..$PR_HEAD"
+
+# Check if Changes has been updated in the PR
+if git diff "$COMMIT_RANGE" --name-only --exit-code Changes > /dev/null; then
+ # Check if any commit messages include something like No Changes entry needed
+ REGEX='[Nn]o [Cc]hange.* needed'
+ if [[ -n $(git log --grep="$REGEX" --max-count=1 "$COMMIT_RANGE") ]]; then
+ echo -e "$MSG: \e[33mSKIPPED\e[0m (owing to commit message)"
+ else
+ echo -e "$MSG: \e[31mNO\e[0m"
+ cat <<"EOF"
+------------------------------------------------------------------------
+Most contributions should come with a message in the Changes file, as
+described in our contributor documentation:
+
+ https://github.com/ocaml/ocaml/blob/trunk/CONTRIBUTING.md#changelog
+
+Some very minor changes (typo fixes for example) may not need
+a Changes entry. In this case, you may explicitly disable this test by
+adding the code word "No change entry needed" (on a single line) to
+a commit message of the PR, or using the "no-change-entry-needed" label
+on the github pull request.
+------------------------------------------------------------------------
+EOF
+ exit 1
+ fi
+else
+ echo -e "$MSG: \e[32mYES\e[0m"
+fi
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# Hygiene Checks: ensure that configure.ac generates configure
+# This tests both branches and PRs. Any commit which updates either files which
+# affect configure (configure.ac, VERSION, aclocal.m4 and build-aux/*) and also
+# which alter this script.
+# The behaviour is slightly different for pushes vs pull requests: in a PR, all
+# commits must be correct; in a push, it must be the case that the configure is
+# correct at the tip of the branch. This allows you to push a correcting PR to
+# trunk, for example, but rejects a PR which includes bad commits (for increased
+# bisect safety).
+
+set -e
+
+if [[ $1 = 'pull_request' ]]; then
+ ALL_COMMITS_MUST_PASS=1
+else
+ ALL_COMMITS_MUST_PASS=0
+fi
+
+# We need all the commits in the PR to be available
+. tools/ci/actions/deepen-fetch.sh
+
+# Display failing commits in red for PRs and yellow for branches (error/warning)
+if ((ALL_COMMITS_MUST_PASS)); then
+ COLOR='31'
+else
+ COLOR='33'
+fi
+
+CI_SCRIPT='tools/ci/actions/check-configure.sh'
+PATHS=\
+'configure\|configure\.ac\|VERSION\|aclocal\.m4\|build-aux/.*'\
+'\|tools/autogen\|tools/git-dev-options\.sh'
+
+# $1 - commit to checkout files from
+# $2 - range of commits to diff
+# When testing a single commit, $1 and $2 will be the same; when validating the
+# tip of a branch, $1 will be HEAD and $2 will be the range of commits in the
+# branch.
+CheckTree () {
+ RET=0
+ COMMIT="$1"
+ COMMITS_TO_SEARCH="$2"
+ if git diff-tree --diff-filter=d --no-commit-id --name-only -r \
+ "$COMMITS_TO_SEARCH" | grep -qx "$PATHS\|$CI_SCRIPT"; then
+ git checkout -qB return
+ git checkout -q "$COMMIT"
+ mv configure configure.ref
+ make -s configure
+ if diff -q configure configure.ref >/dev/null ; then
+ echo -e "$COMMIT: \e[32mconfigure.ac generates configure\e[0m"
+ else
+ RET=1
+ echo -e \
+ "$COMMIT: \e[${COLOR}mconfigure.ac doesn't generate configure\e[0m"
+ fi
+ mv configure.ref configure
+ git checkout -q return
+ fi
+ return $RET
+}
+
+# $RESULT is 1 for success and 0 for error
+RESULT=1
+# We traverse the commits in commit order; if $ALL_COMMITS_MUST_PASS=0, the
+# success of the most recent commit of the branch (traversed last) will
+# override any previous failure.
+for commit in $(git rev-list "$MERGE_BASE..$PR_HEAD" --reverse); do
+ if CheckTree "$commit" "$commit"; then
+ if ((!ALL_COMMITS_MUST_PASS)); then
+ # Commit passed, so reset any previous failure
+ RESULT=1
+ fi
+ else
+ RESULT=0
+ fi
+done
+
+if ((!RESULT)); then
+ echo 'configure.ac no longer generates configure'
+ if ((ALL_COMMITS_MUST_PASS)); then
+ echo 'Please rebase the PR, editing the commits identified above and run:'
+ else
+ echo 'Please fix the branch by committing changes after running:'
+ fi
+ echo 'make -B configure'
+ exit 1
+fi
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+set -e
+
+# Hygiene Checks: Ensure that *Labels module docs are in sync with the
+# unlabelled version.
+
+MSG='CheckSyncStdlibDocs is a no-op'
+
+tools/sync_stdlib_docs
+if git diff --quiet --exit-code; then
+ echo -e "$MSG: \e[32mYES\e[0m"
+else
+ echo -e "$MSG: \e[31mNO\e[0m"
+ echo "CheckSyncStdlibDocs: failure with the following differences:"
+ git --no-pager diff
+ cat<<EOF
+------------------------------------------------------------------------
+This should be fixable by just running tools/sync_stdlib_docs and
+eviewing the changes it makes.
+------------------------------------------------------------------------
+EOF
+ git checkout .
+ exit 1
+fi
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+set -e
+
+# Test whether the manual/ has been touched by this PR.
+
+if [[ $2 = 'push' && ${11} = 'ocaml/ocaml' ]]; then
+ # Always build the manual for pushes to ocaml/ocaml
+ result=true
+else
+ # We need all the commits in the PR to be available
+ . tools/ci/actions/deepen-fetch.sh
+ if git diff "$MERGE_BASE..$PR_HEAD" --name-only --exit-code \
+ -- manual/* > /dev/null; then
+ result=false
+ else
+ result=true
+ fi
+fi
+
+echo "::set-output name=changed::$result"
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# Hygiene Checks: ensure that check-typo passes for all files
+# This tests both branches and PRs. It is capable of requiring that every commit
+# in a PR satisfies check-typo, but at present it only requires that the HEAD
+# of the branch satisfies it.
+
+set -e
+
+# Set to 1 to require all commits individually to pass check-typo
+CHECK_ALL_COMMITS=0
+
+# We need all the commits in the PR to be available
+. tools/ci/actions/deepen-fetch.sh
+
+# Test to see if any part of the directory name has been marked prune
+not_pruned () {
+ DIR=$(dirname "$1")
+ if [[ $DIR = '.' ]] ; then
+ return 0
+ else
+ case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in
+ ,set,)
+ return 1
+ ;;
+ *)
+
+ not_pruned "$DIR"
+ return $?
+ esac
+ fi
+}
+
+# $1 - commit to checkout files from
+# $2 - range of commits to diff
+CheckTypoTree () {
+ COMMIT="$1"
+ COMMITS_TO_SEARCH="$2"
+ export OCAML_CT_HEAD="$COMMIT"
+ export OCAML_CT_LS_FILES="git diff-tree --no-commit-id --name-only -r \
+$COMMITS_TO_SEARCH --"
+ export OCAML_CT_CAT='git cat-file --textconv'
+ export OCAML_CT_PREFIX="$COMMIT:"
+ GIT_INDEX_FILE=tmp-index git read-tree --reset -i "$COMMIT"
+ git diff-tree --diff-filter=d --no-commit-id --name-only -r \
+ "$COMMITS_TO_SEARCH" | (while IFS= read -r path
+ do
+ if not_pruned "$path" ; then
+ echo "Checking $COMMIT: $path"
+ if ! tools/check-typo "./$path" ; then
+ touch failed
+ fi
+ else
+ echo "NOT checking $COMMIT: $path (typo.prune)"
+ fi
+ done)
+ rm -f tmp-index
+}
+
+# tmp-index is used to ensure that correct version of .gitattributes is used by
+# check-typo
+export OCAML_CT_GIT_INDEX='tmp-index'
+export OCAML_CT_CA_FLAG='--cached'
+rm -f failed
+
+COMMIT_RANGE="$MERGE_BASE..$PR_HEAD"
+if ((CHECK_ALL_COMMITS)); then
+ # Check each commit in turn
+ for commit in $(git rev-list "$COMMIT_RANGE" --reverse); do
+ CheckTypoTree "$commit" "$commit"
+ done
+else
+ # Use the range of commits just to get the list of files to check; only HEAD
+ # is scanned.
+ CheckTypoTree "$FETCH_HEAD" "$COMMIT_RANGE"
+fi
+
+if [[ -e failed ]]; then
+ exit 1
+fi
--- /dev/null
+#!/usr/bin/env bash
+#**************************************************************************
+#* *
+#* OCaml *
+#* *
+#* David Allsopp, OCaml Labs, Cambridge. *
+#* *
+#* Copyright 2021 David Allsopp Ltd. *
+#* *
+#* All rights reserved. This file is distributed under the terms of *
+#* the GNU Lesser General Public License version 2.1, with the *
+#* special exception on linking described in the file LICENSE. *
+#* *
+#**************************************************************************
+
+# The aim of this script is to ensure that all the commits for a PR or branch
+# push are fetched. Particularly for long-lived PRs, the relevant commits for
+# the merge-base (i.e. the commit on trunk) will not be present by default.
+# For force pushes, the same can be true for branches (e.g. a rebase)
+# After running this script, 5 variables are available:
+# - FETCH_HEAD - the merge commit for a PR or the tip of the branch of a push
+# - UPSTREAM_BRANCH - the branch a PR is against or the full ref of the push
+# - UPSTREAM_SHA - the tip of UPSTREAM_BRANCH (prior to push, if applicable)
+# - PR_BRANCH - the PR's branch name; equal to $UPSTREAM_BRANCH for a push
+# - PR_HEAD - the tip of PR_BRANCH (so, for a push, the new tip after pushing)
+
+# GitHub Actions doesn't support the ternary operator, so the dance is done here
+# Each script has:
+# $1 - ref to fetch when deepening
+# $2 - event type ('pull_request' or 'push')
+# $3 - upstream branch name
+# $4 - upstream branch SHA
+# $5 - PR branch name
+# $6 - PR SHA
+# $7 - full ref being pushed
+# $8 - upstream SHA prior to push
+# $9 - repeats $7
+# $10 - upstream SHA after the push
+FETCH_REF="${1}"
+if [[ $2 = 'pull_request' ]]; then
+ shift 2
+else
+ shift 6
+fi
+
+# Record FETCH_HEAD (if it hasn't been by a previous step)
+git branch fetch_head FETCH_HEAD &> /dev/null || true
+
+FETCH_HEAD=$(git rev-parse fetch_head)
+UPSTREAM_BRANCH="$1"
+UPSTREAM_HEAD="$2"
+PR_BRANCH="$3"
+PR_HEAD="$4"
+
+# Ensure that enough has been fetched to have all the commits between the
+# the two branches.
+
+NEW=0
+# Special case: new tags and new branches will have UPSTREAM_HEAD=0\{40}
+if [[ -z ${UPSTREAM_HEAD//0/} ]]; then
+ echo "$UPSTREAM_BRANCH is new: only testing HEAD"
+ UPSTREAM_HEAD="$PR_HEAD~1"
+ NEW=1
+elif ! git log -1 "$UPSTREAM_HEAD" &> /dev/null ; then
+ echo "$UPSTREAM_BRANCH has been force-pushed"
+ git fetch origin "$UPSTREAM_HEAD" &> /dev/null
+fi
+
+if ! git merge-base "$UPSTREAM_HEAD" "$PR_HEAD" &> /dev/null; then
+ echo "Determining merge-base of $UPSTREAM_HEAD..$PR_HEAD for $PR_BRANCH"
+
+ DEEPEN=50
+ MSG='Deepening'
+
+ while ! git merge-base "$UPSTREAM_HEAD" "$PR_HEAD" &> /dev/null
+ do
+ echo " - $MSG by $DEEPEN commits from $FETCH_REF"
+ git fetch origin --deepen=$DEEPEN "$FETCH_REF" &> /dev/null
+ MSG='Further deepening'
+ ((DEEPEN*=2))
+ done
+fi
+
+MERGE_BASE=$(git merge-base "$UPSTREAM_HEAD" "$PR_HEAD")
+
+if [[ $UPSTREAM_BRANCH != $PR_BRANCH ]]; then
+ echo "$PR_BRANCH branched from $UPSTREAM_BRANCH at: $MERGE_BASE"
+elif ((!NEW)); then
+ echo "$UPSTREAM_BRANCH branched at: $MERGE_BASE"
+fi
MAKE="make $MAKE_ARG"
SHELL=dash
+MAKE_WARN="$MAKE --warn-undefined-variables"
+
export PATH=$PREFIX/bin:$PATH
Configure () {
}
Build () {
- $MAKE world.opt
- $MAKE ocamlnat
+ script --return --command "$MAKE_WARN world.opt" build.log
+ script --return --append --command "$MAKE_WARN ocamlnat" build.log
echo Ensuring that all names are prefixed in the runtime
./tools/check-symbol-names runtime/*.a
}
API_Docs () {
echo Ensuring that all library documentation compiles
- $MAKE -C ocamldoc html_doc pdf_doc texi_doc
+ $MAKE -C api_docgen html pdf texi
}
Install () {
}
Checks () {
+ set +x
+ STATUS=0
+ if grep -Fq ' warning: undefined variable ' build.log; then
+ echo -e '\e[31mERROR\e[0m Undefined Makefile variables detected!'
+ grep -F ' warning: undefined variable ' build.log | sort | uniq
+ STATUS=1
+ fi
+ rm build.log
+ set -x
if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
echo Check the code examples in the manual
$MAKE manual-pregen
# check that the 'clean' target also works
$MAKE clean
$MAKE -C manual clean
+ $MAKE -C manual distclean
# check that the `distclean` target definitely cleans the tree
$MAKE distclean
# Check the working tree is clean
test -z "$(git status --porcelain)"
# Check that there are no ignored files
test -z "$(git ls-files --others -i --exclude-standard)"
+ exit $STATUS
}
CheckManual () {
}
+BuildManual () {
+ $MAKE -C manual/src/html_processing duniverse
+ $MAKE -C manual manual
+ $MAKE -C manual web
+}
+
+# ReportBuildStatus accepts an exit code as a parameter (defaults to 1) and also
+# instructs GitHub Actions to set build-status to 'failed' on non-zero exit or
+# 'success' otherwise.
+ReportBuildStatus () {
+ CODE=${1:-1}
+ if ((CODE)); then
+ STATUS='failed'
+ else
+ STATUS='success'
+ fi
+ echo "::set-output name=build-status::$STATUS"
+ exit $CODE
+}
+
+BasicCompiler () {
+ trap ReportBuildStatus ERR
+
+ ./configure --disable-dependency-generation \
+ --disable-debug-runtime \
+ --disable-instrumented-runtime
+
+ # Need a runtime
+ make -j coldstart
+ # And generated files (ocamllex compiles ocamlyacc)
+ make -j ocamllex
+
+ ReportBuildStatus 0
+}
+
case $1 in
configure) Configure;;
build) Build;;
test) Test;;
api-docs) API_Docs;;
install) Install;;
+manual) BuildManual;;
other-checks) Checks;;
+basic-compiler) BasicCompiler;;
*) echo "Unknown CI instruction: $1"
exit 1;;
esac
@rem Do not call setlocal!\r
@echo off\r
\r
+chcp 65001 > nul\r
+set BUILD_PREFIX=🐫реализация\r
+set OCAMLROOT=%PROGRAMFILES%\Бактріан🐫\r
+\r
if "%1" neq "install" goto %1\r
setlocal enabledelayedexpansion\r
echo AppVeyor Environment\r
\r
:UpgradeCygwin\r
if "%CYGWIN_INSTALL_PACKAGES%" neq "" "%CYG_ROOT%\setup-x86_64.exe" --quiet-mode --no-shortcuts --no-startmenu --no-desktop --only-site --root "%CYG_ROOT%" --site "%CYG_MIRROR%" --local-package-dir "%CYG_CACHE%" --packages %CYGWIN_INSTALL_PACKAGES:~1% > nul\r
-for %%P in (%CYGWIN_COMMANDS%) do "%CYG_ROOT%\bin\%%P.exe" --version > nul || set CYGWIN_UPGRADE_REQUIRED=1\r
+for %%P in (%CYGWIN_COMMANDS%) do "%CYG_ROOT%\bin\%%P.exe" --version 2> nul > nul || set CYGWIN_UPGRADE_REQUIRED=1\r
"%CYG_ROOT%\bin\bash.exe" -lc "cygcheck -dc %CYGWIN_PACKAGES%"\r
if %CYGWIN_UPGRADE_REQUIRED% equ 1 (\r
echo Cygwin package upgrade required - please go and drink coffee\r
goto :EOF\r
\r
:install\r
-chcp 65001 > nul\r
-rem This must be kept in sync with appveyor_build.sh\r
-set BUILD_PREFIX=🐫реализация\r
-git worktree add "..\%BUILD_PREFIX%-%PORT%" -b appveyor-build-%PORT%\r
-if "%PORT%" equ "msvc64" (\r
- git worktree add "..\%BUILD_PREFIX%-msvc32" -b appveyor-build-%PORT%32\r
+\r
+if defined SDK set SDK=call %SDK%\r
+if not defined SDK (\r
+ if "%PORT%" equ "msvc64" set SDK=call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
+ if "%PORT%" equ "msvc32" set SDK=call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\vcvars32.bat"\r
)\r
+%SDK%\r
+\r
+git worktree add "..\%BUILD_PREFIX%-%PORT%" -b appveyor-build-%PORT%\r
\r
cd "..\%BUILD_PREFIX%-%PORT%"\r
-if "%PORT%" equ "mingw32" (\r
+if "%BOOTSTRAP_FLEXDLL%" equ "true" (\r
git submodule update --init flexdll\r
)\r
\r
set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-i686-gcc-core mingw64-i686-runtime\r
set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-w64-mingw32-gcc cygcheck\r
)\r
+if "%PORT%" equ "mingw64" (\r
+ set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% mingw64-x86_64-gcc-core\r
+ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% x86_64-w64-mingw32-gcc\r
+)\r
+if "%PORT%" equ "cygwin32" (\r
+ set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% cygwin32-gcc-core flexdll\r
+ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% i686-pc-cygwin-gcc flexlink\r
+)\r
+if "%PORT%" equ "cygwin64" (\r
+ set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% gcc-core flexdll\r
+ set CYGWIN_COMMANDS=%CYGWIN_COMMANDS% x86_64-pc-cygwin-gcc flexlink\r
+)\r
+if "%PORT:~0,6%%BOOTSTRAP_FLEXDLL%" equ "cygwinfalse" set CYGWIN_PACKAGES=%CYGWIN_PACKAGES% flexdll\r
\r
set CYGWIN_INSTALL_PACKAGES=\r
-set CYGWIN_UPGRADE_REQUIRED=0\r
+set CYGWIN_UPGRADE_REQUIRED=%FORCE_CYGWIN_UPGRADE%\r
\r
for %%P in (%CYGWIN_PACKAGES%) do call :CheckPackage %%P\r
call :UpgradeCygwin\r
goto :EOF\r
\r
:build\r
-if "%PORT%" equ "msvc64" (\r
- setlocal\r
- call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
-)\r
-rem Do the main build (either msvc64 or mingw32)\r
"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh" || exit /b 1\r
-\r
-if "%PORT%" neq "msvc64" goto :EOF\r
-\r
-rem Reconfigure the environment and run the msvc32 partial build\r
-endlocal\r
-call "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin\SetEnv.cmd" /x86\r
-"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh msvc32-only" || exit /b 1\r
goto :EOF\r
\r
:test\r
-rem Reconfigure the environment for the msvc64 build\r
-call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
+rem No tests run in the "C" build mode\r
+if "%BUILD_MODE%" equ "C" goto :EOF\r
+rem Add a C# compiler in PATH for the testsuite for mingw\r
+if "%PORT%" equ "mingw64" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\amd64\vcvars64.bat"\r
+if "%PORT%" equ "mingw32" call "C:\Program Files (x86)\Microsoft Visual Studio 14.0\VC\bin\vcvars32.bat"\r
"%CYG_ROOT%\bin\bash.exe" -lc "$APPVEYOR_BUILD_FOLDER/tools/ci/appveyor/appveyor_build.sh test" || exit /b 1\r
goto :EOF\r
CACHE_DIRECTORY=/cygdrive/c/projects/cache
if [[ -z $APPVEYOR_PULL_REQUEST_HEAD_COMMIT ]] ; then
- MAKE="make -j"
+ MAKE="make -j$NUMBER_OF_PROCESSORS"
else
MAKE=make
fi
# $2: the prefix to use to install
function set_configuration {
case "$1" in
- mingw)
+ cygwin*)
+ dep='--disable-dependency-generation'
+ ;;
+ mingw32)
build='--build=i686-pc-cygwin'
host='--host=i686-w64-mingw32'
dep='--disable-dependency-generation'
;;
- msvc)
+ mingw64)
+ build='--build=i686-pc-cygwin'
+ host='--host=x86_64-w64-mingw32'
+ dep='--disable-dependency-generation'
+ ;;
+ msvc32)
build='--build=i686-pc-cygwin'
host='--host=i686-pc-windows'
dep='--disable-dependency-generation'
;;
msvc64)
- build='--build=x86_64-unknown-cygwin'
+ build='--build=x86_64-pc-cygwin'
host='--host=x86_64-pc-windows'
# Explicitly test dependency generation on msvc64
dep='--enable-dependency-generation'
}
APPVEYOR_BUILD_FOLDER=$(echo "$APPVEYOR_BUILD_FOLDER" | cygpath -f -)
-# These directory names are specified here, because getting UTF-8 correctly
-# through appveyor.yml -> Command Script -> Bash is quite painful...
-OCAMLROOT=$(echo "$PROGRAMFILES/Бактріан🐫" | cygpath -f - -m)
-
-# This must be kept in sync with appveyor_build.cmd
-BUILD_PREFIX=🐫реализация
-
-PATH=$(echo "$OCAMLROOT" | cygpath -f -)/bin/flexdll:$PATH
+FLEXDLLROOT="$PROGRAMFILES/flexdll"
+OCAMLROOT=$(echo "$OCAMLROOT" | cygpath -f - -m)
+
+if [[ $BOOTSTRAP_FLEXDLL = 'false' ]] ; then
+ case "$PORT" in
+ cygwin*) ;;
+ *) export PATH="$FLEXDLLROOT:$PATH";;
+ esac
+fi
case "$1" in
install)
- mkdir -p "$OCAMLROOT/bin/flexdll"
- cd "$APPVEYOR_BUILD_FOLDER/../flexdll"
- # msvc64 objects need to be compiled with VS2015, so are copied later from
- # a source build.
- for f in flexdll.h flexlink.exe flexdll*_msvc.obj default*.manifest ; do
- cp "$f" "$OCAMLROOT/bin/flexdll/"
- done
- if [[ $PORT = 'msvc64' ]] ; then
- echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \
- >> ~/.bash_profile
+ if [[ $BOOTSTRAP_FLEXDLL = 'false' ]] ; then
+ mkdir -p "$FLEXDLLROOT"
+ cd "$APPVEYOR_BUILD_FOLDER/../flexdll"
+ # The objects are always built from the sources
+ for f in flexdll.h flexlink.exe default*.manifest ; do
+ cp "$f" "$FLEXDLLROOT/"
+ done
fi
- ;;
- msvc32-only)
- cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-msvc32"
-
- set_configuration msvc "$OCAMLROOT-msvc32"
-
- run "$MAKE world" $MAKE world
- run "$MAKE runtimeopt" $MAKE runtimeopt
- run "$MAKE -C otherlibs/systhreads libthreadsnat.lib" \
- $MAKE -C otherlibs/systhreads libthreadsnat.lib
-
- exit 0
+ case "$PORT" in
+ msvc*)
+ echo 'eval $($APPVEYOR_BUILD_FOLDER/tools/msvs-promote-path)' \
+ >> ~/.bash_profile
+ ;;
+ esac
;;
test)
FULL_BUILD_PREFIX="$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX"
"$FULL_BUILD_PREFIX-$PORT/tools/check-symbol-names" \
$FULL_BUILD_PREFIX-$PORT/runtime/*.a
fi
+ if [[ $PORT = 'mingw64' ]] ; then
+ export PATH="$PATH:/usr/x86_64-w64-mingw32/sys-root/mingw/bin"
+ elif [[ $PORT = 'mingw32' ]] ; then
+ export PATH="$PATH:/usr/i686-w64-mingw32/sys-root/mingw/bin"
+ fi
run "test $PORT" $MAKE -C "$FULL_BUILD_PREFIX-$PORT" tests
run "install $PORT" $MAKE -C "$FULL_BUILD_PREFIX-$PORT" install
if [[ $PORT = 'msvc64' ]] ; then
if [[ $PORT = 'msvc64' ]] ; then
# Ensure that make distclean can be run from an empty tree
run "$MAKE distclean" $MAKE distclean
+ fi
+
+ if [[ $BOOTSTRAP_FLEXDLL = 'false' ]] ; then
tar -xzf "$APPVEYOR_BUILD_FOLDER/flexdll.tar.gz"
cd "flexdll-$FLEXDLL_VERSION"
- $MAKE MSVC_DETECT=0 CHAINS=msvc64 support
- cp flexdll*_msvc64.obj "$OCAMLROOT/bin/flexdll/"
+ $MAKE MSVC_DETECT=0 CHAINS=${PORT%32} support
+ cp -f *.obj "$FLEXDLLROOT/" 2>/dev/null || \
+ cp -f *.o "$FLEXDLLROOT/"
cd ..
fi
- if [[ $PORT = 'msvc64' ]] ; then
- set_configuration msvc64 "$OCAMLROOT"
- else
- set_configuration mingw "$OCAMLROOT-mingw32"
- fi
-
- cd "$APPVEYOR_BUILD_FOLDER/../$BUILD_PREFIX-$PORT"
+ set_configuration "$PORT" "$OCAMLROOT"
export TERM=ansi
- if [[ $PORT = 'mingw32' ]] ; then
- set -o pipefail
- # For an explanation of the sed command, see
- # https://github.com/appveyor/ci/issues/1824
- script --quiet --return --command \
- "$MAKE -C ../$BUILD_PREFIX-mingw32 flexdll && "\
-"$MAKE -C ../$BUILD_PREFIX-mingw32 world.opt" \
- "../$BUILD_PREFIX-mingw32/build.log" |
- sed -e 's/\d027\[K//g' \
- -e 's/\d027\[m/\d027[0m/g' \
- -e 's/\d027\[01\([m;]\)/\d027[1\1/g'
- else
+ case "$BUILD_MODE" in
+ world.opt)
+ set -o pipefail
+ # For an explanation of the sed command, see
+ # https://github.com/appveyor/ci/issues/1824
+ script --quiet --return --command \
+ "$MAKE -C ../$BUILD_PREFIX-$PORT world.opt" \
+ "../$BUILD_PREFIX-$PORT/build.log" |
+ sed -e 's/\d027\[K//g' \
+ -e 's/\d027\[m/\d027[0m/g' \
+ -e 's/\d027\[01\([m;]\)/\d027[1\1/g'
+ rm -f build.log;;
+ steps)
+ run "C deps: runtime" make -j64 -C runtime setup-depend
+ run "C deps: win32unix" make -j64 -C otherlibs/win32unix setup-depend
run "$MAKE world" $MAKE world
run "$MAKE bootstrap" $MAKE bootstrap
run "$MAKE opt" $MAKE opt
- run "$MAKE opt.opt" $MAKE opt.opt
- fi
+ run "$MAKE opt.opt" $MAKE opt.opt;;
+ C)
+ run "$MAKE world" $MAKE world
+ run "$MAKE runtimeopt" $MAKE runtimeopt
+ run "$MAKE -C otherlibs/systhreads libthreadsnat.lib" \
+ $MAKE -C otherlibs/systhreads libthreadsnat.lib;;
+ *)
+ echo "Unrecognised build: $BUILD_MODE"
+ exit 1
+ esac
+
+ echo DLL base addresses
+ case "$PORT" in
+ *32)
+ ARG='-4';;
+ *64)
+ ARG='-8';;
+ esac
+ find "../$BUILD_PREFIX-$PORT" -type f \( -name \*.dll -o -name \*.so \) | \
+ xargs rebase -i "$ARG"
;;
esac
It is used on Inria's CI to make sure the bootstrap procedure works.
diff --git a/runtime/floats.c b/runtime/floats.c
-index b93f6a409..6edbed9c6 100644
+index 7561bfba8..db246978c 100644
--- a/runtime/floats.c
+++ b/runtime/floats.c
-@@ -536,11 +536,6 @@ CAMLprim value caml_sin_float(value f)
+@@ -858,11 +858,6 @@ CAMLprim value caml_sin_float(value f)
return caml_copy_double(sin(Double_val(f)));
}
{
return caml_copy_double(cos(Double_val(f)));
diff --git a/stdlib/float.ml b/stdlib/float.ml
-index 8d9c5cca6..3b3ca61bc 100644
+index ab5cd5c07..e09cbe215 100644
--- a/stdlib/float.ml
+++ b/stdlib/float.ml
-@@ -69,8 +69,6 @@ external hypot : float -> float -> float
+@@ -85,8 +85,6 @@ external hypot : float -> float -> float
= "caml_hypot_float" "caml_hypot" [@@unboxed] [@@noalloc]
external cosh : float -> float = "caml_cosh_float" "cosh"
[@@unboxed] [@@noalloc]
- [@@unboxed] [@@noalloc]
external tanh : float -> float = "caml_tanh_float" "tanh"
[@@unboxed] [@@noalloc]
- external ceil : float -> float = "caml_ceil_float" "ceil"
+ external acosh : float -> float = "caml_acosh_float" "caml_acosh"
diff --git a/stdlib/float.mli b/stdlib/float.mli
-index 2cdd31608..904f4af0e 100644
+index ba84d9b0e..8132f93f7 100644
--- a/stdlib/float.mli
+++ b/stdlib/float.mli
-@@ -196,10 +196,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+@@ -285,10 +285,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
[@@unboxed] [@@noalloc]
(** Hyperbolic cosine. Argument is in radians. *)
[@@unboxed] [@@noalloc]
(** Hyperbolic tangent. Argument is in radians. *)
diff --git a/stdlib/pervasives.ml b/stdlib/pervasives.ml
-index 945512716..55bc9e921 100644
+index e9b2e5cde..3a39cf754 100644
--- a/stdlib/pervasives.ml
+++ b/stdlib/pervasives.ml
-@@ -97,8 +97,6 @@ external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
+@@ -99,8 +99,6 @@ external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot"
[@@unboxed] [@@noalloc]
external cosh : float -> float = "caml_cosh_float" "cosh"
[@@unboxed] [@@noalloc]
[@@unboxed] [@@noalloc]
external ceil : float -> float = "caml_ceil_float" "ceil"
diff --git a/stdlib/stdlib.ml b/stdlib/stdlib.ml
-index 425728f64..4057dbc90 100644
+index aac8fcc17..663ce44f2 100644
--- a/stdlib/stdlib.ml
+++ b/stdlib/stdlib.ml
-@@ -148,8 +148,6 @@ external log10 : float -> float = "caml_log10_float" "log10"
+@@ -146,8 +146,6 @@ external log10 : float -> float = "caml_log10_float" "log10"
external log1p : float -> float = "caml_log1p_float" "caml_log1p"
[@@unboxed] [@@noalloc]
external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc]
-external sinh : float -> float = "caml_sinh_float" "sinh"
- [@@unboxed] [@@noalloc]
- external sqrt : float -> float = "caml_sqrt_float" "sqrt"
+ external asinh : float -> float = "caml_asinh_float" "caml_asinh"
[@@unboxed] [@@noalloc]
- external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc]
+ external sqrt : float -> float = "caml_sqrt_float" "sqrt"
diff --git a/stdlib/stdlib.mli b/stdlib/stdlib.mli
-index d451bba9c..990a41467 100644
+index e2e898266..2e18f16d3 100644
--- a/stdlib/stdlib.mli
+++ b/stdlib/stdlib.mli
-@@ -461,10 +461,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
+@@ -556,10 +556,6 @@ external cosh : float -> float = "caml_cosh_float" "cosh"
[@@unboxed] [@@noalloc]
(** Hyperbolic cosine. Argument is in radians. *)
check_make_alldepend=true
;;
mingw64)
- build='--build=x86_64-unknown-cygwin'
+ build='--build=x86_64-pc-cygwin'
host='--host=x86_64-w64-mingw32'
instdir='C:/ocamlmgw64'
cleanup=true
cleanup=true
;;
msvc64)
- build='--build=x86_64-unknown-cygwin'
+ build='--build=x86_64-pc-cygwin'
host='--host=x86_64-pc-windows'
instdir='C:/ocamlms64'
configure=nt
make_native=true
cleanup=false
check_make_alldepend=false
-dorebase=false
jobs=''
bootstrap=false
cygwin64)
cleanup=true
check_make_alldepend=true
- dorebase=false
- confoptions="$confoptions --disable-shared "
;;
mingw)
build='--build=i686-pc-cygwin'
check_make_alldepend=true
;;
mingw64)
- build='--build=x86_64-unknown-cygwin'
+ build='--build=x86_64-pc-cygwin'
host='--host=x86_64-w64-mingw32'
instdir='C:/ocamlmgw64'
cleanup=true
cleanup=true
;;
msvc64)
- build='--build=x86_64-unknown-cygwin'
+ build='--build=x86_64-pc-cygwin'
host='--host=x86_64-pc-windows'
instdir='C:/ocamlms64'
cleanup=true
$make --warn-undefined-variables alldepend
fi
-if $dorebase; then
- # temporary solution to the cygwin fork problem
- # see https://github.com/alainfrisch/flexdll/issues/50
- rebase -b 0x7cd20000 otherlibs/unix/dllunix.so
- rebase -b 0x7cdc0000 otherlibs/systhreads/dllthreads.so
-fi
-
$make --warn-undefined-variables install
rm -rf "$instdir"
# ocamlyacc doesn't clean memory on exit
leak:ocamlyacc
+# Alternate signal stacks are currently never freed (see #10266)
+leak:caml_setup_stack_overflow_detection
#* *
#**************************************************************************
+# Be verbose and stop on errors
+set -ex
+
jobs=-j8
instdir="$HOME/ocaml-tmp-install-$$"
+
+# Make sure the repository is clean
+git clean -q -f -d -x
+
./configure --prefix "$instdir" --disable-dependency-generation
make $jobs world
make $jobs opt
+++ /dev/null
-#!/usr/bin/env bash
-#**************************************************************************
-#* *
-#* OCaml *
-#* *
-#* Anil Madhavapeddy, OCaml Labs *
-#* *
-#* Copyright 2014 Institut National de Recherche en Informatique et *
-#* en Automatique. *
-#* *
-#* All rights reserved. This file is distributed under the terms of *
-#* the GNU Lesser General Public License version 2.1, with the *
-#* special exception on linking described in the file LICENSE. *
-#* *
-#**************************************************************************
-
-set -e
-
-# TRAVIS_COMMIT_RANGE has the form <commit1>...<commit2>
-# TRAVIS_CUR_HEAD is <commit1>
-# TRAVIS_PR_HEAD is <commit2>
-#
-# The following diagram illustrates the relationship between
-# the commits:
-#
-# (trunk) (pr branch)
-# TRAVIS_CUR_HEAD TRAVIS_PR_HEAD
-# | /
-# ... ...
-# | /
-# TRAVIS_MERGE_BASE
-#
-echo "TRAVIS_COMMIT_RANGE=$TRAVIS_COMMIT_RANGE"
-echo "TRAVIS_COMMIT=$TRAVIS_COMMIT"
-if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]] ; then
- FETCH_HEAD=$(git rev-parse FETCH_HEAD)
- echo "FETCH_HEAD=$FETCH_HEAD"
-else
- FETCH_HEAD=$TRAVIS_COMMIT
-fi
-
-if [[ $TRAVIS_EVENT_TYPE = 'push' ]] ; then
- if ! git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
- echo 'TRAVIS_COMMIT does not exist - CI failure'
- exit 1
- fi
-else
- if [[ $TRAVIS_COMMIT != $(git rev-parse FETCH_HEAD) ]] ; then
- echo 'WARNING! Travis TRAVIS_COMMIT and FETCH_HEAD do not agree!'
- if git cat-file -e "$TRAVIS_COMMIT" 2> /dev/null ; then
- echo 'TRAVIS_COMMIT exists, so going with it'
- else
- echo 'TRAVIS_COMMIT does not exist; setting to FETCH_HEAD'
- TRAVIS_COMMIT=$FETCH_HEAD
- fi
- fi
-fi
-
-set -x
-
-PREFIX=~/local
-
-MAKE="make $MAKE_ARG"
-SHELL=dash
-
-TRAVIS_CUR_HEAD=${TRAVIS_COMMIT_RANGE%%...*}
-TRAVIS_PR_HEAD=${TRAVIS_COMMIT_RANGE##*...}
-case $TRAVIS_EVENT_TYPE in
- # If this is not a pull request then TRAVIS_COMMIT_RANGE may be empty.
- pull_request)
- DEEPEN=50
- while ! git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD" >& /dev/null
- do
- echo "Deepening $TRAVIS_BRANCH by $DEEPEN commits"
- git fetch origin --deepen=$DEEPEN "$TRAVIS_BRANCH"
- ((DEEPEN*=2))
- done
- TRAVIS_MERGE_BASE=$(git merge-base "$TRAVIS_CUR_HEAD" "$TRAVIS_PR_HEAD");;
-esac
-
-CheckSyncStdlibDocs () {
- cat<<EOF
-------------------------------------------------------------------------
-This test checks that running tools/sync-stdlib-docs is a no-op in the current
-state, which means that the labelled/unlabelled .mli files are in sync. If
-this check fails, it should be fixable by just running the script and reviewing
-the changes it makes.
-------------------------------------------------------------------------
-EOF
- tools/sync_stdlib_docs
- git diff --quiet --exit-code && result=pass || result=fail
- case $result in
- pass)
- echo "CheckSyncStdlibDocs: success";;
- fail)
- echo "CheckSyncStdlibDocs: failure with the following differences:"
- git --no-pager diff
- exit 1;;
- esac
-}
-
-CheckDepend () {
- cat<<EOF
-------------------------------------------------------------------------
-This test checks that 'alldepend' target is a no-op in the current
-state, which means that dependencies are correctly stored in .depend
-files. It should only be run after the compiler has been built.
-If this check fails, it should be fixable by just running 'make alldepend'.
-------------------------------------------------------------------------
-EOF
- ./configure --disable-dependency-generation \
- --disable-debug-runtime \
- --disable-instrumented-runtime
- # Need a runtime
- $MAKE -j coldstart
- # And generated files (ocamllex compiles ocamlyacc)
- $MAKE -j ocamllex
- $MAKE alldepend
- # note: we cannot use $? as (set -e) may be set globally,
- # and disabling it locally is not worth the hassle.
- # note: we ignore the whitespace in case different C dependency
- # detectors use different indentation styles.
- git diff --ignore-all-space --quiet --exit-code **.depend \
- && result=pass || result=fail
- case $result in
- pass)
- echo "CheckDepend: success";;
- fail)
- echo "CheckDepend: failure with the following differences:"
- git --no-pager diff --ignore-all-space **.depend
- exit 1;;
- esac
-}
-
-BuildAndTest () {
- mkdir -p $PREFIX
- cat<<EOF
-------------------------------------------------------------------------
-This test builds the OCaml compiler distribution with your pull request
-and runs its testsuite.
-
-Failing to build the compiler distribution, or testsuite failures are
-critical errors that must be understood and fixed before your pull
-request can be merged.
-------------------------------------------------------------------------
-EOF
-
- # Ensure that make distclean can be run from an empty tree
- $MAKE distclean
-
- if [ "$MIN_BUILD" = "1" ] ; then
- configure_flags="\
- --prefix=$PREFIX \
- --disable-shared \
- --disable-debug-runtime \
- --disable-instrumented-runtime \
- --disable-systhreads \
- --disable-str-lib \
- --disable-unix-lib \
- --disable-bigarray-lib \
- --disable-ocamldoc \
- --disable-native-compiler \
- --enable-ocamltest \
- --disable-dependency-generation \
- $CONFIG_ARG"
- else
- configure_flags="\
- --prefix=$PREFIX \
- --enable-flambda-invariants \
- --enable-ocamltest \
- --disable-dependency-generation \
- $CONFIG_ARG"
- fi
- case $XARCH in
- x64)
- ./configure $configure_flags
- ;;
- i386)
- ./configure --build=x86_64-pc-linux-gnu --host=i386-linux \
- CC='gcc -m32' AS='as --32' ASPP='gcc -m32 -c' \
- PARTIALLD='ld -r -melf_i386' \
- $configure_flags
- ;;
- *)
- echo unknown arch
- exit 1
- ;;
- esac
-
- export PATH=$PREFIX/bin:$PATH
- if [ "$MIN_BUILD" = "1" ] ; then
- if $MAKE world.opt ; then
- echo "world.opt is not supposed to work!"
- exit 1
- else
- $MAKE world
- fi
- else
- $MAKE world.opt
- $MAKE ocamlnat
- fi
- echo Ensuring that all names are prefixed in the runtime
- ./tools/check-symbol-names runtime/*.a
- cd testsuite
- echo Running the testsuite with the normal runtime
- $MAKE all
- if [ "$MIN_BUILD" != "1" ] ; then
- echo Running the testsuite with the debug runtime
- $MAKE USE_RUNTIME='d' OCAMLTESTDIR="$(pwd)/_ocamltestd" TESTLOG=_logd all
- fi
- cd ..
- if command -v pdflatex &>/dev/null ; then
- echo Ensuring that all library documentation compiles
- $MAKE -C ocamldoc html_doc pdf_doc texi_doc
- fi
- $MAKE install
- if command -v hevea &>/dev/null ; then
- echo Ensuring that the manual compiles
- # These steps rely on the compiler being installed and in PATH
- $MAKE -C manual/manual/html_processing duniverse
- $MAKE -C manual web
- fi
- if fgrep 'SUPPORTS_SHARED_LIBRARIES=true' Makefile.config &>/dev/null ; then
- echo Check the code examples in the manual
- $MAKE manual-pregen
- fi
- # check_all_arches checks tries to compile all backends in place,
- # we would need to redo (small parts of) world.opt afterwards to
- # use the compiler again
- $MAKE check_all_arches
- # Ensure that .gitignore is up-to-date - this will fail if any untreacked or
- # altered files exist.
- test -z "$(git status --porcelain)"
- # check that the 'clean' target also works
- $MAKE clean
- $MAKE -C manual clean
- # check that the `distclean` target definitely cleans the tree
- $MAKE distclean
- $MAKE -C manual distclean
- # Check the working tree is clean
- test -z "$(git status --porcelain)"
- # Check that there are no ignored files
- test -z "$(git ls-files --others -i --exclude-standard)"
-}
-
-CheckChangesModified () {
- cat<<EOF
-------------------------------------------------------------------------
-This test checks that the Changes file has been modified by the pull
-request. Most contributions should come with a message in the Changes
-file, as described in our contributor documentation:
-
- https://github.com/ocaml/ocaml/blob/trunk/CONTRIBUTING.md#changelog
-
-Some very minor changes (typo fixes for example) may not need
-a Changes entry. In this case, you may explicitly disable this test by
-adding the code word "No change entry needed" (on a single line) to
-a commit message of the PR, or using the "no-change-entry-needed" label
-on the github pull request.
-------------------------------------------------------------------------
-EOF
- # check that Changes has been modified
- git diff "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD" --name-only --exit-code \
- Changes > /dev/null && CheckNoChangesMessage || echo pass
-}
-
-CheckNoChangesMessage () {
- API_URL=https://api.github.com/repos/$TRAVIS_REPO_SLUG/issues/$TRAVIS_PULL_REQUEST/labels
- if [[ -n $(git log --grep='[Nn]o [Cc]hange.* needed' --max-count=1 \
- "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD") ]]
- then echo pass
- elif [[ -n $(curl "$API_URL" | grep 'no-change-entry-needed') ]]
- then echo pass
- else exit 1
- fi
-}
-
-CheckManual () {
- cat<<EOF
---------------------------------------------------------------------------
-This test checks the global structure of the reference manual
-(e.g. missing chapters).
---------------------------------------------------------------------------
-EOF
- # we need some of the configuration data provided by configure
- ./configure
- $MAKE check-stdlib check-case-collision -C manual/tests
-
-}
-
-CheckTestsuiteModified () {
- cat<<EOF
-------------------------------------------------------------------------
-This test checks that the OCaml testsuite has been modified by the
-pull request. Any new feature should come with tests, bugs should come
-with regression tests, and generally any change in behavior that can
-be exercised by a test should come with a test or modify and existing
-test. See our contributor documentation:
-
- https://github.com/ocaml/ocaml/blob/trunk/CONTRIBUTING.md#test-you-must
-
-Modifications that result in no change in observable behavior
-(documentation contributions for example) can hardly be tested, in
-which case it is acceptable for this test to fail.
-
-Note: the heuristic used by this test is extremely fragile; passing it
-does *not* imply that your change is appropriately tested.
-------------------------------------------------------------------------
-EOF
- # check that at least a file in testsuite/ has been modified
- git diff "$TRAVIS_MERGE_BASE..$TRAVIS_PR_HEAD" --name-only --exit-code \
- testsuite > /dev/null && exit 1 || echo pass
-}
-
-# Test to see if any part of the directory name has been marked prune
-not_pruned () {
- DIR=$(dirname "$1")
- if [[ $DIR = '.' ]] ; then
- return 0
- else
- case ",$(git check-attr typo.prune "$DIR" | sed -e 's/.*: //')," in
- ,set,)
- return 1
- ;;
- *)
-
- not_pruned "$DIR"
- return $?
- esac
- fi
-}
-
-CheckTypoTree () {
- export OCAML_CT_HEAD=$1
- export OCAML_CT_LS_FILES="git diff-tree --no-commit-id --name-only -r $2 --"
- export OCAML_CT_CAT='git cat-file --textconv'
- export OCAML_CT_PREFIX="$1:"
- GIT_INDEX_FILE=tmp-index git read-tree --reset -i "$1"
- git diff-tree --diff-filter=d --no-commit-id --name-only -r "$2" \
- | (while IFS= read -r path
- do
- if not_pruned "$path" ; then
- echo "Checking $1: $path"
- if ! tools/check-typo "./$path" ; then
- touch check-typo-failed
- fi
- else
- echo "NOT checking $1: $path (typo.prune)"
- fi
- case "$path" in
- configure|configure.ac|VERSION|tools/ci/travis/travis-ci.sh)
- touch CHECK_CONFIGURE;;
- esac
- done)
- rm -f tmp-index
- if [[ -e CHECK_CONFIGURE ]] ; then
- rm -f CHECK_CONFIGURE
- echo "configure generation altered in $1"
- echo 'Verifying that configure.ac generates configure'
- git checkout "$1"
- mv configure configure.ref
- make configure
- if ! diff -q configure configure.ref >/dev/null ; then
- echo "configure.ac no longer generates configure, \
-please run rm configure ; make configure and commit"
- exit 1
- fi
- fi
-}
-
-CHECK_ALL_COMMITS=0
-
-CheckTypo () {
- export OCAML_CT_GIT_INDEX='tmp-index'
- export OCAML_CT_CA_FLAG='--cached'
- # Work around an apparent bug in Ubuntu 12.4.5
- # See https://bugs.launchpad.net/ubuntu/+source/gawk/+bug/1647879
- rm -f check-typo-failed
- if [[ -z $TRAVIS_COMMIT_RANGE ]]
- then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
- else
- if [[ $TRAVIS_EVENT_TYPE = 'pull_request' ]]
- then TRAVIS_COMMIT_RANGE=$TRAVIS_MERGE_BASE..$TRAVIS_PULL_REQUEST_SHA
- fi
- if [[ $CHECK_ALL_COMMITS -eq 1 ]]
- then
- for commit in $(git rev-list "$TRAVIS_COMMIT_RANGE" --reverse)
- do
- CheckTypoTree "$commit" "$commit"
- done
- else
- if [[ -z $TRAVIS_PULL_REQUEST_SHA ]]
- then CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT"
- else CheckTypoTree "$TRAVIS_COMMIT" "$TRAVIS_COMMIT_RANGE"
- fi
- fi
- fi
- echo complete
- if [[ -e check-typo-failed ]]
- then exit 1
- fi
-}
-
-
-case $CI_KIND in
-build) BuildAndTest;;
-changes)
- case $TRAVIS_EVENT_TYPE in
- pull_request) CheckChangesModified;;
- esac;;
-manual)
- CheckManual;;
-tests)
- case $TRAVIS_EVENT_TYPE in
- pull_request) CheckTestsuiteModified;;
- esac;;
-check-typo)
- set +x
- CheckTypo;;
-check-depend)
- CheckSyncStdlibDocs
- CheckDepend;;
-*) echo unknown CI kind
- exit 1
- ;;
-esac
(**************************************************************************)
open Printf
-open Ocamlmklibconfig
let syslib x =
if Config.ccomp_type = "msvc" then x ^ ".lib" else "-l" ^ x
(* PR#4783: under Windows, don't use absolute paths because we do
not know where the binary distribution will be installed. *)
let compiler_path name =
- if Sys.os_type = "Win32" then name else Filename.concat bindir name
+ if Sys.os_type = "Win32" then name else Filename.concat Config.bindir name
let bytecode_objs = ref [] (* .cmo,.cma,.ml,.mli files to pass to ocamlc *)
and native_objs = ref [] (* .cmx,.ml,.mli files to pass to ocamlopt *)
pass to mksharedlib and ar *)
and caml_libs = ref [] (* -cclib to pass to ocamlc, ocamlopt *)
and caml_opts = ref [] (* -ccopt to pass to ocamlc, ocamlopt *)
-and dynlink = ref supports_shared_libraries
+and dynlink = ref Config.supports_shared_libraries
and failsafe = ref false (* whether to fall back on static build only *)
and c_libs = ref [] (* libs to pass to mksharedlib and ocamlc -cclib *)
and c_Lopts = ref [] (* options to pass to mksharedlib and ocamlc -cclib *)
(String.concat " " !c_objs)
(String.concat " " !c_opts)
(String.concat " " !ld_opts)
- (make_rpath mksharedlibrpath)
+ (make_rpath Config.mksharedlibrpath)
(String.concat " " !c_libs)
(String.concat " " flexdll_dirs)
)
(Filename.basename !output_c)
(Filename.basename !output_c)
(String.concat " " (prefix_list "-ccopt " !c_opts))
- (make_rpath_ccopt default_rpath)
+ (make_rpath_ccopt Config.default_rpath)
(String.concat " " (prefix_list "-cclib " !c_libs))
(String.concat " " !caml_libs));
if !native_objs <> [] then
(String.concat " " !native_objs)
(Filename.basename !output_c)
(String.concat " " (prefix_list "-ccopt " !c_opts))
- (make_rpath_ccopt default_rpath)
+ (make_rpath_ccopt Config.default_rpath)
(String.concat " " (prefix_list "-cclib " !c_libs))
(String.concat " " !caml_libs))
let copy_chars_unix nchars =
let n = ref nchars in
while !n > 0 do
- let m = input !inchan copy_buffer 0 (min !n 256) in
+ let m = input !inchan copy_buffer 0 (Int.min !n 256) in
if m = 0 then raise End_of_file;
output !outchan copy_buffer 0 m;
n := !n - m
let main () =
try
- Warnings.parse_options false "a";
+ Option.iter Location.(prerr_alert none) @@ Warnings.parse_options false "a";
Arg.parse_expand [
"-f", Arg.String (fun s -> dumpfile := s),
"<file> Use <file> as dump file (default ocamlprof.dump)";
# Bump this on any changes. It's vital that HOOK_VERSION followed by equals
# appears nowhere else in these sources!
-HOOK_VERSION=4
+HOOK_VERSION=5
# For what it's worth, allow for empty trees!
if git rev-parse --verify HEAD >/dev/null 2>&1
}
# Now run check-typo over all the files in the index
-ERRORS=0
+STATUS=0
export OCAML_CT_PREFIX=:
export OCAML_CT_CAT="git cat-file --textconv"
export OCAML_CT_CA_FLAG=--cached
-git diff --diff-filter=d --staged --name-only | (while IFS= read -r path
+while IFS= read -r path
do
if not_pruned "$path" && ! tools/check-typo "./$path" ; then
- ERRORS=1
+ STATUS=1
fi
-done; exit $ERRORS)
+done < <(git diff --diff-filter=d --staged --name-only)
+
+# If any files affecting the generation of configure have been updated, test
+# whether the index includes an up-to-date configure script.
+# See also tools/ci/actions/check-configure.sh
+
+AUTOCONF_FILES=\
+'configure configure.ac VERSION aclocal.m4 build-aux/* '\
+'tools/autogen tools/git-dev-options.sh'
+
+# Convert $AUTOCONF_FILES to a BRE
+PATHS="${AUTOCONF_FILES//./\\.}"
+PATHS="${PATHS//\*/.*}"
+PATHS="${PATHS// /\\|}"
+
+OVERRIDE_MESSAGE='(you can override githooks with git-commit --no-verify)'
+WRONG_AUTOCONF=0
+
+if git diff --diff-filter=d --staged --name-only | grep -qx "$PATHS" ; then
+ # Get the AC_PREREQ line in configure.ac for the required autoconf version
+ PREREQ="$(git cat-file --textconv :configure.ac \
+ | sed -ne 's/^AC_PREREQ(\[\(.*\)\])/\1/p')"
+ if [[ -z $PREREQ ]]; then
+ echo 'Unable to find/parse the AC_PREREQ macro in configure.ac'
+ echo 'This line should be of the form AC_PREREQ([2.69])'
+ echo '(with no whitespace or comment)'
+ STATUS=1
+ else
+ # Check for autoconf and its version
+ AUTOCONF_TOOL='autoconf'
+ # Check version of autoconf
+ set -o pipefail
+ AUTOCONF_VERSION="$($AUTOCONF_TOOL --version 2>/dev/null | head -n 1)"
+ if [[ $? -ne 0 ]]; then
+ echo 'Files affecting configure updated, but autoconf not found'
+ echo 'Unable to verify that configure is up-to-date'
+ echo "$OVERRIDE_MESSAGE"
+ STATUS=1
+ else
+ AUTOCONF_VERSION="${AUTOCONF_VERSION##* }"
+ if [[ $AUTOCONF_VERSION != $PREREQ ]]; then
+ # Found autoconf, but it's the wrong version. If it's older,
+ # tools/autogen will fail. If it's newer, it may succeed, but CI may
+ # fail. autoconf is frequently available at an exact version, so try
+ # the two known names for it.
+ for tool in $AUTOCONF_TOOL-$PREREQ $AUTOCONF_TOOL$PREREQ; do
+ VERSION="$($tool --version 2>/dev/null | head -n 1)"
+ if [[ $? -eq 0 ]]; then
+ VERSION="${VERSION##* }"
+ if [[ $VERSION != $PREREQ ]]; then
+ continue
+ fi
+ else
+ continue
+ fi
+ echo "autoconf has version $AUTOCONF_VERSION; using $tool instead"
+ AUTOCONF_TOOL="$tool"
+ AUTOCONF_VERSION="$VERSION"
+ break
+ done
+ fi
+
+ if [[ $AUTOCONF_VERSION != $PREREQ ]]; then
+ # We're using the wrong version of autoconf: if all other tests succeed,
+ # display a warning that CI may complain (CI uses the version specified
+ # by AC_PREREQ).
+ WRONG_AUTOCONF=1
+ fi
+
+ # Checkout the relevant files from the index to a temporary directory to
+ # test them.
+ BUILD_DIR="$(mktemp -d)"
+ BUILD_DIR="${BUILD_DIR%%/}/"
+ if [[ -z $BUILD_DIR ]]; then
+ echo 'Unable to create a temporary directory to test configure.ac'
+ STATUS=1
+ else
+ git checkout-index --prefix "$BUILD_DIR" -- $AUTOCONF_FILES
+ pushd "$BUILD_DIR" > /dev/null
+ mkdir -p a b
+ mv configure a/
+ echo 'Regenerating configure...'
+ if tools/autogen "$AUTOCONF_TOOL"; then
+ mv configure b/
+ if diff a/configure b/configure > /dev/null; then
+ if ((WRONG_AUTOCONF)); then
+ echo '*** Warning! configure.ac generates the configure script'
+ echo "*** However, this is using autoconf $AUTOCONF_VERSION"
+ echo "*** configure.ac requires autoconf $PREREQ; the CI check on"
+ echo '*** GitHub may fail.'
+ fi
+ else
+ echo 'configure.ac does not appear to generate configure'
+ echo 'Try running make -B configure and stage the changes'
+ echo "$OVERRIDE_MESSAGE"
+ git diff --text --no-index a b
+ STATUS=1
+ fi
+ else
+ echo 'tools/autogen failed'
+ STATUS=1
+ fi
+ popd > /dev/null
+ rm -rf "$BUILD_DIR"
+ fi
+ fi
+ fi
+fi
+
+exit $STATUS
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* The interactive toplevel loop *)
+
+open Format
+open Misc
+open Parsetree
+open Types
+open Typedtree
+open Outcometree
+open Topcommon
+module String = Misc.Stdlib.String
+
+(* The table of toplevel value bindings and its accessors *)
+
+let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
+
+let getvalue name =
+ try
+ String.Map.find name !toplevel_value_bindings
+ with Not_found ->
+ fatal_error (name ^ " unbound at toplevel")
+
+let setvalue name v =
+ toplevel_value_bindings := String.Map.add name v !toplevel_value_bindings
+
+let implementation_label = ""
+
+(* To print values *)
+
+module EvalBase = struct
+
+ let eval_ident id =
+ if Ident.persistent id || Ident.global id then begin
+ try
+ Symtable.get_global_value id
+ with Symtable.Error (Undefined_global name) ->
+ raise (Undefined_global name)
+ end else begin
+ let name = Translmod.toplevel_name id in
+ try
+ String.Map.find name !toplevel_value_bindings
+ with Not_found ->
+ raise (Undefined_global name)
+ end
+
+end
+
+include Topcommon.MakeEvalPrinter(EvalBase)
+
+(* Load in-core and execute a lambda term *)
+
+let may_trace = ref false (* Global lock on tracing *)
+
+let load_lambda ppf lam =
+ if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
+ let slam = Simplif.simplify_lambda lam in
+ if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
+ let (init_code, fun_code) = Bytegen.compile_phrase slam in
+ if !Clflags.dump_instr then
+ fprintf ppf "%a%a@."
+ Printinstr.instrlist init_code
+ Printinstr.instrlist fun_code;
+ let (code, reloc, events) =
+ Emitcode.to_memory init_code fun_code
+ in
+ let can_free = (fun_code = []) in
+ let initial_symtable = Symtable.current_state() in
+ Symtable.patch_object code reloc;
+ Symtable.check_global_initialized reloc;
+ Symtable.update_global_table();
+ let initial_bindings = !toplevel_value_bindings in
+ let bytecode, closure = Meta.reify_bytecode code [| events |] None in
+ match
+ may_trace := true;
+ Fun.protect
+ ~finally:(fun () -> may_trace := false;
+ if can_free then Meta.release_bytecode bytecode)
+ closure
+ with
+ | retval -> Result retval
+ | exception x ->
+ record_backtrace ();
+ toplevel_value_bindings := initial_bindings; (* PR#6211 *)
+ Symtable.restore_state initial_symtable;
+ Exception x
+
+(* Print the outcome of an evaluation *)
+
+let pr_item =
+ Printtyp.print_items
+ (fun env -> function
+ | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
+ Some (outval_of_value env (getvalue (Translmod.toplevel_name id))
+ val_type)
+ | _ -> None
+ )
+
+(* Execute a toplevel phrase *)
+
+let execute_phrase print_outcome ppf phr =
+ match phr with
+ | Ptop_def sstr ->
+ let oldenv = !toplevel_env in
+ Typecore.reset_delayed_checks ();
+ let (str, sg, sn, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
+ if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
+ let sg' = Typemod.Signature_names.simplify newenv sn sg in
+ ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg');
+ Typecore.force_delayed_checks ();
+ let lam = Translmod.transl_toplevel_definition str in
+ Warnings.check_fatal ();
+ begin try
+ toplevel_env := newenv;
+ let res = load_lambda ppf lam in
+ let out_phr =
+ match res with
+ | Result v ->
+ if print_outcome then
+ Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
+ match str.str_items with
+ | [ { str_desc =
+ (Tstr_eval (exp, _)
+ |Tstr_value
+ (Asttypes.Nonrecursive,
+ [{vb_pat = {pat_desc=Tpat_any};
+ vb_expr = exp}
+ ]
+ )
+ )
+ }
+ ] ->
+ let outv = outval_of_value newenv v exp.exp_type in
+ let ty = Printtyp.tree_of_type_scheme exp.exp_type in
+ Ophr_eval (outv, ty)
+
+ | [] -> Ophr_signature []
+ | _ -> Ophr_signature (pr_item oldenv sg'))
+ else Ophr_signature []
+ | Exception exn ->
+ toplevel_env := oldenv;
+ if exn = Out_of_memory then Gc.full_major();
+ let outv =
+ outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
+ in
+ Ophr_exception (exn, outv)
+ in
+ !print_out_phrase ppf out_phr;
+ if Printexc.backtrace_status ()
+ then begin
+ match !backtrace with
+ | None -> ()
+ | Some b ->
+ pp_print_string ppf b;
+ pp_print_flush ppf ();
+ backtrace := None;
+ end;
+ begin match out_phr with
+ | Ophr_eval (_, _) | Ophr_signature _ -> true
+ | Ophr_exception _ -> false
+ end
+ with x ->
+ toplevel_env := oldenv; raise x
+ end
+ | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
+ begin match Topcommon.get_directive dir_name with
+ | None ->
+ fprintf ppf "Unknown directive `%s'." dir_name;
+ let directives = Topcommon.all_directive_names () in
+ Misc.did_you_mean ppf
+ (fun () -> Misc.spellcheck directives dir_name);
+ fprintf ppf "@.";
+ false
+ | Some d ->
+ match d, pdir_arg with
+ | Directive_none f, None -> f (); true
+ | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
+ | Directive_int f, Some {pdira_desc = Pdir_int (n,None) } ->
+ begin match Int_literal_converter.int n with
+ | n -> f n; true
+ | exception _ ->
+ fprintf ppf "Integer literal exceeds the range of \
+ representable integers for directive `%s'.@."
+ dir_name;
+ false
+ end
+ | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
+ fprintf ppf "Wrong integer literal for directive `%s'.@."
+ dir_name;
+ false
+ | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
+ | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
+ | _ ->
+ fprintf ppf "Wrong type of argument for directive `%s'.@."
+ dir_name;
+ false
+ end
+
+let execute_phrase print_outcome ppf phr =
+ try execute_phrase print_outcome ppf phr
+ with exn ->
+ Warnings.reset_fatal ();
+ raise exn
+
+
+(* Additional directives for the bytecode toplevel only *)
+
+open Cmo_format
+
+(* Loading files *)
+
+exception Load_failed
+
+let check_consistency ppf filename cu =
+ try Env.import_crcs ~source:filename cu.cu_imports
+ with Persistent_env.Consistbl.Inconsistency {
+ unit_name = name;
+ inconsistent_source = user;
+ original_source = auth;
+ } ->
+ fprintf ppf "@[<hv 0>The files %s@ and %s@ \
+ disagree over interface %s@]@."
+ user auth name;
+ raise Load_failed
+
+(* This is basically Dynlink.Bytecode.run with no digest *)
+let load_compunit ic filename ppf compunit =
+ check_consistency ppf filename compunit;
+ seek_in ic compunit.cu_pos;
+ let code_size = compunit.cu_codesize + 8 in
+ let code = LongString.create code_size in
+ LongString.input_bytes_into code ic compunit.cu_codesize;
+ LongString.set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
+ LongString.blit_string "\000\000\000\001\000\000\000" 0
+ code (compunit.cu_codesize + 1) 7;
+ let initial_symtable = Symtable.current_state() in
+ Symtable.patch_object code compunit.cu_reloc;
+ Symtable.update_global_table();
+ let events =
+ if compunit.cu_debug = 0 then [| |]
+ else begin
+ seek_in ic compunit.cu_debug;
+ [| input_value ic |]
+ end in
+ begin try
+ may_trace := true;
+ let _bytecode, closure = Meta.reify_bytecode code events None in
+ ignore (closure ());
+ may_trace := false;
+ with exn ->
+ record_backtrace ();
+ may_trace := false;
+ Symtable.restore_state initial_symtable;
+ print_exception_outcome ppf exn;
+ raise Load_failed
+ end
+
+let rec load_file recursive ppf name =
+ let filename =
+ try Some (Load_path.find name) with Not_found -> None
+ in
+ match filename with
+ | None -> fprintf ppf "Cannot find file %s.@." name; false
+ | Some filename ->
+ let ic = open_in_bin filename in
+ Misc.try_finally
+ ~always:(fun () -> close_in ic)
+ (fun () -> really_load_file recursive ppf name filename ic)
+
+and really_load_file recursive ppf name filename ic =
+ let buffer = really_input_string ic (String.length Config.cmo_magic_number) in
+ try
+ if buffer = Config.cmo_magic_number then begin
+ let compunit_pos = input_binary_int ic in (* Go to descriptor *)
+ seek_in ic compunit_pos;
+ let cu : compilation_unit = input_value ic in
+ if recursive then
+ List.iter
+ (function
+ | (Reloc_getglobal id, _)
+ when not (Symtable.is_global_defined id) ->
+ let file = Ident.name id ^ ".cmo" in
+ begin match Load_path.find_uncap file with
+ | exception Not_found -> ()
+ | file ->
+ if not (load_file recursive ppf file) then raise Load_failed
+ end
+ | _ -> ()
+ )
+ cu.cu_reloc;
+ load_compunit ic filename ppf cu;
+ true
+ end else
+ if buffer = Config.cma_magic_number then begin
+ let toc_pos = input_binary_int ic in (* Go to table of contents *)
+ seek_in ic toc_pos;
+ let lib = (input_value ic : library) in
+ List.iter
+ (fun dllib ->
+ let name = Dll.extract_dll_name dllib in
+ try Dll.open_dlls Dll.For_execution [name]
+ with Failure reason ->
+ fprintf ppf
+ "Cannot load required shared library %s.@.Reason: %s.@."
+ name reason;
+ raise Load_failed)
+ lib.lib_dllibs;
+ List.iter (load_compunit ic filename ppf) lib.lib_units;
+ true
+ end else begin
+ fprintf ppf "File %s is not a bytecode object file.@." name;
+ false
+ end
+ with Load_failed -> false
+
+let init () =
+ let crc_intfs = Symtable.init_toplevel() in
+ Compmisc.init_path ();
+ Env.import_crcs ~source:Sys.executable_name crc_intfs;
+ ()
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+
+(* The trace *)
+
+open Trace
+
+external current_environment: unit -> Obj.t = "caml_get_current_environment"
+
+let tracing_function_ptr =
+ get_code_pointer
+ (Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg))
+
+let dir_trace ppf lid =
+ match Env.find_value_by_name lid !Topcommon.toplevel_env with
+ | (path, desc) -> begin
+ (* Check if this is a primitive *)
+ match desc.val_kind with
+ | Val_prim _ ->
+ Format.fprintf ppf
+ "%a is an external function and cannot be traced.@."
+ Printtyp.longident lid
+ | _ ->
+ let clos = Toploop.eval_value_path !Topcommon.toplevel_env path in
+ (* Nothing to do if it's not a closure *)
+ if Obj.is_block clos
+ && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
+ && (match
+ Ctype.(repr (expand_head !Topcommon.toplevel_env desc.val_type))
+ with {desc=Tarrow _} -> true | _ -> false)
+ then begin
+ match is_traced clos with
+ | Some opath ->
+ Format.fprintf ppf "%a is already traced (under the name %a).@."
+ Printtyp.path path
+ Printtyp.path opath
+ | None ->
+ (* Instrument the old closure *)
+ traced_functions :=
+ { path = path;
+ closure = clos;
+ actual_code = get_code_pointer clos;
+ instrumented_fun =
+ instrument_closure
+ !Topcommon.toplevel_env lid ppf desc.val_type }
+ :: !traced_functions;
+ (* Redirect the code field of the closure to point
+ to the instrumentation function *)
+ set_code_pointer clos tracing_function_ptr;
+ Format.fprintf ppf "%a is now traced.@." Printtyp.longident lid
+ end else
+ Format.fprintf ppf "%a is not a function.@." Printtyp.longident lid
+ end
+ | exception Not_found ->
+ Format.fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+
+let dir_untrace ppf lid =
+ match Env.find_value_by_name lid !Topcommon.toplevel_env with
+ | (path, _desc) ->
+ let rec remove = function
+ | [] ->
+ Format.fprintf ppf "%a was not traced.@." Printtyp.longident lid;
+ []
+ | f :: rem ->
+ if Path.same f.path path then begin
+ set_code_pointer f.closure f.actual_code;
+ Format.fprintf ppf "%a is no longer traced.@."
+ Printtyp.longident lid;
+ rem
+ end else f :: remove rem in
+ traced_functions := remove !traced_functions
+ | exception Not_found ->
+ Format.fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+
+let dir_untrace_all ppf () =
+ List.iter
+ (fun f ->
+ set_code_pointer f.closure f.actual_code;
+ Format.fprintf ppf "%a is no longer traced.@." Printtyp.path f.path)
+ !traced_functions;
+ traced_functions := []
+
+let _ = Topcommon.add_directive "trace"
+ (Directive_ident (dir_trace Format.std_formatter))
+ {
+ section = Topdirs.section_trace;
+ doc = "All calls to the function \
+ named function-name will be traced.";
+ }
+
+let _ = Topcommon.add_directive "untrace"
+ (Directive_ident (dir_untrace Format.std_formatter))
+ {
+ section = Topdirs.section_trace;
+ doc = "Stop tracing the given function.";
+ }
+
+let _ = Topcommon.add_directive "untrace_all"
+ (Directive_none (dir_untrace_all Format.std_formatter))
+ {
+ section = Topdirs.section_trace;
+ doc = "Stop tracing all functions traced so far.";
+ }
+
+
+(* --- *)
+
+
+let preload_objects = ref []
+
+(* Position of the first non expanded argument *)
+let first_nonexpanded_pos = ref 0
+
+let current = ref (!Arg.current)
+
+let argv = ref Sys.argv
+
+(* Test whether the option is part of a responsefile *)
+let is_expanded pos = pos < !first_nonexpanded_pos
+
+let expand_position pos len =
+ if pos < !first_nonexpanded_pos then
+ (* Shift the position *)
+ first_nonexpanded_pos := !first_nonexpanded_pos + len
+ else
+ (* New last position *)
+ first_nonexpanded_pos := pos + len + 2
+
+let prepare ppf =
+ Topcommon.set_paths ();
+ try
+ let res =
+ let objects =
+ List.rev (!preload_objects @ !Compenv.first_objfiles)
+ in
+ List.for_all (Topeval.load_file false ppf) objects
+ in
+ Topcommon.run_hooks Topcommon.Startup;
+ res
+ with x ->
+ try Location.report_exception ppf x; false
+ with x ->
+ Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
+ false
+
+(* If [name] is "", then the "file" is stdin treated as a script file. *)
+let file_argument name =
+ let ppf = Format.err_formatter in
+ if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
+ then preload_objects := name :: !preload_objects
+ else if is_expanded !current then begin
+ (* Script files are not allowed in expand options because otherwise the
+ check in override arguments may fail since the new argv can be larger
+ than the original argv.
+ *)
+ Printf.eprintf "For implementation reasons, the toplevel does not support\
+ \ having script files (here %S) inside expanded arguments passed through the\
+ \ -args{,0} command-line option.\n" name;
+ raise (Compenv.Exit_with_status 2)
+ end else begin
+ let newargs = Array.sub !argv !current
+ (Array.length !argv - !current)
+ in
+ Compenv.readenv ppf Before_link;
+ Compmisc.read_clflags_from_env ();
+ if prepare ppf && Toploop.run_script ppf name newargs
+ then raise (Compenv.Exit_with_status 0)
+ else raise (Compenv.Exit_with_status 2)
+ end
+
+
+let wrap_expand f s =
+ let start = !current in
+ let arr = f s in
+ expand_position start (Array.length arr);
+ arr
+
+module Options = Main_args.Make_bytetop_options (struct
+ include Main_args.Default.Topmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
+end)
+
+let () =
+ let extra_paths =
+ match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
+ | exception Not_found -> []
+ | s -> Misc.split_path_contents s
+ in
+ Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
+
+let main () =
+ let ppf = Format.err_formatter in
+ let program = "ocaml" in
+ Compenv.readenv ppf Before_args;
+ Clflags.add_arguments __LOC__ Options.list;
+ Compenv.parse_arguments ~current argv file_argument program;
+ Compenv.readenv ppf Before_link;
+ Compmisc.read_clflags_from_env ();
+ if not (prepare ppf) then raise (Compenv.Exit_with_status 2);
+ Compmisc.init_path ();
+ Toploop.loop Format.std_formatter
+
+let main () =
+ match main () with
+ | exception Compenv.Exit_with_status n -> n
+ | () -> 0
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* The "trace" facility *)
+
+open Format
+open Misc
+open Longident
+open Types
+open Topeval
+open Topcommon
+
+type codeptr = Obj.raw_data
+
+type traced_function =
+ { path: Path.t; (* Name under which it is traced *)
+ closure: Obj.t; (* Its function closure (patched) *)
+ actual_code: codeptr; (* Its original code pointer *)
+ instrumented_fun: codeptr -> Obj.t -> Obj.t -> Obj.t }
+ (* Printing function *)
+
+let traced_functions = ref ([] : traced_function list)
+
+(* Check if a function is already traced *)
+
+let is_traced clos =
+ let rec is_traced = function
+ [] -> None
+ | tf :: rem -> if tf.closure == clos then Some tf.path else is_traced rem
+ in is_traced !traced_functions
+
+(* Get or overwrite the code pointer of a closure *)
+
+let get_code_pointer cls =
+ assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
+ Obj.raw_field cls 0
+
+let set_code_pointer cls ptr =
+ assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
+ Obj.set_raw_field cls 0 ptr
+
+(* Call a traced function (use old code pointer, but new closure as
+ environment so that recursive calls are also traced).
+ It is necessary to wrap Meta.invoke_traced_function in an ML function
+ so that the RETURN at the end of the ML wrapper takes us to the
+ code of the function. *)
+
+let invoke_traced_function codeptr env arg =
+ Meta.invoke_traced_function codeptr env arg
+
+let print_label ppf l =
+ if l <> Asttypes.Nolabel then fprintf ppf "%s:" (Printtyp.string_of_label l)
+
+(* If a function returns a functional value, wrap it into a trace code *)
+
+let rec instrument_result env name ppf clos_typ =
+ match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+ | Tarrow(l, t1, t2, _) ->
+ let starred_name =
+ match name with
+ | Lident s -> Lident(s ^ "*")
+ | Ldot(lid, s) -> Ldot(lid, s ^ "*")
+ | Lapply _ -> fatal_error "Trace.instrument_result" in
+ let trace_res = instrument_result env starred_name ppf t2 in
+ (fun clos_val ->
+ Obj.repr (fun arg ->
+ if not !may_trace then
+ (Obj.magic clos_val : Obj.t -> Obj.t) arg
+ else begin
+ may_trace := false;
+ try
+ fprintf ppf "@[<2>%a <--@ %a%a@]@."
+ Printtyp.longident starred_name
+ print_label l
+ (print_value !toplevel_env arg) t1;
+ may_trace := true;
+ let res = (Obj.magic clos_val : Obj.t -> Obj.t) arg in
+ may_trace := false;
+ fprintf ppf "@[<2>%a -->@ %a@]@."
+ Printtyp.longident starred_name
+ (print_value !toplevel_env res) t2;
+ may_trace := true;
+ trace_res res
+ with exn ->
+ may_trace := false;
+ fprintf ppf "@[<2>%a raises@ %a@]@."
+ Printtyp.longident starred_name
+ (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
+ may_trace := true;
+ raise exn
+ end))
+ | _ -> (fun v -> v)
+
+(* Same as instrument_result, but for a toplevel closure (modified in place) *)
+
+exception Dummy
+let _ = Dummy
+
+let instrument_closure env name ppf clos_typ =
+ match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
+ | Tarrow(l, t1, t2, _) ->
+ let trace_res = instrument_result env name ppf t2 in
+ (fun actual_code closure arg ->
+ if not !may_trace then begin
+ try invoke_traced_function actual_code closure arg
+ with Dummy -> assert false
+ (* do not remove handler, prevents tail-call to invoke_traced_ *)
+ end else begin
+ may_trace := false;
+ try
+ fprintf ppf "@[<2>%a <--@ %a%a@]@."
+ Printtyp.longident name
+ print_label l
+ (print_value !toplevel_env arg) t1;
+ may_trace := true;
+ let res = invoke_traced_function actual_code closure arg in
+ may_trace := false;
+ fprintf ppf "@[<2>%a -->@ %a@]@."
+ Printtyp.longident name
+ (print_value !toplevel_env res) t2;
+ may_trace := true;
+ trace_res res
+ with exn ->
+ may_trace := false;
+ fprintf ppf "@[<2>%a raises@ %a@]@."
+ Printtyp.longident name
+ (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
+ may_trace := true;
+ raise exn
+ end)
+ | _ -> assert false
+
+(* Given the address of a closure, find its tracing info *)
+
+let rec find_traced_closure clos = function
+ | [] -> fatal_error "Trace.find_traced_closure"
+ | f :: rem -> if f.closure == clos then f else find_traced_closure clos rem
+
+(* Trace the application of an (instrumented) closure to an argument *)
+
+let print_trace clos arg =
+ let f = find_traced_closure clos !traced_functions in
+ f.instrumented_fun f.actual_code clos arg
;* *
;**************************************************************************
+(copy_files# byte/*.ml)
+
(library
(name ocamltoplevel)
(wrapped false)
(flags (:standard -principal -nostdlib))
(libraries stdlib ocamlcommon ocamlbytecomp)
- (modules genprintval toploop trace topdirs topmain))
+ (modules :standard \ topstart expunge))
(executable
(name topstart)
stdlib__Uchar
stdlib__Weak
; the rest
- outcometree topdirs toploop
+ outcometree topdirs topeval toploop topmain topcommon
)))
| {type_kind = Type_abstract; type_manifest = Some body} ->
tree_of_val depth obj
(instantiate_type env decl.type_params ty_list body)
- | {type_kind = Type_variant constr_list; type_unboxed} ->
- let unbx = type_unboxed.unboxed in
+ | {type_kind = Type_variant (constr_list,rep)} ->
+ let unbx = (rep = Variant_unboxed) in
let tag =
if unbx then Cstr_unboxed
else if O.is_block obj
find row.row_fields
| Tobject (_, _) ->
Oval_stuff "<obj>"
- | Tsubst ty ->
- tree_of_val (depth - 1) obj ty
- | Tfield(_, _, _, _) | Tnil | Tlink _ ->
+ | Tsubst _ | Tfield(_, _, _, _) | Tnil | Tlink _ ->
fatal_error "Printval.outval_of_value"
| Tpoly (ty, _) ->
tree_of_val (depth - 1) obj ty
let rec find = function
| [] -> raise Not_found
| (_name, Simple (sch, printer)) :: remainder ->
- if Ctype.moregeneral env false sch ty
+ if Ctype.is_moregeneral env false sch ty
then printer
else find remainder
| (_name, Generic (path, fn)) :: remainder ->
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* The interactive toplevel loop *)
+
+open Format
+open Config
+open Misc
+open Parsetree
+open Types
+open Typedtree
+open Outcometree
+open Topcommon
+
+type res = Ok of Obj.t | Err of string
+type evaluation_outcome = Result of Obj.t | Exception of exn
+
+let _dummy = (Ok (Obj.magic 0), Err "")
+
+external ndl_run_toplevel: string -> string -> res
+ = "caml_natdynlink_run_toplevel"
+
+let implementation_label = "native toplevel"
+
+let global_symbol id =
+ let sym = Compilenv.symbol_for_global id in
+ match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with
+ | None ->
+ fatal_error ("Toploop.global_symbol " ^ (Ident.unique_name id))
+ | Some obj -> obj
+
+let need_symbol sym =
+ Option.is_none (Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym)
+
+let dll_run dll entry =
+ match (try Result (Obj.magic (ndl_run_toplevel dll entry))
+ with exn -> Exception exn)
+ with
+ | Exception _ as r -> r
+ | Result r ->
+ match Obj.magic r with
+ | Ok x -> Result x
+ | Err s -> fatal_error ("Toploop.dll_run " ^ s)
+
+
+let remembered = ref Ident.empty
+
+let rec remember phrase_name i = function
+ | [] -> ()
+ | Sig_value (id, _, _) :: rest
+ | Sig_module (id, _, _, _, _) :: rest
+ | Sig_typext (id, _, _, _) :: rest
+ | Sig_class (id, _, _, _) :: rest ->
+ remembered := Ident.add id (phrase_name, i) !remembered;
+ remember phrase_name (succ i) rest
+ | _ :: rest -> remember phrase_name i rest
+
+let toplevel_value id =
+ try Ident.find_same id !remembered
+ with _ -> Misc.fatal_error @@ "Unknown ident: " ^ Ident.unique_name id
+
+let close_phrase lam =
+ let open Lambda in
+ Ident.Set.fold (fun id l ->
+ let glb, pos = toplevel_value id in
+ let glob =
+ Lprim (Pfield pos,
+ [Lprim (Pgetglobal glb, [], Loc_unknown)],
+ Loc_unknown)
+ in
+ Llet(Strict, Pgenval, id, glob, l)
+ ) (free_variables lam) lam
+
+let toplevel_value id =
+ let glob, pos =
+ if Config.flambda then toplevel_value id else Translmod.nat_toplevel_name id
+ in
+ (Obj.magic (global_symbol glob)).(pos)
+
+(* Return the value referred to by a path *)
+
+module EvalBase = struct
+
+ let eval_ident id =
+ try
+ if Ident.persistent id || Ident.global id
+ then global_symbol id
+ else toplevel_value id
+ with _ ->
+ raise (Undefined_global (Ident.name id))
+
+end
+
+include Topcommon.MakeEvalPrinter(EvalBase)
+
+(* Load in-core and execute a lambda term *)
+
+let may_trace = ref false (* Global lock on tracing *)
+
+let phrase_seqid = ref 0
+let phrase_name = ref "TOP"
+
+(* CR-soon trefis for mshinwell: copy/pasted from Optmain. Should it be shared
+ or?
+ mshinwell: It should be shared, but after 4.03. *)
+module Backend = struct
+ (* See backend_intf.mli. *)
+
+ let symbol_for_global' = Compilenv.symbol_for_global'
+ let closure_symbol = Compilenv.closure_symbol
+
+ let really_import_approx = Import_approx.really_import_approx
+ let import_symbol = Import_approx.import_symbol
+
+ let size_int = Arch.size_int
+ let big_endian = Arch.big_endian
+
+ let max_sensible_number_of_arguments =
+ (* The "-1" is to allow for a potential closure environment parameter. *)
+ Proc.max_arguments_for_tailcalls - 1
+end
+let backend = (module Backend : Backend_intf.S)
+
+let load_lambda ppf ~module_ident ~required_globals lam size =
+ if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
+ let slam = Simplif.simplify_lambda lam in
+ if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
+
+ let dll =
+ if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
+ else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
+ in
+ let filename = Filename.chop_extension dll in
+ let program =
+ { Lambda.
+ code = slam;
+ main_module_block_size = size;
+ module_ident;
+ required_globals;
+ }
+ in
+ let middle_end =
+ if Config.flambda then Flambda_middle_end.lambda_to_clambda
+ else Closure_middle_end.lambda_to_clambda
+ in
+ Asmgen.compile_implementation ~toplevel:need_symbol
+ ~backend ~prefixname:filename
+ ~middle_end ~ppf_dump:ppf program;
+ Asmlink.call_linker_shared [filename ^ ext_obj] dll;
+ Sys.remove (filename ^ ext_obj);
+
+ let dll =
+ if Filename.is_implicit dll
+ then Filename.concat (Sys.getcwd ()) dll
+ else dll in
+ match
+ Fun.protect
+ ~finally:(fun () ->
+ (try Sys.remove dll with Sys_error _ -> ()))
+ (* note: under windows, cannot remove a loaded dll
+ (should remember the handles, close them in at_exit, and then
+ remove files) *)
+ (fun () -> dll_run dll !phrase_name)
+ with
+ | res -> res
+ | exception x ->
+ record_backtrace ();
+ Exception x
+
+(* Print the outcome of an evaluation *)
+
+let pr_item =
+ Printtyp.print_items
+ (fun env -> function
+ | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
+ Some (outval_of_value env (toplevel_value id) val_type)
+ | _ -> None
+ )
+
+(* Execute a toplevel phrase *)
+
+let execute_phrase print_outcome ppf phr =
+ match phr with
+ | Ptop_def sstr ->
+ let oldenv = !toplevel_env in
+ incr phrase_seqid;
+ phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
+ Compilenv.reset ?packname:None !phrase_name;
+ Typecore.reset_delayed_checks ();
+ let sstr, rewritten =
+ match sstr with
+ | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ]
+ | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive,
+ [{ pvb_expr = e
+ ; pvb_pat = { ppat_desc = Ppat_any ; _ }
+ ; pvb_attributes = attrs
+ ; _ }])
+ ; pstr_loc = loc }
+ ] ->
+ let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in
+ let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in
+ [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true
+ | _ -> sstr, false
+ in
+ let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
+ if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
+ let sg' = Typemod.Signature_names.simplify newenv names sg in
+ ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
+ Typecore.force_delayed_checks ();
+ let module_ident, res, required_globals, size =
+ if Config.flambda then
+ let { Lambda.module_ident; main_module_block_size = size;
+ required_globals; code = res } =
+ Translmod.transl_implementation_flambda !phrase_name
+ (str, Tcoerce_none)
+ in
+ remember module_ident 0 sg';
+ module_ident, close_phrase res, required_globals, size
+ else
+ let size, res = Translmod.transl_store_phrases !phrase_name str in
+ Ident.create_persistent !phrase_name, res, Ident.Set.empty, size
+ in
+ Warnings.check_fatal ();
+ begin try
+ toplevel_env := newenv;
+ let res = load_lambda ppf ~required_globals ~module_ident res size in
+ let out_phr =
+ match res with
+ | Result _ ->
+ if Config.flambda then
+ (* CR-someday trefis: *)
+ Env.register_import_as_opaque (Ident.name module_ident)
+ else
+ Compilenv.record_global_approx_toplevel ();
+ if print_outcome then
+ Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
+ match str.str_items with
+ | [] -> Ophr_signature []
+ | _ ->
+ if rewritten then
+ match sg' with
+ | [ Sig_value (id, vd, _) ] ->
+ let outv =
+ outval_of_value newenv (toplevel_value id)
+ vd.val_type
+ in
+ let ty = Printtyp.tree_of_type_scheme vd.val_type in
+ Ophr_eval (outv, ty)
+ | _ -> assert false
+ else
+ Ophr_signature (pr_item oldenv sg'))
+ else Ophr_signature []
+ | Exception exn ->
+ toplevel_env := oldenv;
+ if exn = Out_of_memory then Gc.full_major();
+ let outv =
+ outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
+ in
+ Ophr_exception (exn, outv)
+ in
+ !print_out_phrase ppf out_phr;
+ begin match out_phr with
+ | Ophr_eval (_, _) | Ophr_signature _ -> true
+ | Ophr_exception _ -> false
+ end
+ with x ->
+ toplevel_env := oldenv; raise x
+ end
+ | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
+ begin match get_directive dir_name with
+ | None ->
+ fprintf ppf "Unknown directive `%s'.@." dir_name;
+ false
+ | Some d ->
+ match d, pdir_arg with
+ | Directive_none f, None -> f (); true
+ | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
+ | Directive_int f, Some {pdira_desc = Pdir_int (n,None)} ->
+ begin match Int_literal_converter.int n with
+ | n -> f n; true
+ | exception _ ->
+ fprintf ppf "Integer literal exceeds the range of \
+ representable integers for directive `%s'.@."
+ dir_name;
+ false
+ end
+ | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
+ fprintf ppf "Wrong integer literal for directive `%s'.@."
+ dir_name;
+ false
+ | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
+ | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
+ | _ ->
+ fprintf ppf "Wrong type of argument for directive `%s'.@."
+ dir_name;
+ false
+ end
+
+
+(* API compat *)
+
+let getvalue _ = assert false
+let setvalue _ _ = assert false
+
+(* Loading files *)
+
+(* Load in-core a .cmxs file *)
+
+let load_file _ (* fixme *) ppf name0 =
+ let name =
+ try Some (Load_path.find name0)
+ with Not_found -> None
+ in
+ match name with
+ | None -> fprintf ppf "File not found: %s@." name0; false
+ | Some name ->
+ let fn,tmp =
+ if Filename.check_suffix name ".cmx" || Filename.check_suffix name ".cmxa"
+ then
+ let cmxs = Filename.temp_file "caml" ".cmxs" in
+ Asmlink.link_shared ~ppf_dump:ppf [name] cmxs;
+ cmxs,true
+ else
+ name,false
+ in
+ let success =
+ (* The Dynlink interface does not allow us to distinguish between
+ a Dynlink.Error exceptions raised in the loaded modules
+ or a genuine error during dynlink... *)
+ try Dynlink.loadfile fn; true
+ with
+ | Dynlink.Error err ->
+ fprintf ppf "Error while loading %s: %s.@."
+ name (Dynlink.error_message err);
+ false
+ | exn ->
+ print_exception_outcome ppf exn;
+ false
+ in
+ if tmp then (try Sys.remove fn with Sys_error _ -> ());
+ success
+
+let init () =
+ Compmisc.init_path ();
+ Clflags.dlcode := true;
+ ()
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+let preload_objects = ref []
+
+(* Position of the first non expanded argument *)
+let first_nonexpanded_pos = ref 0
+
+let current = ref (!Arg.current)
+
+let argv = ref Sys.argv
+
+(* Test whether the option is part of a responsefile *)
+let is_expanded pos = pos < !first_nonexpanded_pos
+
+let expand_position pos len =
+ if pos < !first_nonexpanded_pos then
+ (* Shift the position *)
+ first_nonexpanded_pos := !first_nonexpanded_pos + len
+ else
+ (* New last position *)
+ first_nonexpanded_pos := pos + len + 2
+
+
+let prepare ppf =
+ Topcommon.set_paths ();
+ try
+ let res =
+ List.for_all (Topeval.load_file false ppf) (List.rev !preload_objects)
+ in
+ Topcommon.run_hooks Topcommon.Startup;
+ res
+ with x ->
+ try Location.report_exception ppf x; false
+ with x ->
+ Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
+ false
+
+let file_argument name =
+ let ppf = Format.err_formatter in
+ if Filename.check_suffix name ".cmxs"
+ || Filename.check_suffix name ".cmx"
+ || Filename.check_suffix name ".cmxa"
+ then preload_objects := name :: !preload_objects
+ else if is_expanded !current then begin
+ (* Script files are not allowed in expand options because otherwise the
+ check in override arguments may fail since the new argv can be larger
+ than the original argv.
+ *)
+ Printf.eprintf "For implementation reasons, the toplevel does not support\
+ \ having script files (here %S) inside expanded arguments passed through\
+ \ the -args{,0} command-line option.\n" name;
+ raise (Compenv.Exit_with_status 2)
+ end else begin
+ let newargs = Array.sub !argv !Arg.current
+ (Array.length !argv - !Arg.current)
+ in
+ Compmisc.read_clflags_from_env ();
+ if prepare ppf && Toploop.run_script ppf name newargs
+ then raise (Compenv.Exit_with_status 0)
+ else raise (Compenv.Exit_with_status 2)
+ end
+
+let wrap_expand f s =
+ let start = !current in
+ let arr = f s in
+ expand_position start (Array.length arr);
+ arr
+
+module Options = Main_args.Make_opttop_options (struct
+ include Main_args.Default.Opttopmain
+ let _stdin () = file_argument ""
+ let _args = wrap_expand Arg.read_arg
+ let _args0 = wrap_expand Arg.read_arg0
+ let anonymous s = file_argument s
+end);;
+
+let () =
+ let extra_paths =
+ match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
+ | exception Not_found -> []
+ | s -> Misc.split_path_contents s
+ in
+ Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
+
+let main () =
+ let ppf = Format.err_formatter in
+ Clflags.native_code := true;
+ let program = "ocamlnat" in
+ Compenv.readenv ppf Before_args;
+ Clflags.add_arguments __LOC__ Options.list;
+ Compenv.parse_arguments ~current argv file_argument program;
+ Compmisc.read_clflags_from_env ();
+ if not (prepare Format.err_formatter) then raise (Compenv.Exit_with_status 2);
+ Compmisc.init_path ();
+ Toploop.loop Format.std_formatter
+
+let main () =
+ match main () with
+ | exception Compenv.Exit_with_status n -> n
+ | () -> 0
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Dummy implementation, [Trace] is not supported in native code *)
+
+let unavailable () =
+ invalid_arg "'Trace' is not available in the native toplevel."
+
+type codeptr
+
+type traced_function =
+ { path: Path.t; (* Name under which it is traced *)
+ closure: Obj.t; (* Its function closure (patched) *)
+ actual_code: codeptr; (* Its original code pointer *)
+ instrumented_fun: codeptr -> Obj.t -> Obj.t -> Obj.t }
+ (* Printing function *)
+
+let traced_functions = ref []
+let is_traced _ = None
+let get_code_pointer _ = unavailable ()
+let set_code_pointer _ _ = unavailable ()
+let instrument_closure _ _ _ _ _ _ _ = unavailable ()
+let print_trace _ _ = unavailable ()
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* Toplevel directives *)
-
-open Format
-open Misc
-open Longident
-open Types
-open Opttoploop
-
-(* The standard output formatter *)
-let std_out = std_formatter
-
-(* To quit *)
-
-let dir_quit () = raise (Compenv.Exit_with_status 0)
-
-let _ = Hashtbl.add directive_table "quit" (Directive_none dir_quit)
-
-(* To add a directory to the load path *)
-
-let dir_directory s =
- let d = expand_directory Config.standard_library s in
- let dir = Load_path.Dir.create d in
- Load_path.prepend_dir dir;
- toplevel_env :=
- Stdlib.String.Set.fold
- (fun name env ->
- Env.add_persistent_structure (Ident.create_persistent name) env)
- (Env.persistent_structures_of_dir dir)
- !toplevel_env
-
-let _ = Hashtbl.add directive_table "directory" (Directive_string dir_directory)
-(* To remove a directory from the load path *)
-let dir_remove_directory s =
- let d = expand_directory Config.standard_library s in
- let keep id =
- match Load_path.find_uncap (Ident.name id ^ ".cmi") with
- | exception Not_found -> true
- | fn -> Filename.dirname fn <> d
- in
- toplevel_env := Env.filter_non_loaded_persistent keep !toplevel_env;
- Load_path.remove_dir s
-
-let _ =
- Hashtbl.add directive_table "remove_directory"
- (Directive_string dir_remove_directory)
-
-let _ = Hashtbl.add directive_table "show_dirs"
- (Directive_none
- (fun () ->
- List.iter print_endline (Load_path.get_paths ())
- ))
-
-(* To change the current directory *)
-
-let dir_cd s = Sys.chdir s
-
-let _ = Hashtbl.add directive_table "cd" (Directive_string dir_cd)
-
-(* Load in-core a .cmxs file *)
-
-let load_file ppf name0 =
- let name =
- try Some (Load_path.find name0)
- with Not_found -> None
- in
- match name with
- | None -> fprintf ppf "File not found: %s@." name0; false
- | Some name ->
- let fn,tmp =
- if Filename.check_suffix name ".cmx" || Filename.check_suffix name ".cmxa"
- then
- let cmxs = Filename.temp_file "caml" ".cmxs" in
- Asmlink.link_shared ~ppf_dump:ppf [name] cmxs;
- cmxs,true
- else
- name,false
- in
- let success =
- (* The Dynlink interface does not allow us to distinguish between
- a Dynlink.Error exceptions raised in the loaded modules
- or a genuine error during dynlink... *)
- try Dynlink.loadfile fn; true
- with
- | Dynlink.Error err ->
- fprintf ppf "Error while loading %s: %s.@."
- name (Dynlink.error_message err);
- false
- | exn ->
- print_exception_outcome ppf exn;
- false
- in
- if tmp then (try Sys.remove fn with Sys_error _ -> ());
- success
-
-
-let dir_load ppf name = ignore (load_file ppf name)
-
-let _ = Hashtbl.add directive_table "load" (Directive_string (dir_load std_out))
-
-(* Load commands from a file *)
-
-let dir_use ppf name = ignore(Opttoploop.use_file ppf name)
-let dir_use_output ppf name = ignore(Opttoploop.use_output ppf name)
-
-let _ = Hashtbl.add directive_table "use" (Directive_string (dir_use std_out))
-let _ = Hashtbl.add directive_table "use_output"
- (Directive_string (dir_use_output std_out))
-
-(* Install, remove a printer *)
-
-type 'a printer_type_new = Format.formatter -> 'a -> unit
-type 'a printer_type_old = 'a -> unit
-
-let match_printer_type ppf desc typename =
- let printer_type =
- match
- Env.find_type_by_name
- (Ldot(Lident "Opttopdirs", typename)) !toplevel_env
- with
- | (path, _) -> path
- | exception Not_found ->
- fprintf ppf "Cannot find type Topdirs.%s.@." typename;
- raise Exit
- in
- Ctype.begin_def();
- let ty_arg = Ctype.newvar() in
- Ctype.unify !toplevel_env
- (Ctype.newconstr printer_type [ty_arg])
- (Ctype.instance desc.val_type);
- Ctype.end_def();
- Ctype.generalize ty_arg;
- ty_arg
-
-let find_printer_type ppf lid =
- match Env.find_value_by_name lid !toplevel_env with
- | (path, desc) -> begin
- match match_printer_type ppf desc "printer_type_new" with
- | ty_arg -> (ty_arg, path, false)
- | exception Ctype.Unify _ -> begin
- match match_printer_type ppf desc "printer_type_old" with
- | ty_arg -> (ty_arg, path, true)
- | exception Ctype.Unify _ ->
- fprintf ppf "%a has a wrong type for a printing function.@."
- Printtyp.longident lid;
- raise Exit
- end
- end
- | exception Not_found ->
- fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
- raise Exit
-
-let dir_install_printer ppf lid =
- try
- let (ty_arg, path, is_old_style) = find_printer_type ppf lid in
- let v = eval_value_path !toplevel_env path in
- let print_function =
- if is_old_style then
- (fun _formatter repr -> Obj.obj v (Obj.obj repr))
- else
- (fun formatter repr -> Obj.obj v formatter (Obj.obj repr)) in
- install_printer path ty_arg print_function
- with Exit -> ()
-
-let dir_remove_printer ppf lid =
- try
- let (_ty_arg, path, _is_old_style) = find_printer_type ppf lid in
- begin try
- remove_printer path
- with Not_found ->
- fprintf ppf "No printer named %a.@." Printtyp.longident lid
- end
- with Exit -> ()
-
-let _ = Hashtbl.add directive_table "install_printer"
- (Directive_ident (dir_install_printer std_out))
-let _ = Hashtbl.add directive_table "remove_printer"
- (Directive_ident (dir_remove_printer std_out))
-
-let parse_warnings ppf iserr s =
- try Warnings.parse_options iserr s
- with Arg.Bad err -> fprintf ppf "%s.@." err
-
-let _ =
-(* Control the printing of values *)
-
- Hashtbl.add directive_table "print_depth"
- (Directive_int(fun n -> max_printer_depth := n));
- Hashtbl.add directive_table "print_length"
- (Directive_int(fun n -> max_printer_steps := n));
-
-(* Set various compiler flags *)
-
- Hashtbl.add directive_table "labels"
- (Directive_bool(fun b -> Clflags.classic := not b));
-
- Hashtbl.add directive_table "principal"
- (Directive_bool(fun b -> Clflags.principal := b));
-
- Hashtbl.add directive_table "warnings"
- (Directive_string (parse_warnings std_out false));
-
- Hashtbl.add directive_table "warn_error"
- (Directive_string (parse_warnings std_out true))
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The toplevel directives. *)
-
-open Format
-
-val dir_quit : unit -> unit
-val dir_directory : string -> unit
-val dir_remove_directory : string -> unit
-val dir_cd : string -> unit
-val dir_load : formatter -> string -> unit
-val dir_use : formatter -> string -> unit
-val dir_use_output : formatter -> string -> unit
-val dir_install_printer : formatter -> Longident.t -> unit
-val dir_remove_printer : formatter -> Longident.t -> unit
-
-type 'a printer_type_new = Format.formatter -> 'a -> unit
-type 'a printer_type_old = 'a -> unit
-
-(* For topmain.ml. Maybe shouldn't be there *)
-val load_file : formatter -> string -> bool
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The interactive toplevel loop *)
-
-open Format
-open Config
-open Misc
-open Parsetree
-open Types
-open Typedtree
-open Outcometree
-open Ast_helper
-
-type res = Ok of Obj.t | Err of string
-type evaluation_outcome = Result of Obj.t | Exception of exn
-
-let _dummy = (Ok (Obj.magic 0), Err "")
-
-external ndl_run_toplevel: string -> string -> res
- = "caml_natdynlink_run_toplevel"
-
-let global_symbol id =
- let sym = Compilenv.symbol_for_global id in
- match Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym with
- | None ->
- fatal_error ("Opttoploop.global_symbol " ^ (Ident.unique_name id))
- | Some obj -> obj
-
-let need_symbol sym =
- Option.is_none (Dynlink.unsafe_get_global_value ~bytecode_or_asm_symbol:sym)
-
-let dll_run dll entry =
- match (try Result (Obj.magic (ndl_run_toplevel dll entry))
- with exn -> Exception exn)
- with
- | Exception _ as r -> r
- | Result r ->
- match Obj.magic r with
- | Ok x -> Result x
- | Err s -> fatal_error ("Opttoploop.dll_run " ^ s)
-
-
-type directive_fun =
- | Directive_none of (unit -> unit)
- | Directive_string of (string -> unit)
- | Directive_int of (int -> unit)
- | Directive_ident of (Longident.t -> unit)
- | Directive_bool of (bool -> unit)
-
-
-let remembered = ref Ident.empty
-
-let rec remember phrase_name i = function
- | [] -> ()
- | Sig_value (id, _, _) :: rest
- | Sig_module (id, _, _, _, _) :: rest
- | Sig_typext (id, _, _, _) :: rest
- | Sig_class (id, _, _, _) :: rest ->
- remembered := Ident.add id (phrase_name, i) !remembered;
- remember phrase_name (succ i) rest
- | _ :: rest -> remember phrase_name i rest
-
-let toplevel_value id =
- try Ident.find_same id !remembered
- with _ -> Misc.fatal_error @@ "Unknown ident: " ^ Ident.unique_name id
-
-let close_phrase lam =
- let open Lambda in
- Ident.Set.fold (fun id l ->
- let glb, pos = toplevel_value id in
- let glob =
- Lprim (Pfield pos,
- [Lprim (Pgetglobal glb, [], Loc_unknown)],
- Loc_unknown)
- in
- Llet(Strict, Pgenval, id, glob, l)
- ) (free_variables lam) lam
-
-let toplevel_value id =
- let glob, pos =
- if Config.flambda then toplevel_value id else Translmod.nat_toplevel_name id
- in
- (Obj.magic (global_symbol glob)).(pos)
-
-(* Return the value referred to by a path *)
-
-let rec eval_address = function
- | Env.Aident id ->
- if Ident.persistent id || Ident.global id
- then global_symbol id
- else toplevel_value id
- | Env.Adot(a, pos) ->
- Obj.field (eval_address a) pos
-
-let eval_path find env path =
- match find path env with
- | addr -> eval_address addr
- | exception Not_found ->
- fatal_error ("Cannot find address for: " ^ (Path.name path))
-
-let eval_module_path env path =
- eval_path Env.find_module_address env path
-
-let eval_value_path env path =
- eval_path Env.find_value_address env path
-
-let eval_extension_path env path =
- eval_path Env.find_constructor_address env path
-
-let eval_class_path env path =
- eval_path Env.find_class_address env path
-
-(* To print values *)
-
-module EvalPath = struct
- type valu = Obj.t
- exception Error
- let eval_address addr =
- try eval_address addr with _ -> raise Error
- let same_value v1 v2 = (v1 == v2)
-end
-
-module Printer = Genprintval.Make(Obj)(EvalPath)
-
-let max_printer_depth = ref 100
-let max_printer_steps = ref 300
-
-let print_out_value = Oprint.out_value
-let print_out_type = Oprint.out_type
-let print_out_class_type = Oprint.out_class_type
-let print_out_module_type = Oprint.out_module_type
-let print_out_type_extension = Oprint.out_type_extension
-let print_out_sig_item = Oprint.out_sig_item
-let print_out_signature = Oprint.out_signature
-let print_out_phrase = Oprint.out_phrase
-
-let print_untyped_exception ppf obj =
- !print_out_value ppf (Printer.outval_of_untyped_exception obj)
-let outval_of_value env obj ty =
- Printer.outval_of_value !max_printer_steps !max_printer_depth
- (fun _ _ _ -> None) env obj ty
-let print_value env obj ppf ty =
- !print_out_value ppf (outval_of_value env obj ty)
-
-type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
- | Zero of 'b
- | Succ of ('a -> ('a, 'b) gen_printer)
-
-let install_printer = Printer.install_printer
-let install_generic_printer = Printer.install_generic_printer
-let install_generic_printer' = Printer.install_generic_printer'
-let remove_printer = Printer.remove_printer
-
-(* Hooks for parsing functions *)
-
-let parse_toplevel_phrase = ref Parse.toplevel_phrase
-let parse_use_file = ref Parse.use_file
-let print_location = Location.print_loc
-let print_error = Location.print_report
-let print_warning = Location.print_warning
-let input_name = Location.input_name
-
-let parse_mod_use_file name lb =
- let modname =
- String.capitalize_ascii
- (Filename.remove_extension (Filename.basename name))
- in
- let items =
- List.concat
- (List.map
- (function Ptop_def s -> s | Ptop_dir _ -> [])
- (!parse_use_file lb))
- in
- [ Ptop_def
- [ Str.module_
- (Mb.mk
- (Location.mknoloc (Some modname))
- (Mod.structure items)
- )
- ]
- ]
-
-(* Hook for initialization *)
-
-let toplevel_startup_hook = ref (fun () -> ())
-
-type event = ..
-type event +=
- | Startup
- | After_setup
-
-let hooks = ref []
-
-let add_hook f = hooks := f :: !hooks
-
-let () =
- add_hook (function
- | Startup -> !toplevel_startup_hook ()
- | _ -> ())
-
-let run_hooks hook = List.iter (fun f -> f hook) !hooks
-
-(* Load in-core and execute a lambda term *)
-
-let phrase_seqid = ref 0
-let phrase_name = ref "TOP"
-
-(* CR-soon trefis for mshinwell: copy/pasted from Optmain. Should it be shared
- or?
- mshinwell: It should be shared, but after 4.03. *)
-module Backend = struct
- (* See backend_intf.mli. *)
-
- let symbol_for_global' = Compilenv.symbol_for_global'
- let closure_symbol = Compilenv.closure_symbol
-
- let really_import_approx = Import_approx.really_import_approx
- let import_symbol = Import_approx.import_symbol
-
- let size_int = Arch.size_int
- let big_endian = Arch.big_endian
-
- let max_sensible_number_of_arguments =
- (* The "-1" is to allow for a potential closure environment parameter. *)
- Proc.max_arguments_for_tailcalls - 1
-end
-let backend = (module Backend : Backend_intf.S)
-
-let load_lambda ppf ~module_ident ~required_globals lam size =
- if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
- let slam = Simplif.simplify_lambda lam in
- if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
-
- let dll =
- if !Clflags.keep_asm_file then !phrase_name ^ ext_dll
- else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
- in
- let filename = Filename.chop_extension dll in
- let program =
- { Lambda.
- code = slam;
- main_module_block_size = size;
- module_ident;
- required_globals;
- }
- in
- let middle_end =
- if Config.flambda then Flambda_middle_end.lambda_to_clambda
- else Closure_middle_end.lambda_to_clambda
- in
- Asmgen.compile_implementation ~toplevel:need_symbol
- ~backend ~filename ~prefixname:filename
- ~middle_end ~ppf_dump:ppf program;
- Asmlink.call_linker_shared [filename ^ ext_obj] dll;
- Sys.remove (filename ^ ext_obj);
-
- let dll =
- if Filename.is_implicit dll
- then Filename.concat (Sys.getcwd ()) dll
- else dll in
- let res = dll_run dll !phrase_name in
- (try Sys.remove dll with Sys_error _ -> ());
- (* note: under windows, cannot remove a loaded dll
- (should remember the handles, close them in at_exit, and then remove
- files) *)
- res
-
-(* Print the outcome of an evaluation *)
-
-let pr_item =
- Printtyp.print_items
- (fun env -> function
- | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
- Some (outval_of_value env (toplevel_value id) val_type)
- | _ -> None
- )
-
-(* The current typing environment for the toplevel *)
-
-let toplevel_env = ref Env.empty
-
-(* Print an exception produced by an evaluation *)
-
-let print_out_exception ppf exn outv =
- !print_out_phrase ppf (Ophr_exception (exn, outv))
-
-let print_exception_outcome ppf exn =
- if exn = Out_of_memory then Gc.full_major ();
- let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
- print_out_exception ppf exn outv
-
-(* The table of toplevel directives.
- Filled by functions from module topdirs. *)
-
-let directive_table = (Hashtbl.create 13 : (string, directive_fun) Hashtbl.t)
-
-(* Execute a toplevel phrase *)
-
-let execute_phrase print_outcome ppf phr =
- match phr with
- | Ptop_def sstr ->
- let oldenv = !toplevel_env in
- incr phrase_seqid;
- phrase_name := Printf.sprintf "TOP%i" !phrase_seqid;
- Compilenv.reset ?packname:None !phrase_name;
- Typecore.reset_delayed_checks ();
- let sstr, rewritten =
- match sstr with
- | [ { pstr_desc = Pstr_eval (e, attrs) ; pstr_loc = loc } ]
- | [ { pstr_desc = Pstr_value (Asttypes.Nonrecursive,
- [{ pvb_expr = e
- ; pvb_pat = { ppat_desc = Ppat_any ; _ }
- ; pvb_attributes = attrs
- ; _ }])
- ; pstr_loc = loc }
- ] ->
- let pat = Ast_helper.Pat.var (Location.mknoloc "_$") in
- let vb = Ast_helper.Vb.mk ~loc ~attrs pat e in
- [ Ast_helper.Str.value ~loc Asttypes.Nonrecursive [vb] ], true
- | _ -> sstr, false
- in
- let (str, sg, names, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
- if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
- let sg' = Typemod.Signature_names.simplify newenv names sg in
- ignore (Includemod.signatures oldenv ~mark:Mark_positive sg sg');
- Typecore.force_delayed_checks ();
- let module_ident, res, required_globals, size =
- if Config.flambda then
- let { Lambda.module_ident; main_module_block_size = size;
- required_globals; code = res } =
- Translmod.transl_implementation_flambda !phrase_name
- (str, Tcoerce_none)
- in
- remember module_ident 0 sg';
- module_ident, close_phrase res, required_globals, size
- else
- let size, res = Translmod.transl_store_phrases !phrase_name str in
- Ident.create_persistent !phrase_name, res, Ident.Set.empty, size
- in
- Warnings.check_fatal ();
- begin try
- toplevel_env := newenv;
- let res = load_lambda ppf ~required_globals ~module_ident res size in
- let out_phr =
- match res with
- | Result _ ->
- if Config.flambda then
- (* CR-someday trefis: *)
- Env.register_import_as_opaque (Ident.name module_ident)
- else
- Compilenv.record_global_approx_toplevel ();
- if print_outcome then
- Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
- match str.str_items with
- | [] -> Ophr_signature []
- | _ ->
- if rewritten then
- match sg' with
- | [ Sig_value (id, vd, _) ] ->
- let outv =
- outval_of_value newenv (toplevel_value id)
- vd.val_type
- in
- let ty = Printtyp.tree_of_type_scheme vd.val_type in
- Ophr_eval (outv, ty)
- | _ -> assert false
- else
- Ophr_signature (pr_item oldenv sg'))
- else Ophr_signature []
- | Exception exn ->
- toplevel_env := oldenv;
- if exn = Out_of_memory then Gc.full_major();
- let outv =
- outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
- in
- Ophr_exception (exn, outv)
- in
- !print_out_phrase ppf out_phr;
- begin match out_phr with
- | Ophr_eval (_, _) | Ophr_signature _ -> true
- | Ophr_exception _ -> false
- end
- with x ->
- toplevel_env := oldenv; raise x
- end
- | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
- let d =
- try Some (Hashtbl.find directive_table dir_name)
- with Not_found -> None
- in
- begin match d with
- | None ->
- fprintf ppf "Unknown directive `%s'.@." dir_name;
- false
- | Some d ->
- match d, pdir_arg with
- | Directive_none f, None -> f (); true
- | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
- | Directive_int f, Some {pdira_desc = Pdir_int (n,None)} ->
- begin match Int_literal_converter.int n with
- | n -> f n; true
- | exception _ ->
- fprintf ppf "Integer literal exceeds the range of \
- representable integers for directive `%s'.@."
- dir_name;
- false
- end
- | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
- fprintf ppf "Wrong integer literal for directive `%s'.@."
- dir_name;
- false
- | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
- | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
- | _ ->
- fprintf ppf "Wrong type of argument for directive `%s'.@."
- dir_name;
- false
- end
-
-(* Read and execute commands from a file, or from stdin if [name] is "". *)
-
-let use_print_results = ref true
-
-let preprocess_phrase ppf phr =
- let phr =
- match phr with
- | Ptop_def str ->
- let str =
- Pparse.apply_rewriters_str ~restore:true ~tool_name:"ocaml" str
- in
- Ptop_def str
- | phr -> phr
- in
- if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
- if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
- phr
-
-let use_channel ppf ~wrap_in_module ic name filename =
- let lb = Lexing.from_channel ic in
- Location.init lb filename;
- (* Skip initial #! line if any *)
- Lexer.skip_hash_bang lb;
- let success =
- protect_refs [ R (Location.input_name, filename) ] (fun () ->
- try
- List.iter
- (fun ph ->
- let ph = preprocess_phrase ppf ph in
- if not (execute_phrase !use_print_results ppf ph) then raise Exit)
- (if wrap_in_module then
- parse_mod_use_file name lb
- else
- !parse_use_file lb);
- true
- with
- | Exit -> false
- | Sys.Break -> fprintf ppf "Interrupted.@."; false
- | x -> Location.report_exception ppf x; false) in
- success
-
-let use_output ppf command =
- let fn = Filename.temp_file "ocaml" "_toploop.ml" in
- Misc.try_finally ~always:(fun () ->
- try Sys.remove fn with Sys_error _ -> ())
- (fun () ->
- match
- Printf.ksprintf Sys.command "%s > %s"
- command
- (Filename.quote fn)
- with
- | 0 ->
- let ic = open_in_bin fn in
- Misc.try_finally ~always:(fun () -> close_in ic)
- (fun () ->
- use_channel ppf ~wrap_in_module:false ic "" "(command-output)")
- | n ->
- fprintf ppf "Command exited with code %d.@." n;
- false)
-
-let use_file ppf ~wrap_in_module name =
- match name with
- | "" ->
- use_channel ppf ~wrap_in_module stdin name "(stdin)"
- | _ ->
- match Load_path.find name with
- | filename ->
- let ic = open_in_bin filename in
- Misc.try_finally ~always:(fun () -> close_in ic)
- (fun () -> use_channel ppf ~wrap_in_module ic name filename)
- | exception Not_found ->
- fprintf ppf "Cannot find file %s.@." name;
- false
-
-let mod_use_file ppf name =
- use_file ppf ~wrap_in_module:true name
-let use_file ppf name =
- use_file ppf ~wrap_in_module:false name
-
-let use_silently ppf name =
- protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
-
-(* Reading function for interactive use *)
-
-let first_line = ref true
-let got_eof = ref false;;
-
-let read_input_default prompt buffer len =
- output_string stdout prompt; flush stdout;
- let i = ref 0 in
- try
- while true do
- if !i >= len then raise Exit;
- let c = input_char stdin in
- Bytes.set buffer !i c;
- incr i;
- if c = '\n' then raise Exit;
- done;
- (!i, false)
- with
- | End_of_file ->
- (!i, true)
- | Exit ->
- (!i, false)
-
-let read_interactive_input = ref read_input_default
-
-let refill_lexbuf buffer len =
- if !got_eof then (got_eof := false; 0) else begin
- let prompt =
- if !Clflags.noprompt then ""
- else if !first_line then "# "
- else if !Clflags.nopromptcont then ""
- else if Lexer.in_comment () then "* "
- else " "
- in
- first_line := false;
- let (len, eof) = !read_interactive_input prompt buffer len in
- if eof then begin
- Location.echo_eof ();
- if len > 0 then got_eof := true;
- len
- end else
- len
- end
-
-(* Toplevel initialization. Performed here instead of at the
- beginning of loop() so that user code linked in with ocamlmktop
- can call directives from Topdirs. *)
-
-let _ =
- Sys.interactive := true;
- Compmisc.init_path ();
- Clflags.dlcode := true;
- ()
-
-let find_ocamlinit () =
- let ocamlinit = ".ocamlinit" in
- if Sys.file_exists ocamlinit then Some ocamlinit else
- let getenv var = match Sys.getenv var with
- | exception Not_found -> None | "" -> None | v -> Some v
- in
- let exists_in_dir dir file = match dir with
- | None -> None
- | Some dir ->
- let file = Filename.concat dir file in
- if Sys.file_exists file then Some file else None
- in
- let home_dir () = getenv "HOME" in
- let config_dir () =
- if Sys.win32 then None else
- match getenv "XDG_CONFIG_HOME" with
- | Some _ as v -> v
- | None ->
- match home_dir () with
- | None -> None
- | Some dir -> Some (Filename.concat dir ".config")
- in
- let init_ml = Filename.concat "ocaml" "init.ml" in
- match exists_in_dir (config_dir ()) init_ml with
- | Some _ as v -> v
- | None -> exists_in_dir (home_dir ()) ocamlinit
-
-let load_ocamlinit ppf =
- if !Clflags.noinit then ()
- else match !Clflags.init_file with
- | Some f -> if Sys.file_exists f then ignore (use_silently ppf f)
- else fprintf ppf "Init file not found: \"%s\".@." f
- | None ->
- match find_ocamlinit () with
- | None -> ()
- | Some file -> ignore (use_silently ppf file)
-;;
-
-let set_paths () =
- (* Add whatever -I options have been specified on the command line,
- but keep the directories that user code linked in with ocamlmktop
- may have added to load_path. *)
- let expand = Misc.expand_directory Config.standard_library in
- let current_load_path = Load_path.get_paths () in
- let load_path = List.concat [
- [ "" ];
- List.map expand (List.rev !Compenv.first_include_dirs);
- List.map expand (List.rev !Clflags.include_dirs);
- List.map expand (List.rev !Compenv.last_include_dirs);
- current_load_path;
- [expand "+camlp4"];
- ]
- in
- Load_path.init load_path
-
-let initialize_toplevel_env () =
- toplevel_env := Compmisc.initial_env()
-
-(* The interactive loop *)
-
-exception PPerror
-
-let loop ppf =
- Location.formatter_for_warnings := ppf;
- if not !Clflags.noversion then
- fprintf ppf " OCaml version %s - native toplevel@.@." Config.version;
- initialize_toplevel_env ();
- let lb = Lexing.from_function refill_lexbuf in
- Location.init lb "//toplevel//";
- Location.input_name := "//toplevel//";
- Location.input_lexbuf := Some lb;
- Sys.catch_break true;
- run_hooks After_setup;
- load_ocamlinit ppf;
- while true do
- let snap = Btype.snapshot () in
- try
- Lexing.flush_input lb;
- Location.reset();
- first_line := true;
- let phr = try !parse_toplevel_phrase lb with Exit -> raise PPerror in
- let phr = preprocess_phrase ppf phr in
- Env.reset_cache_toplevel ();
- if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
- if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
- ignore(execute_phrase true ppf phr)
- with
- | End_of_file -> raise (Compenv.Exit_with_status 0)
- | Sys.Break -> fprintf ppf "Interrupted.@."; Btype.backtrack snap
- | PPerror -> ()
- | x -> Location.report_exception ppf x; Btype.backtrack snap
- done
-
-external caml_sys_modify_argv : string array -> unit =
- "caml_sys_modify_argv"
-
-let override_sys_argv new_argv =
- caml_sys_modify_argv new_argv;
- Arg.current := 0
-
-(* Execute a script. If [name] is "", read the script from stdin. *)
-
-let run_script ppf name args =
- override_sys_argv args;
- Compmisc.init_path ~dir:(Filename.dirname name) ();
- (* Note: would use [Filename.abspath] here, if we had it. *)
- toplevel_env := Compmisc.initial_env();
- Sys.interactive := false;
- run_hooks After_setup;
- let explicit_name =
- (* Prevent use_silently from searching in the path. *)
- if Filename.is_implicit name
- then Filename.concat Filename.current_dir_name name
- else name
- in
- use_silently ppf explicit_name
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open Format
-
-(* Set the load paths, before running anything *)
-
-val set_paths : unit -> unit
-
-(* The interactive toplevel loop *)
-
-val loop : formatter -> unit
-
-(* Read and execute a script from the given file *)
-
-val run_script : formatter -> string -> string array -> bool
- (* true if successful, false if error *)
-
-(* Interface with toplevel directives *)
-
-type directive_fun =
- | Directive_none of (unit -> unit)
- | Directive_string of (string -> unit)
- | Directive_int of (int -> unit)
- | Directive_ident of (Longident.t -> unit)
- | Directive_bool of (bool -> unit)
-
-val directive_table : (string, directive_fun) Hashtbl.t
- (* Table of known directives, with their execution function *)
-val toplevel_env : Env.t ref
- (* Typing environment for the toplevel *)
-val initialize_toplevel_env : unit -> unit
- (* Initialize the typing environment for the toplevel *)
-val print_exception_outcome : formatter -> exn -> unit
- (* Print an exception resulting from the evaluation of user code. *)
-val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
- (* Execute the given toplevel phrase. Return [true] if the
- phrase executed with no errors and [false] otherwise.
- First bool says whether the values and types of the results
- should be printed. Uncaught exceptions are always printed. *)
-val preprocess_phrase :
- formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
- (* Preprocess the given toplevel phrase using regular and ppx
- preprocessors. Return the updated phrase. *)
-val use_file : formatter -> string -> bool
-val use_output : formatter -> string -> bool
-val use_silently : formatter -> string -> bool
-val mod_use_file : formatter -> string -> bool
- (* Read and execute commands from a file.
- [use_file] prints the types and values of the results.
- [use_silently] does not print them.
- [mod_use_file] wrap the file contents into a module. *)
-val eval_module_path: Env.t -> Path.t -> Obj.t
-val eval_value_path: Env.t -> Path.t -> Obj.t
-val eval_extension_path: Env.t -> Path.t -> Obj.t
-val eval_class_path: Env.t -> Path.t -> Obj.t
- (* Return the toplevel object referred to by the given path *)
-
-(* Printing of values *)
-
-val print_value: Env.t -> Obj.t -> formatter -> Types.type_expr -> unit
-val print_untyped_exception: formatter -> Obj.t -> unit
-
-type ('a, 'b) gen_printer =
- | Zero of 'b
- | Succ of ('a -> ('a, 'b) gen_printer)
-
-val install_printer :
- Path.t -> Types.type_expr -> (formatter -> Obj.t -> unit) -> unit
-val install_generic_printer :
- Path.t -> Path.t ->
- (int -> (int -> Obj.t -> Outcometree.out_value,
- Obj.t -> Outcometree.out_value) gen_printer) -> unit
-val install_generic_printer' :
- Path.t -> Path.t -> (formatter -> Obj.t -> unit,
- formatter -> Obj.t -> unit) gen_printer -> unit
-val remove_printer : Path.t -> unit
-
-val max_printer_depth: int ref
-val max_printer_steps: int ref
-
-(* Hooks for external parsers and printers *)
-
-val parse_toplevel_phrase : (Lexing.lexbuf -> Parsetree.toplevel_phrase) ref
-val parse_use_file : (Lexing.lexbuf -> Parsetree.toplevel_phrase list) ref
-val print_location : formatter -> Location.t -> unit
-val print_error : formatter -> Location.error -> unit
-val print_warning : Location.t -> formatter -> Warnings.t -> unit
-val input_name : string ref
-
-val print_out_value :
- (formatter -> Outcometree.out_value -> unit) ref
-val print_out_type :
- (formatter -> Outcometree.out_type -> unit) ref
-val print_out_class_type :
- (formatter -> Outcometree.out_class_type -> unit) ref
-val print_out_module_type :
- (formatter -> Outcometree.out_module_type -> unit) ref
-val print_out_type_extension :
- (formatter -> Outcometree.out_type_extension -> unit) ref
-val print_out_sig_item :
- (formatter -> Outcometree.out_sig_item -> unit) ref
-val print_out_signature :
- (formatter -> Outcometree.out_sig_item list -> unit) ref
-val print_out_phrase :
- (formatter -> Outcometree.out_phrase -> unit) ref
-
-(* Hooks for external line editor *)
-
-val read_interactive_input : (string -> bytes -> int -> int * bool) ref
-
-(* Hooks *)
-
-val toplevel_startup_hook : (unit -> unit) ref
-
-type event = ..
-type event +=
- | Startup
- | After_setup
- (* Just after the setup, when the toplevel is ready to evaluate user
- input. This happens before the toplevel has evaluated any kind of
- user input, in particular this happens before loading the
- [.ocamlinit] file. *)
-
-val add_hook : (event -> unit) -> unit
-(* Add a function that will be called at key points of the toplevel
- initialization process. *)
-
-val run_hooks : event -> unit
-(* Run all the registered hooks. *)
-
-
-(* Misc *)
-
-val override_sys_argv : string array -> unit
-(* [override_sys_argv args] replaces the contents of [Sys.argv] by [args]
- and reset [Arg.current] to [0].
-
- This is called by [run_script] so that [Sys.argv] represents
- "script.ml args..." instead of the full command line:
- "ocamlrun unix.cma ... script.ml args...". *)
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-open Compenv
-
-let usage =
- "Usage: ocamlnat <options> <object-files> [script-file]\noptions are:"
-
-let preload_objects = ref []
-
-(* Position of the first non expanded argument *)
-let first_nonexpanded_pos = ref 0
-
-let current = ref (!Arg.current)
-
-let argv = ref Sys.argv
-
-(* Test whether the option is part of a responsefile *)
-let is_expanded pos = pos < !first_nonexpanded_pos
-
-let expand_position pos len =
- if pos < !first_nonexpanded_pos then
- (* Shift the position *)
- first_nonexpanded_pos := !first_nonexpanded_pos + len
- else
- (* New last position *)
- first_nonexpanded_pos := pos + len + 2
-
-
-let prepare ppf =
- Opttoploop.set_paths ();
- try
- let res =
- List.for_all (Opttopdirs.load_file ppf) (List.rev !preload_objects)
- in
- Opttoploop.run_hooks Opttoploop.Startup;
- res
- with x ->
- try Location.report_exception ppf x; false
- with x ->
- Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
- false
-
-let file_argument name =
- let ppf = Format.err_formatter in
- if Filename.check_suffix name ".cmxs"
- || Filename.check_suffix name ".cmx"
- || Filename.check_suffix name ".cmxa"
- then preload_objects := name :: !preload_objects
- else if is_expanded !current then begin
- (* Script files are not allowed in expand options because otherwise the
- check in override arguments may fail since the new argv can be larger
- than the original argv.
- *)
- Printf.eprintf "For implementation reasons, the toplevel does not support\
- \ having script files (here %S) inside expanded arguments passed through\
- \ the -args{,0} command-line option.\n" name;
- raise (Exit_with_status 2)
- end else begin
- let newargs = Array.sub !argv !Arg.current
- (Array.length !argv - !Arg.current)
- in
- Compmisc.read_clflags_from_env ();
- if prepare ppf && Opttoploop.run_script ppf name newargs
- then raise (Exit_with_status 0)
- else raise (Exit_with_status 2)
- end
-
-let wrap_expand f s =
- let start = !current in
- let arr = f s in
- expand_position start (Array.length arr);
- arr
-
-module Options = Main_args.Make_opttop_options (struct
- include Main_args.Default.Opttopmain
- let _stdin () = file_argument ""
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
- let anonymous s = file_argument s
-end);;
-
-let () =
- let extra_paths =
- match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
- | exception Not_found -> []
- | s -> Misc.split_path_contents s
- in
- Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
-
-let main () =
- Clflags.native_code := true;
- let list = ref Options.list in
- begin
- try
- Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
- with
- | Arg.Bad msg -> Format.fprintf Format.err_formatter "%s%!" msg;
- raise (Exit_with_status 2)
- | Arg.Help msg -> Format.fprintf Format.std_formatter "%s%!" msg;
- raise (Exit_with_status 0)
- end;
- Compmisc.read_clflags_from_env ();
- if not (prepare Format.err_formatter) then raise (Exit_with_status 2);
- Compmisc.init_path ();
- Opttoploop.loop Format.std_formatter
-
-let main () =
- match main () with
- | exception Exit_with_status n -> n
- | () -> 0
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* Start the [ocaml] toplevel loop *)
-
-val main: unit -> int
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 2002 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-let _ = exit (Opttopmain.main())
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(* Definitions for the interactive toplevel loop that are common between
+ bytecode and native *)
+
+open Format
+open Parsetree
+open Outcometree
+open Ast_helper
+
+(* Hooks for parsing functions *)
+
+let parse_toplevel_phrase = ref Parse.toplevel_phrase
+let parse_use_file = ref Parse.use_file
+let print_location = Location.print_loc
+let print_error = Location.print_report
+let print_warning = Location.print_warning
+let input_name = Location.input_name
+
+let parse_mod_use_file name lb =
+ let modname =
+ String.capitalize_ascii
+ (Filename.remove_extension (Filename.basename name))
+ in
+ let items =
+ List.concat
+ (List.map
+ (function Ptop_def s -> s | Ptop_dir _ -> [])
+ (!parse_use_file lb))
+ in
+ [ Ptop_def
+ [ Str.module_
+ (Mb.mk
+ (Location.mknoloc (Some modname))
+ (Mod.structure items)
+ )
+ ]
+ ]
+
+(* Hooks for printing *)
+
+let max_printer_depth = ref 100
+let max_printer_steps = ref 300
+
+let print_out_value = Oprint.out_value
+let print_out_type = Oprint.out_type
+let print_out_class_type = Oprint.out_class_type
+let print_out_module_type = Oprint.out_module_type
+let print_out_type_extension = Oprint.out_type_extension
+let print_out_sig_item = Oprint.out_sig_item
+let print_out_signature = Oprint.out_signature
+let print_out_phrase = Oprint.out_phrase
+
+
+(* The current typing environment for the toplevel *)
+
+let toplevel_env = ref Env.empty
+
+let backtrace = ref None
+
+(* Generic evaluator and printer *)
+
+exception Undefined_global of string
+
+module type EVAL_BASE = sig
+
+ (* Return the value referred to by a base ident.
+ @raise [Undefined_global] if not found *)
+ val eval_ident: Ident.t -> Obj.t
+
+end
+
+module MakeEvalPrinter (E: EVAL_BASE) = struct
+
+ let rec eval_address = function
+ | Env.Aident id -> E.eval_ident id
+ | Env.Adot(p, pos) -> Obj.field (eval_address p) pos
+
+ let eval_path find env path =
+ match find path env with
+ | addr -> eval_address addr
+ | exception Not_found ->
+ Misc.fatal_error ("Cannot find address for: " ^ (Path.name path))
+
+ let eval_module_path env path =
+ eval_path Env.find_module_address env path
+
+ let eval_value_path env path =
+ eval_path Env.find_value_address env path
+
+ let eval_extension_path env path =
+ eval_path Env.find_constructor_address env path
+
+ let eval_class_path env path =
+ eval_path Env.find_class_address env path
+
+
+ module Printer = Genprintval.Make(Obj)(struct
+ type valu = Obj.t
+ exception Error
+ let eval_address addr =
+ try eval_address addr
+ with Undefined_global _ ->
+ raise Error
+ let same_value v1 v2 = (v1 == v2)
+ end)
+
+ let print_untyped_exception ppf obj =
+ !print_out_value ppf (Printer.outval_of_untyped_exception obj)
+ let outval_of_value env obj ty =
+ Printer.outval_of_value !max_printer_steps !max_printer_depth
+ (fun _ _ _ -> None) env obj ty
+ let print_value env obj ppf ty =
+ !print_out_value ppf (outval_of_value env obj ty)
+
+ (* Print an exception produced by an evaluation *)
+
+ let print_out_exception ppf exn outv =
+ !print_out_phrase ppf (Ophr_exception (exn, outv))
+
+ let print_exception_outcome ppf exn =
+ if exn = Out_of_memory then Gc.full_major ();
+ let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
+ print_out_exception ppf exn outv;
+ if Printexc.backtrace_status ()
+ then
+ match !backtrace with
+ | None -> ()
+ | Some b ->
+ print_string b;
+ backtrace := None
+
+ type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
+ let install_printer = Printer.install_printer
+ let install_generic_printer = Printer.install_generic_printer
+ let install_generic_printer' = Printer.install_generic_printer'
+ let remove_printer = Printer.remove_printer
+
+end
+
+
+(* Hook for initialization *)
+
+let toplevel_startup_hook = ref (fun () -> ())
+
+type event = ..
+type event +=
+ | Startup
+ | After_setup
+
+let hooks = ref []
+
+let add_hook f = hooks := f :: !hooks
+
+let () =
+ add_hook (function
+ | Startup -> !toplevel_startup_hook ()
+ | _ -> ())
+
+let run_hooks hook = List.iter (fun f -> f hook) !hooks
+
+(* Helpers for execution *)
+
+type evaluation_outcome = Result of Obj.t | Exception of exn
+
+let record_backtrace () =
+ if Printexc.backtrace_status ()
+ then backtrace := Some (Printexc.get_backtrace ())
+
+let preprocess_phrase ppf phr =
+ let phr =
+ match phr with
+ | Ptop_def str ->
+ let str =
+ Pparse.apply_rewriters_str ~restore:true ~tool_name:"ocaml" str
+ in
+ Ptop_def str
+ | phr -> phr
+ in
+ if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
+ if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
+ phr
+
+(* Phrase buffer that stores the last toplevel phrase (see
+ [Location.input_phrase_buffer]). *)
+let phrase_buffer = Buffer.create 1024
+
+(* Reading function for interactive use *)
+
+let first_line = ref true
+let got_eof = ref false
+
+let read_input_default prompt buffer len =
+ output_string stdout prompt; flush stdout;
+ let i = ref 0 in
+ try
+ while true do
+ if !i >= len then raise Exit;
+ let c = input_char stdin in
+ Bytes.set buffer !i c;
+ (* Also populate the phrase buffer as new characters are added. *)
+ Buffer.add_char phrase_buffer c;
+ incr i;
+ if c = '\n' then raise Exit;
+ done;
+ (!i, false)
+ with
+ | End_of_file ->
+ (!i, true)
+ | Exit ->
+ (!i, false)
+
+let read_interactive_input = ref read_input_default
+
+let refill_lexbuf buffer len =
+ if !got_eof then (got_eof := false; 0) else begin
+ let prompt =
+ if !Clflags.noprompt then ""
+ else if !first_line then "# "
+ else if !Clflags.nopromptcont then ""
+ else if Lexer.in_comment () then "* "
+ else " "
+ in
+ first_line := false;
+ let (len, eof) = !read_interactive_input prompt buffer len in
+ if eof then begin
+ Location.echo_eof ();
+ if len > 0 then got_eof := true;
+ len
+ end else
+ len
+ end
+
+let set_paths () =
+ (* Add whatever -I options have been specified on the command line,
+ but keep the directories that user code linked in with ocamlmktop
+ may have added to load_path. *)
+ let expand = Misc.expand_directory Config.standard_library in
+ let current_load_path = Load_path.get_paths () in
+ let load_path = List.concat [
+ [ "" ];
+ List.map expand (List.rev !Compenv.first_include_dirs);
+ List.map expand (List.rev !Clflags.include_dirs);
+ List.map expand (List.rev !Compenv.last_include_dirs);
+ current_load_path;
+ [expand "+camlp4"];
+ ]
+ in
+ Load_path.init load_path;
+ Dll.add_path load_path
+
+let initialize_toplevel_env () =
+ toplevel_env := Compmisc.initial_env()
+
+external caml_sys_modify_argv : string array -> unit =
+ "caml_sys_modify_argv"
+
+let override_sys_argv new_argv =
+ caml_sys_modify_argv new_argv;
+ Arg.current := 0
+
+
+(* The table of toplevel directives.
+ Filled by functions from module topdirs. *)
+
+type directive_fun =
+ | Directive_none of (unit -> unit)
+ | Directive_string of (string -> unit)
+ | Directive_int of (int -> unit)
+ | Directive_ident of (Longident.t -> unit)
+ | Directive_bool of (bool -> unit)
+
+type directive_info = {
+ section: string;
+ doc: string;
+}
+
+let directive_table = (Hashtbl.create 23 : (string, directive_fun) Hashtbl.t)
+
+let directive_info_table =
+ (Hashtbl.create 23 : (string, directive_info) Hashtbl.t)
+
+let add_directive name dir_fun dir_info =
+ Hashtbl.add directive_table name dir_fun;
+ Hashtbl.add directive_info_table name dir_info
+
+let get_directive name =
+ Hashtbl.find_opt directive_table name
+
+let get_directive_info name =
+ Hashtbl.find_opt directive_info_table name
+
+let all_directive_names () =
+ Hashtbl.fold (fun dir _ acc -> dir::acc) directive_table []
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides common implementations for internals of [Toploop], for
+ bytecode and native code (see [Topeval] for the diverging parts of the
+ implementation).
+
+ You should not use it directly, refer to the functions in [Toploop] instead.
+*)
+
+(**/**)
+
+(* Definitions for the interactive toplevel loop that are common between
+ bytecode and native *)
+
+open Format
+
+(* Set the load paths, before running anything *)
+
+val set_paths : unit -> unit
+
+(* Management and helpers for the execution *)
+
+val toplevel_env : Env.t ref
+ (* Typing environment for the toplevel *)
+val initialize_toplevel_env : unit -> unit
+ (* Initialize the typing environment for the toplevel *)
+val preprocess_phrase :
+ formatter -> Parsetree.toplevel_phrase -> Parsetree.toplevel_phrase
+ (* Preprocess the given toplevel phrase using regular and ppx
+ preprocessors. Return the updated phrase. *)
+val record_backtrace : unit -> unit
+
+
+(* Printing of values *)
+
+val max_printer_depth: int ref
+val max_printer_steps: int ref
+
+val print_out_value :
+ (formatter -> Outcometree.out_value -> unit) ref
+val print_out_type :
+ (formatter -> Outcometree.out_type -> unit) ref
+val print_out_class_type :
+ (formatter -> Outcometree.out_class_type -> unit) ref
+val print_out_module_type :
+ (formatter -> Outcometree.out_module_type -> unit) ref
+val print_out_type_extension :
+ (formatter -> Outcometree.out_type_extension -> unit) ref
+val print_out_sig_item :
+ (formatter -> Outcometree.out_sig_item -> unit) ref
+val print_out_signature :
+ (formatter -> Outcometree.out_sig_item list -> unit) ref
+val print_out_phrase :
+ (formatter -> Outcometree.out_phrase -> unit) ref
+
+
+exception Undefined_global of string
+
+module type EVAL_BASE = sig
+
+ (* Return the value referred to by a base ident
+ @raise [Undefined_global] if not found *)
+ val eval_ident: Ident.t -> Obj.t
+
+end
+
+
+module MakeEvalPrinter (_ : EVAL_BASE) : sig
+
+ val eval_address: Env.address -> Obj.t
+ (* Used for printers *)
+
+ val eval_module_path: Env.t -> Path.t -> Obj.t
+ val eval_value_path: Env.t -> Path.t -> Obj.t
+ val eval_extension_path: Env.t -> Path.t -> Obj.t
+ val eval_class_path: Env.t -> Path.t -> Obj.t
+ (* Return the toplevel object referred to by the given path *)
+
+ module Printer: Genprintval.S with type t = Obj.t
+
+ val print_value: Env.t -> Printer.t -> formatter -> Types.type_expr -> unit
+
+ val print_untyped_exception: formatter -> Printer.t -> unit
+
+ val print_exception_outcome : formatter -> exn -> unit
+ (* Print an exception resulting from the evaluation of user code. *)
+
+ val outval_of_value:
+ Env.t -> Printer.t -> Types.type_expr -> Outcometree.out_value
+
+ type ('a, 'b) gen_printer =
+ | Zero of 'b
+ | Succ of ('a -> ('a, 'b) gen_printer)
+
+ val install_printer :
+ Path.t -> Types.type_expr -> (formatter -> Printer.t -> unit) -> unit
+ val install_generic_printer :
+ Path.t -> Path.t ->
+ (int -> (int -> Printer.t -> Outcometree.out_value,
+ Printer.t-> Outcometree.out_value) gen_printer) -> unit
+ val install_generic_printer' :
+ Path.t -> Path.t -> (formatter -> Printer.t -> unit,
+ formatter -> Printer.t -> unit) gen_printer -> unit
+ val remove_printer : Path.t -> unit
+
+end
+
+
+(* Interface with toplevel directives *)
+
+type directive_fun =
+ | Directive_none of (unit -> unit)
+ | Directive_string of (string -> unit)
+ | Directive_int of (int -> unit)
+ | Directive_ident of (Longident.t -> unit)
+ | Directive_bool of (bool -> unit)
+
+type directive_info = {
+ section: string;
+ doc: string;
+}
+
+(* Add toplevel directive and its documentation.
+ @since 4.03 *)
+val add_directive : string -> directive_fun -> directive_info -> unit
+
+val get_directive : string -> directive_fun option
+
+val get_directive_info : string -> directive_info option
+
+val all_directive_names : unit -> string list
+
+val[@deprecated] directive_table : (string, directive_fun) Hashtbl.t
+ (* @deprecated please use [add_directive] instead of inserting
+ in this table directly. *)
+
+val[@deprecated] directive_info_table : (string, directive_info) Hashtbl.t
+ (* @deprecated please use [add_directive] instead of inserting
+ in this table directly. *)
+
+(* Hooks for external parsers and printers *)
+
+val parse_toplevel_phrase : (Lexing.lexbuf -> Parsetree.toplevel_phrase) ref
+val parse_use_file : (Lexing.lexbuf -> Parsetree.toplevel_phrase list) ref
+val print_location : formatter -> Location.t -> unit
+val print_error : formatter -> Location.error -> unit
+val print_warning : Location.t -> formatter -> Warnings.t -> unit
+val input_name : string ref
+
+(* Hooks for external line editor *)
+
+(* Phrase buffer that stores the last toplevel phrase (see
+ [Location.input_phrase_buffer]). *)
+val phrase_buffer : Buffer.t
+
+val first_line : bool ref
+
+val got_eof : bool ref
+
+val read_interactive_input : (string -> bytes -> int -> int * bool) ref
+
+(* Hooks *)
+
+val toplevel_startup_hook : (unit -> unit) ref
+
+type event = ..
+type event +=
+ | Startup
+ | After_setup
+ (* Just after the setup, when the toplevel is ready to evaluate user
+ input. This happens before the toplevel has evaluated any kind of
+ user input, in particular this happens before loading the
+ [.ocamlinit] file. *)
+
+val add_hook : (event -> unit) -> unit
+(* Add a function that will be called at key points of the toplevel
+ initialization process. *)
+
+val run_hooks : event -> unit
+(* Run all the registered hooks. *)
+
+(* Misc *)
+
+val override_sys_argv : string array -> unit
+(* [override_sys_argv args] replaces the contents of [Sys.argv] by [args]
+ and reset [Arg.current] to [0].
+
+ This is called by [run_script] so that [Sys.argv] represents
+ "script.ml args..." instead of the full command line:
+ "ocamlrun unix.cma ... script.ml args...". *)
+
+(**/**)
+
+(* internal functions used by [Topeval] *)
+
+type evaluation_outcome = Result of Obj.t | Exception of exn
+
+val backtrace: string option ref
+
+val parse_mod_use_file:
+ string -> Lexing.lexbuf -> Parsetree.toplevel_phrase list
+
+val refill_lexbuf: bytes -> int -> int
open Misc
open Longident
open Types
-open Cmo_format
-open Trace
open Toploop
(* The standard output formatter *)
section_undocumented;
])
(* Do not forget to keep the directives synchronized with the manual in
- manual/manual/cmds/top.etex *)
+ manual/src/cmds/top.etex *)
(* To quit *)
section = section_run;
doc = "Remove the given directory from the search path.";
}
+
+let dir_show_dirs () =
+ List.iter print_endline (Load_path.get_paths ())
+
+let _ = add_directive "show_dirs" (Directive_none dir_show_dirs)
+ {
+ section = section_run;
+ doc = "List directories currently in the search path.";
+ }
+
(* To change the current directory *)
let dir_cd s = Sys.chdir s
section = section_run;
doc = "Change the current working directory.";
}
-(* Load in-core a .cmo file *)
-
-exception Load_failed
-
-let check_consistency ppf filename cu =
- try Env.import_crcs ~source:filename cu.cu_imports
- with Persistent_env.Consistbl.Inconsistency {
- unit_name = name;
- inconsistent_source = user;
- original_source = auth;
- } ->
- fprintf ppf "@[<hv 0>The files %s@ and %s@ \
- disagree over interface %s@]@."
- user auth name;
- raise Load_failed
-
-let load_compunit ic filename ppf compunit =
- check_consistency ppf filename compunit;
- seek_in ic compunit.cu_pos;
- let code_size = compunit.cu_codesize + 8 in
- let code = LongString.create code_size in
- LongString.input_bytes_into code ic compunit.cu_codesize;
- LongString.set code compunit.cu_codesize (Char.chr Opcodes.opRETURN);
- LongString.blit_string "\000\000\000\001\000\000\000" 0
- code (compunit.cu_codesize + 1) 7;
- let initial_symtable = Symtable.current_state() in
- Symtable.patch_object code compunit.cu_reloc;
- Symtable.update_global_table();
- let events =
- if compunit.cu_debug = 0 then [| |]
- else begin
- seek_in ic compunit.cu_debug;
- [| input_value ic |]
- end in
- begin try
- may_trace := true;
- let _bytecode, closure = Meta.reify_bytecode code events None in
- ignore (closure ());
- may_trace := false;
- with exn ->
- record_backtrace ();
- may_trace := false;
- Symtable.restore_state initial_symtable;
- print_exception_outcome ppf exn;
- raise Load_failed
- end
-let rec load_file recursive ppf name =
- let filename =
- try Some (Load_path.find name) with Not_found -> None
- in
- match filename with
- | None -> fprintf ppf "Cannot find file %s.@." name; false
- | Some filename ->
- let ic = open_in_bin filename in
- Misc.try_finally
- ~always:(fun () -> close_in ic)
- (fun () -> really_load_file recursive ppf name filename ic)
-
-and really_load_file recursive ppf name filename ic =
- let buffer = really_input_string ic (String.length Config.cmo_magic_number) in
- try
- if buffer = Config.cmo_magic_number then begin
- let compunit_pos = input_binary_int ic in (* Go to descriptor *)
- seek_in ic compunit_pos;
- let cu : compilation_unit = input_value ic in
- if recursive then
- List.iter
- (function
- | (Reloc_getglobal id, _)
- when not (Symtable.is_global_defined id) ->
- let file = Ident.name id ^ ".cmo" in
- begin match Load_path.find_uncap file with
- | exception Not_found -> ()
- | file ->
- if not (load_file recursive ppf file) then raise Load_failed
- end
- | _ -> ()
- )
- cu.cu_reloc;
- load_compunit ic filename ppf cu;
- true
- end else
- if buffer = Config.cma_magic_number then begin
- let toc_pos = input_binary_int ic in (* Go to table of contents *)
- seek_in ic toc_pos;
- let lib = (input_value ic : library) in
- List.iter
- (fun dllib ->
- let name = Dll.extract_dll_name dllib in
- try Dll.open_dlls Dll.For_execution [name]
- with Failure reason ->
- fprintf ppf
- "Cannot load required shared library %s.@.Reason: %s.@."
- name reason;
- raise Load_failed)
- lib.lib_dllibs;
- List.iter (load_compunit ic filename ppf) lib.lib_units;
- true
- end else begin
- fprintf ppf "File %s is not a bytecode object file.@." name;
- false
- end
- with Load_failed -> false
-
-let dir_load ppf name = ignore (load_file false ppf name)
+let dir_load ppf name = ignore (Topeval.load_file false ppf name)
let _ = add_directive "load" (Directive_string (dir_load std_out))
{
doc = "Load in memory a bytecode object, produced by ocamlc.";
}
-let dir_load_rec ppf name = ignore (load_file true ppf name)
+let dir_load_rec ppf name = ignore (Topeval.load_file true ppf name)
let _ = add_directive "load_rec"
(Directive_string (dir_load_rec std_out))
doc = "As #load, but loads dependencies recursively.";
}
-let load_file = load_file false
+let load_file = Topeval.load_file false
(* Load commands from a file *)
doc = "Remove the named function from the table of toplevel printers.";
}
-(* The trace *)
-
-external current_environment: unit -> Obj.t = "caml_get_current_environment"
-
-let tracing_function_ptr =
- get_code_pointer
- (Obj.repr (fun arg -> Trace.print_trace (current_environment()) arg))
-
-let dir_trace ppf lid =
- match Env.find_value_by_name lid !toplevel_env with
- | (path, desc) -> begin
- (* Check if this is a primitive *)
- match desc.val_kind with
- | Val_prim _ ->
- fprintf ppf "%a is an external function and cannot be traced.@."
- Printtyp.longident lid
- | _ ->
- let clos = eval_value_path !toplevel_env path in
- (* Nothing to do if it's not a closure *)
- if Obj.is_block clos
- && (Obj.tag clos = Obj.closure_tag || Obj.tag clos = Obj.infix_tag)
- && (match Ctype.(repr (expand_head !toplevel_env desc.val_type))
- with {desc=Tarrow _} -> true | _ -> false)
- then begin
- match is_traced clos with
- | Some opath ->
- fprintf ppf "%a is already traced (under the name %a).@."
- Printtyp.path path
- Printtyp.path opath
- | None ->
- (* Instrument the old closure *)
- traced_functions :=
- { path = path;
- closure = clos;
- actual_code = get_code_pointer clos;
- instrumented_fun =
- instrument_closure !toplevel_env lid ppf desc.val_type }
- :: !traced_functions;
- (* Redirect the code field of the closure to point
- to the instrumentation function *)
- set_code_pointer clos tracing_function_ptr;
- fprintf ppf "%a is now traced.@." Printtyp.longident lid
- end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
- end
- | exception Not_found ->
- fprintf ppf "Unbound value %a.@." Printtyp.longident lid
-
-let dir_untrace ppf lid =
- match Env.find_value_by_name lid !toplevel_env with
- | (path, _desc) ->
- let rec remove = function
- | [] ->
- fprintf ppf "%a was not traced.@." Printtyp.longident lid;
- []
- | f :: rem ->
- if Path.same f.path path then begin
- set_code_pointer f.closure f.actual_code;
- fprintf ppf "%a is no longer traced.@." Printtyp.longident lid;
- rem
- end else f :: remove rem in
- traced_functions := remove !traced_functions
- | exception Not_found ->
- fprintf ppf "Unbound value %a.@." Printtyp.longident lid
-
-let dir_untrace_all ppf () =
- List.iter
- (fun f ->
- set_code_pointer f.closure f.actual_code;
- fprintf ppf "%a is no longer traced.@." Printtyp.path f.path)
- !traced_functions;
- traced_functions := []
-
let parse_warnings ppf iserr s =
- try Warnings.parse_options iserr s
+ try Option.iter Location.(prerr_alert none) @@ Warnings.parse_options iserr s
with Arg.Bad err -> fprintf ppf "%s.@." err
(* Typing information *)
| mty -> mty
let show_prim to_sig ppf lid =
- let env = !Toploop.toplevel_env in
+ let env = !toplevel_env in
let loc = Location.none in
try
let s =
)
"Print the signature of the corresponding value."
+let is_nonrec_type id td =
+ (* We track both recursive uses of t (`type t = X of t`) and
+ nonrecursive uses (`type nonrec t = t`) to only print the nonrec keyword
+ when it is necessary to make the type printable.
+ *)
+ let recursive_use = ref false in
+ let nonrecursive_use = ref false in
+ let it_path = function
+ | Path.Pident id' when Ident.name id' = Ident.name id ->
+ if Ident.same id id' then
+ recursive_use := true
+ else
+ nonrecursive_use:= true
+ | _ -> ()
+ in
+ let it = Btype.{type_iterators with it_path } in
+ let () =
+ it.it_type_declaration it td;
+ Btype.unmark_iterators.it_type_declaration Btype.unmark_iterators td
+ in
+ match !recursive_use, !nonrecursive_use with
+ | false, true -> Trec_not
+ | true, _ | _, false -> Trec_first
+ (* note: true, true is possible *)
+
let () =
reg_show_prim "show_type"
(fun env loc id lid ->
- let _path, desc = Env.lookup_type ~loc lid env in
- [ Sig_type (id, desc, Trec_not, Exported) ]
+ let path, desc = Env.lookup_type ~loc lid env in
+ let id, rs = match path with
+ | Pident id -> id, is_nonrec_type id desc
+ | _ -> id, Trec_first
+ in
+ [ Sig_type (id, desc, rs, Exported) ]
)
"Print the signature of the corresponding type constructor."
* one for exception constructors and another for
* non-exception constructors (normal and extensible variants). *)
let is_exception_constructor env type_expr =
- Ctype.equal env true [type_expr] [Predef.type_exn]
+ Ctype.is_equal env true [type_expr] [Predef.type_exn]
let is_extension_constructor = function
| Cstr_extension _ -> true
)
"Print the signature of the corresponding exception."
+let is_rec_module id md =
+ let exception Exit in
+ let rec it_path = function
+ | Path.Pdot(root, _ ) -> it_path root
+ | Path.Pident id' -> if (Ident.same id id') then raise Exit
+ | _ -> ()
+ in
+ let it = Btype.{type_iterators with it_path } in
+ let rs = match it.it_module_declaration it md with
+ | () -> Trec_not
+ | exception Exit -> Trec_first
+ in
+ Btype.unmark_iterators.it_module_declaration Btype.unmark_iterators md;
+ rs
+
+
let () =
reg_show_prim "show_module"
(fun env loc id lid ->
+ let path, md = Env.lookup_module ~loc lid env in
+ let id = match path with
+ | Pident id -> id
+ | _ -> id
+ in
let rec accum_aliases md acc =
- let acc =
+ let acc rs =
Sig_module (id, Mp_present,
{md with md_type = trim_signature md.md_type},
- Trec_not, Exported) :: acc in
+ rs, Exported) :: acc in
match md.md_type with
| Mty_alias path ->
let md = Env.find_module path env in
- accum_aliases md acc
+ accum_aliases md (acc Trec_not)
| Mty_ident _ | Mty_signature _ | Mty_functor _ ->
- List.rev acc
+ List.rev (acc (is_rec_module id md))
in
- let _, md = Env.lookup_module ~loc lid env in
accum_aliases md []
)
"Print the signature of the corresponding module."
from any of the categories below.";
}
-let _ = add_directive "trace"
- (Directive_ident (dir_trace std_out))
- {
- section = section_trace;
- doc = "All calls to the function \
- named function-name will be traced.";
- }
-
-let _ = add_directive "untrace"
- (Directive_ident (dir_untrace std_out))
- {
- section = section_trace;
- doc = "Stop tracing the given function.";
- }
-
-let _ = add_directive "untrace_all"
- (Directive_none (dir_untrace_all std_out))
- {
- section = section_trace;
- doc = "Stop tracing all functions traced so far.";
- }
-
(* Control the printing of values *)
let _ = add_directive "print_depth"
let directive_sections () =
let sections = Hashtbl.create 10 in
- let add_dir name dir =
+ let add_dir name =
+ let dir =
+ match get_directive name with
+ | Some dir -> dir
+ | None -> assert false
+ in
let section, doc =
- match Hashtbl.find directive_info_table name with
- | { section; doc } -> section, Some doc
- | exception Not_found -> "Undocumented", None
+ match get_directive_info name with
+ | Some { section; doc } -> section, Some doc
+ | None -> "Undocumented", None
in
Hashtbl.replace sections section
((name, dir, doc)
:: (try Hashtbl.find sections section with Not_found -> []))
in
- Hashtbl.iter add_dir directive_table;
+ List.iter add_dir (all_directive_names ());
let take_section section =
if not (Hashtbl.mem sections section) then (section, [])
else begin
val dir_use_output : formatter -> string -> unit
val dir_install_printer : formatter -> Longident.t -> unit
val dir_remove_printer : formatter -> Longident.t -> unit
+
+(* These are now injected from [Topeval], for the bytecode toplevel only:
val dir_trace : formatter -> Longident.t -> unit
val dir_untrace : formatter -> Longident.t -> unit
val dir_untrace_all : formatter -> unit -> unit
+ *)
+
+val section_general : string
+val section_run : string
+val section_env : string
+
+val section_print : string
+val section_trace : string
+val section_options : string
+
+val section_undocumented : string
+
type 'a printer_type_new = Format.formatter -> 'a -> unit
type 'a printer_type_old = 'a -> unit
-(* For topmain.ml. Maybe shouldn't be there *)
-val load_file : formatter -> string -> bool
+(* Here for backwards compatibility, use [Toploop.load_file]. *)
+val[@deprecated] load_file : formatter -> string -> bool
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
+(* *)
+(* Copyright 1996 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** This module provides two alternative implementations for internals of
+ [Toploop], for bytecode and native code.
+
+ You should not use it directly, refer to the functions in [Toploop] instead.
+*)
+
+(**/**)
+
+open Format
+
+(* Accessors for the table of toplevel value bindings. For the bytecode
+ toplevel, these functions must appear as first and second exported functions
+ in this module.
+ (See module Translmod.)
+ They aren't used for the native toplevel.
+*)
+val getvalue : string -> Obj.t
+val setvalue : string -> Obj.t -> unit
+
+(* Label appended after [OCaml version XXX] when starting the toplevel. *)
+val implementation_label: string
+
+val execute_phrase : bool -> formatter -> Parsetree.toplevel_phrase -> bool
+ (* Read and execute commands from a file.
+ [use_file] prints the types and values of the results.
+ [use_silently] does not print them.
+ [mod_use_file] wrap the file contents into a module. *)
+
+val may_trace : bool ref
+
+module EvalBase: Topcommon.EVAL_BASE
+
+include module type of Topcommon.MakeEvalPrinter(EvalBase)
+
+(* For topmain.ml. Maybe shouldn't be there *)
+val load_file : bool -> formatter -> string -> bool
+
+val init: unit -> unit
(* *)
(**************************************************************************)
-(* The interactive toplevel loop *)
-
open Format
-open Misc
-open Parsetree
-open Types
-open Typedtree
-open Outcometree
-open Ast_helper
-module String = Misc.Stdlib.String
-
-type directive_fun =
- | Directive_none of (unit -> unit)
- | Directive_string of (string -> unit)
- | Directive_int of (int -> unit)
- | Directive_ident of (Longident.t -> unit)
- | Directive_bool of (bool -> unit)
-
-type directive_info = {
- section: string;
- doc: string;
-}
-
-(* Phase buffer that stores the last toplevel phrase (see
- [Location.input_phrase_buffer]). *)
-let phrase_buffer = Buffer.create 1024
-
-(* The table of toplevel value bindings and its accessors *)
-
-let toplevel_value_bindings : Obj.t String.Map.t ref = ref String.Map.empty
-
-let getvalue name =
- try
- String.Map.find name !toplevel_value_bindings
- with Not_found ->
- fatal_error (name ^ " unbound at toplevel")
-
-let setvalue name v =
- toplevel_value_bindings := String.Map.add name v !toplevel_value_bindings
-
-(* Return the value referred to by a path *)
-
-let rec eval_address = function
- | Env.Aident id ->
- if Ident.persistent id || Ident.global id then
- Symtable.get_global_value id
- else begin
- let name = Translmod.toplevel_name id in
- try
- String.Map.find name !toplevel_value_bindings
- with Not_found ->
- raise (Symtable.Error(Symtable.Undefined_global name))
- end
- | Env.Adot(p, pos) ->
- Obj.field (eval_address p) pos
-
-let eval_path find env path =
- match find path env with
- | addr -> eval_address addr
- | exception Not_found ->
- fatal_error ("Cannot find address for: " ^ (Path.name path))
-
-let eval_module_path env path =
- eval_path Env.find_module_address env path
-
-let eval_value_path env path =
- eval_path Env.find_value_address env path
-
-let eval_extension_path env path =
- eval_path Env.find_constructor_address env path
-
-let eval_class_path env path =
- eval_path Env.find_class_address env path
-
-(* To print values *)
-
-module EvalPath = struct
- type valu = Obj.t
- exception Error
- let eval_address addr =
- try eval_address addr with Symtable.Error _ -> raise Error
- let same_value v1 v2 = (v1 == v2)
-end
-
-module Printer = Genprintval.Make(Obj)(EvalPath)
-
-let max_printer_depth = ref 100
-let max_printer_steps = ref 300
-
-let print_out_value = Oprint.out_value
-let print_out_type = Oprint.out_type
-let print_out_class_type = Oprint.out_class_type
-let print_out_module_type = Oprint.out_module_type
-let print_out_type_extension = Oprint.out_type_extension
-let print_out_sig_item = Oprint.out_sig_item
-let print_out_signature = Oprint.out_signature
-let print_out_phrase = Oprint.out_phrase
-
-let print_untyped_exception ppf obj =
- !print_out_value ppf (Printer.outval_of_untyped_exception obj)
-let outval_of_value env obj ty =
- Printer.outval_of_value !max_printer_steps !max_printer_depth
- (fun _ _ _ -> None) env obj ty
-let print_value env obj ppf ty =
- !print_out_value ppf (outval_of_value env obj ty)
-
-type ('a, 'b) gen_printer = ('a, 'b) Genprintval.gen_printer =
- | Zero of 'b
- | Succ of ('a -> ('a, 'b) gen_printer)
-
-let install_printer = Printer.install_printer
-let install_generic_printer = Printer.install_generic_printer
-let install_generic_printer' = Printer.install_generic_printer'
-let remove_printer = Printer.remove_printer
-
-(* Hooks for parsing functions *)
-
-let parse_toplevel_phrase = ref Parse.toplevel_phrase
-let parse_use_file = ref Parse.use_file
-let print_location = Location.print_loc
-let print_error = Location.print_report
-let print_warning = Location.print_warning
-let input_name = Location.input_name
-
-let parse_mod_use_file name lb =
- let modname =
- String.capitalize_ascii
- (Filename.remove_extension (Filename.basename name))
- in
- let items =
- List.concat
- (List.map
- (function Ptop_def s -> s | Ptop_dir _ -> [])
- (!parse_use_file lb))
- in
- [ Ptop_def
- [ Str.module_
- (Mb.mk
- (Location.mknoloc (Some modname))
- (Mod.structure items)
- )
- ]
- ]
-
-(* Hook for initialization *)
-
-let toplevel_startup_hook = ref (fun () -> ())
-
-type event = ..
-type event +=
- | Startup
- | After_setup
-
-let hooks = ref []
-
-let add_hook f = hooks := f :: !hooks
-
-let () =
- add_hook (function
- | Startup -> !toplevel_startup_hook ()
- | _ -> ())
-
-let run_hooks hook = List.iter (fun f -> f hook) !hooks
-
-(* Load in-core and execute a lambda term *)
-
-let may_trace = ref false (* Global lock on tracing *)
-type evaluation_outcome = Result of Obj.t | Exception of exn
-
-let backtrace = ref None
-
-let record_backtrace () =
- if Printexc.backtrace_status ()
- then backtrace := Some (Printexc.get_backtrace ())
-
-let load_lambda ppf lam =
- if !Clflags.dump_rawlambda then fprintf ppf "%a@." Printlambda.lambda lam;
- let slam = Simplif.simplify_lambda lam in
- if !Clflags.dump_lambda then fprintf ppf "%a@." Printlambda.lambda slam;
- let (init_code, fun_code) = Bytegen.compile_phrase slam in
- if !Clflags.dump_instr then
- fprintf ppf "%a%a@."
- Printinstr.instrlist init_code
- Printinstr.instrlist fun_code;
- let (code, reloc, events) =
- Emitcode.to_memory init_code fun_code
- in
- let can_free = (fun_code = []) in
- let initial_symtable = Symtable.current_state() in
- Symtable.patch_object code reloc;
- Symtable.check_global_initialized reloc;
- Symtable.update_global_table();
- let initial_bindings = !toplevel_value_bindings in
- let bytecode, closure = Meta.reify_bytecode code [| events |] None in
- match
- may_trace := true;
- Fun.protect
- ~finally:(fun () -> may_trace := false;
- if can_free then Meta.release_bytecode bytecode)
- closure
- with
- | retval -> Result retval
- | exception x ->
- record_backtrace ();
- toplevel_value_bindings := initial_bindings; (* PR#6211 *)
- Symtable.restore_state initial_symtable;
- Exception x
-
-(* Print the outcome of an evaluation *)
-
-let pr_item =
- Printtyp.print_items
- (fun env -> function
- | Sig_value(id, {val_kind = Val_reg; val_type}, _) ->
- Some (outval_of_value env (getvalue (Translmod.toplevel_name id))
- val_type)
- | _ -> None
- )
-
-(* The current typing environment for the toplevel *)
-
-let toplevel_env = ref Env.empty
-
-(* Print an exception produced by an evaluation *)
-
-let print_out_exception ppf exn outv =
- !print_out_phrase ppf (Ophr_exception (exn, outv))
-
-let print_exception_outcome ppf exn =
- if exn = Out_of_memory then Gc.full_major ();
- let outv = outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn in
- print_out_exception ppf exn outv;
- if Printexc.backtrace_status ()
- then
- match !backtrace with
- | None -> ()
- | Some b ->
- print_string b;
- backtrace := None
-
-
-(* Inserting new toplevel directives *)
-
-let directive_table = (Hashtbl.create 23 : (string, directive_fun) Hashtbl.t)
-
-let directive_info_table =
- (Hashtbl.create 23 : (string, directive_info) Hashtbl.t)
-
-let add_directive name dir_fun dir_info =
- Hashtbl.add directive_table name dir_fun;
- Hashtbl.add directive_info_table name dir_info
-
-(* Execute a toplevel phrase *)
-
-let execute_phrase print_outcome ppf phr =
- match phr with
- | Ptop_def sstr ->
- let oldenv = !toplevel_env in
- Typecore.reset_delayed_checks ();
- let (str, sg, sn, newenv) = Typemod.type_toplevel_phrase oldenv sstr in
- if !Clflags.dump_typedtree then Printtyped.implementation ppf str;
- let sg' = Typemod.Signature_names.simplify newenv sn sg in
- ignore (Includemod.signatures ~mark:Mark_positive oldenv sg sg');
- Typecore.force_delayed_checks ();
- let lam = Translmod.transl_toplevel_definition str in
- Warnings.check_fatal ();
- begin try
- toplevel_env := newenv;
- let res = load_lambda ppf lam in
- let out_phr =
- match res with
- | Result v ->
- if print_outcome then
- Printtyp.wrap_printing_env ~error:false oldenv (fun () ->
- match str.str_items with
- | [ { str_desc =
- (Tstr_eval (exp, _)
- |Tstr_value
- (Asttypes.Nonrecursive,
- [{vb_pat = {pat_desc=Tpat_any};
- vb_expr = exp}
- ]
- )
- )
- }
- ] ->
- let outv = outval_of_value newenv v exp.exp_type in
- let ty = Printtyp.tree_of_type_scheme exp.exp_type in
- Ophr_eval (outv, ty)
-
- | [] -> Ophr_signature []
- | _ -> Ophr_signature (pr_item oldenv sg'))
- else Ophr_signature []
- | Exception exn ->
- toplevel_env := oldenv;
- if exn = Out_of_memory then Gc.full_major();
- let outv =
- outval_of_value !toplevel_env (Obj.repr exn) Predef.type_exn
- in
- Ophr_exception (exn, outv)
- in
- !print_out_phrase ppf out_phr;
- if Printexc.backtrace_status ()
- then begin
- match !backtrace with
- | None -> ()
- | Some b ->
- pp_print_string ppf b;
- pp_print_flush ppf ();
- backtrace := None;
- end;
- begin match out_phr with
- | Ophr_eval (_, _) | Ophr_signature _ -> true
- | Ophr_exception _ -> false
- end
- with x ->
- toplevel_env := oldenv; raise x
- end
- | Ptop_dir {pdir_name = {Location.txt = dir_name}; pdir_arg } ->
- let d =
- try Some (Hashtbl.find directive_table dir_name)
- with Not_found -> None
- in
- begin match d with
- | None ->
- fprintf ppf "Unknown directive `%s'." dir_name;
- let directives =
- Hashtbl.fold (fun dir _ acc -> dir::acc) directive_table [] in
- Misc.did_you_mean ppf
- (fun () -> Misc.spellcheck directives dir_name);
- fprintf ppf "@.";
- false
- | Some d ->
- match d, pdir_arg with
- | Directive_none f, None -> f (); true
- | Directive_string f, Some {pdira_desc = Pdir_string s} -> f s; true
- | Directive_int f, Some {pdira_desc = Pdir_int (n,None) } ->
- begin match Int_literal_converter.int n with
- | n -> f n; true
- | exception _ ->
- fprintf ppf "Integer literal exceeds the range of \
- representable integers for directive `%s'.@."
- dir_name;
- false
- end
- | Directive_int _, Some {pdira_desc = Pdir_int (_, Some _)} ->
- fprintf ppf "Wrong integer literal for directive `%s'.@."
- dir_name;
- false
- | Directive_ident f, Some {pdira_desc = Pdir_ident lid} -> f lid; true
- | Directive_bool f, Some {pdira_desc = Pdir_bool b} -> f b; true
- | _ ->
- fprintf ppf "Wrong type of argument for directive `%s'.@."
- dir_name;
- false
- end
-
-let execute_phrase print_outcome ppf phr =
- try execute_phrase print_outcome ppf phr
- with exn ->
- Warnings.reset_fatal ();
- raise exn
+include Topcommon
+include Topeval
(* Read and execute commands from a file, or from stdin if [name] is "". *)
let use_print_results = ref true
-let preprocess_phrase ppf phr =
- let phr =
- match phr with
- | Ptop_def str ->
- let str =
- Pparse.apply_rewriters_str ~restore:true ~tool_name:"ocaml" str
- in
- Ptop_def str
- | phr -> phr
- in
- if !Clflags.dump_parsetree then Printast.top_phrase ppf phr;
- if !Clflags.dump_source then Pprintast.top_phrase ppf phr;
- phr
-
let use_channel ppf ~wrap_in_module ic name filename =
let lb = Lexing.from_channel ic in
Warnings.reset_fatal ();
Location.init lb filename;
(* Skip initial #! line if any *)
Lexer.skip_hash_bang lb;
- protect_refs [ R (Location.input_name, filename);
- R (Location.input_lexbuf, Some lb); ]
+ Misc.protect_refs
+ [ R (Location.input_name, filename);
+ R (Location.input_lexbuf, Some lb); ]
(fun () ->
try
List.iter
use_file ppf ~wrap_in_module:false name
let use_silently ppf name =
- protect_refs [ R (use_print_results, false) ] (fun () -> use_file ppf name)
-
-(* Reading function for interactive use *)
+ Misc.protect_refs
+ [ R (use_print_results, false) ]
+ (fun () -> use_file ppf name)
-let first_line = ref true
-let got_eof = ref false;;
+let load_file = load_file false
-let read_input_default prompt buffer len =
- output_string stdout prompt; flush stdout;
- let i = ref 0 in
- try
- while true do
- if !i >= len then raise Exit;
- let c = input_char stdin in
- Bytes.set buffer !i c;
- (* Also populate the phrase buffer as new characters are added. *)
- Buffer.add_char phrase_buffer c;
- incr i;
- if c = '\n' then raise Exit;
- done;
- (!i, false)
- with
- | End_of_file ->
- (!i, true)
- | Exit ->
- (!i, false)
-
-let read_interactive_input = ref read_input_default
+(* Execute a script. If [name] is "", read the script from stdin. *)
-let refill_lexbuf buffer len =
- if !got_eof then (got_eof := false; 0) else begin
- let prompt =
- if !Clflags.noprompt then ""
- else if !first_line then "# "
- else if !Clflags.nopromptcont then ""
- else if Lexer.in_comment () then "* "
- else " "
- in
- first_line := false;
- let (len, eof) = !read_interactive_input prompt buffer len in
- if eof then begin
- Location.echo_eof ();
- if len > 0 then got_eof := true;
- len
- end else
- len
- end
+let run_script ppf name args =
+ override_sys_argv args;
+ Compmisc.init_path ~dir:(Filename.dirname name) ();
+ (* Note: would use [Filename.abspath] here, if we had it. *)
+ begin
+ try toplevel_env := Compmisc.initial_env()
+ with Env.Error _ | Typetexp.Error _ as exn ->
+ Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
+ end;
+ Sys.interactive := false;
+ run_hooks After_setup;
+ let explicit_name =
+ (* Prevent use_silently from searching in the path. *)
+ if name <> "" && Filename.is_implicit name
+ then Filename.concat Filename.current_dir_name name
+ else name
+ in
+ use_silently ppf explicit_name
(* Toplevel initialization. Performed here instead of at the
beginning of loop() so that user code linked in with ocamlmktop
can call directives from Topdirs. *)
-
let _ =
if !Sys.interactive then (* PR#6108 *)
invalid_arg "The ocamltoplevel.cma library from compiler-libs \
cannot be loaded inside the OCaml toplevel";
Sys.interactive := true;
- let crc_intfs = Symtable.init_toplevel() in
- Compmisc.init_path ();
- Env.import_crcs ~source:Sys.executable_name crc_intfs;
- ()
+ Topeval.init ()
let find_ocamlinit () =
let ocamlinit = ".ocamlinit" in
match find_ocamlinit () with
| None -> ()
| Some file -> ignore (use_silently ppf file)
-;;
-
-let set_paths () =
- (* Add whatever -I options have been specified on the command line,
- but keep the directories that user code linked in with ocamlmktop
- may have added to load_path. *)
- let expand = Misc.expand_directory Config.standard_library in
- let current_load_path = Load_path.get_paths () in
- let load_path = List.concat [
- [ "" ];
- List.map expand (List.rev !Compenv.first_include_dirs);
- List.map expand (List.rev !Clflags.include_dirs);
- List.map expand (List.rev !Compenv.last_include_dirs);
- current_load_path;
- [expand "+camlp4"];
- ]
- in
- Load_path.init load_path;
- Dll.add_path load_path
-
-let initialize_toplevel_env () =
- toplevel_env := Compmisc.initial_env()
(* The interactive loop *)
Clflags.debug := true;
Location.formatter_for_warnings := ppf;
if not !Clflags.noversion then
- fprintf ppf " OCaml version %s@.@." Config.version;
+ fprintf ppf " OCaml version %s%s%s@.@."
+ Config.version
+ (if Topeval.implementation_label = "" then "" else " - ")
+ Topeval.implementation_label;
begin
try initialize_toplevel_env ()
with Env.Error _ | Typetexp.Error _ as exn ->
| PPerror -> ()
| x -> Location.report_exception ppf x; Btype.backtrack snap
done
-
-external caml_sys_modify_argv : string array -> unit =
- "caml_sys_modify_argv"
-
-let override_sys_argv new_argv =
- caml_sys_modify_argv new_argv;
- Arg.current := 0
-
-(* Execute a script. If [name] is "", read the script from stdin. *)
-
-let run_script ppf name args =
- override_sys_argv args;
- Compmisc.init_path ~dir:(Filename.dirname name) ();
- (* Note: would use [Filename.abspath] here, if we had it. *)
- begin
- try toplevel_env := Compmisc.initial_env()
- with Env.Error _ | Typetexp.Error _ as exn ->
- Location.report_exception ppf exn; raise (Compenv.Exit_with_status 2)
- end;
- Sys.interactive := false;
- run_hooks After_setup;
- let explicit_name =
- (* Prevent use_silently from searching in the path. *)
- if name <> "" && Filename.is_implicit name
- then Filename.concat Filename.current_dir_name name
- else name
- in
- use_silently ppf explicit_name
@since 4.03 *)
-val directive_table : (string, directive_fun) Hashtbl.t
- (* Deprecated: please use [add_directive] instead of inserting
+val get_directive : string -> directive_fun option
+
+val get_directive_info : string -> directive_info option
+
+val all_directive_names : unit -> string list
+
+val[@deprecated] directive_table : (string, directive_fun) Hashtbl.t
+ (* @deprecated please use [add_directive] instead of inserting
in this table directly. *)
-val directive_info_table : (string, directive_info) Hashtbl.t
+val[@deprecated] directive_info_table : (string, directive_info) Hashtbl.t
+ (* @deprecated please use [add_directive] instead of inserting
+ in this table directly. *)
val toplevel_env : Env.t ref
(* Typing environment for the toplevel *)
(* Return the toplevel object referred to by the given path *)
val record_backtrace : unit -> unit
+val load_file: formatter -> string -> bool
+
(* Printing of values *)
val print_value: Env.t -> Obj.t -> formatter -> Types.type_expr -> unit
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-let usage = "Usage: ocaml <options> <object-files> [script-file [arguments]]\n\
- options are:"
-
-let preload_objects = ref []
-
-(* Position of the first non expanded argument *)
-let first_nonexpanded_pos = ref 0
-
-let current = ref (!Arg.current)
-
-let argv = ref Sys.argv
-
-(* Test whether the option is part of a responsefile *)
-let is_expanded pos = pos < !first_nonexpanded_pos
-
-let expand_position pos len =
- if pos < !first_nonexpanded_pos then
- (* Shift the position *)
- first_nonexpanded_pos := !first_nonexpanded_pos + len
- else
- (* New last position *)
- first_nonexpanded_pos := pos + len + 2
-
-let prepare ppf =
- Toploop.set_paths ();
- try
- let res =
- let objects =
- List.rev (!preload_objects @ !Compenv.first_objfiles)
- in
- List.for_all (Topdirs.load_file ppf) objects
- in
- Toploop.run_hooks Toploop.Startup;
- res
- with x ->
- try Location.report_exception ppf x; false
- with x ->
- Format.fprintf ppf "Uncaught exception: %s\n" (Printexc.to_string x);
- false
-
-(* If [name] is "", then the "file" is stdin treated as a script file. *)
-let file_argument name =
- let ppf = Format.err_formatter in
- if Filename.check_suffix name ".cmo" || Filename.check_suffix name ".cma"
- then preload_objects := name :: !preload_objects
- else if is_expanded !current then begin
- (* Script files are not allowed in expand options because otherwise the
- check in override arguments may fail since the new argv can be larger
- than the original argv.
- *)
- Printf.eprintf "For implementation reasons, the toplevel does not support\
- \ having script files (here %S) inside expanded arguments passed through the\
- \ -args{,0} command-line option.\n" name;
- raise (Compenv.Exit_with_status 2)
- end else begin
- let newargs = Array.sub !argv !current
- (Array.length !argv - !current)
- in
- Compenv.readenv ppf Before_link;
- Compmisc.read_clflags_from_env ();
- if prepare ppf && Toploop.run_script ppf name newargs
- then raise (Compenv.Exit_with_status 0)
- else raise (Compenv.Exit_with_status 2)
- end
-
-
-let wrap_expand f s =
- let start = !current in
- let arr = f s in
- expand_position start (Array.length arr);
- arr
-
-module Options = Main_args.Make_bytetop_options (struct
- include Main_args.Default.Topmain
- let _stdin () = file_argument ""
- let _args = wrap_expand Arg.read_arg
- let _args0 = wrap_expand Arg.read_arg0
- let anonymous s = file_argument s
-end);;
-
-let () =
- let extra_paths =
- match Sys.getenv "OCAMLTOP_INCLUDE_PATH" with
- | exception Not_found -> []
- | s -> Misc.split_path_contents s
- in
- Clflags.include_dirs := List.rev_append extra_paths !Clflags.include_dirs
-
-let main () =
- let ppf = Format.err_formatter in
- Compenv.readenv ppf Before_args;
- let list = ref Options.list in
- begin
- try
- Arg.parse_and_expand_argv_dynamic current argv list file_argument usage;
- with
- | Arg.Bad msg -> Printf.eprintf "%s" msg; raise (Compenv.Exit_with_status 2)
- | Arg.Help msg -> Printf.printf "%s" msg; raise (Compenv.Exit_with_status 0)
- end;
- Compenv.readenv ppf Before_link;
- Compmisc.read_clflags_from_env ();
- if not (prepare ppf) then raise (Compenv.Exit_with_status 2);
- Compmisc.init_path ();
- Toploop.loop Format.std_formatter
-
-let main () =
- match main () with
- | exception Compenv.Exit_with_status n -> n
- | () -> 0
+++ /dev/null
-(**************************************************************************)
-(* *)
-(* OCaml *)
-(* *)
-(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
-(* *)
-(* Copyright 1996 Institut National de Recherche en Informatique et *)
-(* en Automatique. *)
-(* *)
-(* All rights reserved. This file is distributed under the terms of *)
-(* the GNU Lesser General Public License version 2.1, with the *)
-(* special exception on linking described in the file LICENSE. *)
-(* *)
-(**************************************************************************)
-
-(* The "trace" facility *)
-
-open Format
-open Misc
-open Longident
-open Types
-open Toploop
-
-type codeptr = Obj.raw_data
-
-type traced_function =
- { path: Path.t; (* Name under which it is traced *)
- closure: Obj.t; (* Its function closure (patched) *)
- actual_code: codeptr; (* Its original code pointer *)
- instrumented_fun: codeptr -> Obj.t -> Obj.t -> Obj.t }
- (* Printing function *)
-
-let traced_functions = ref ([] : traced_function list)
-
-(* Check if a function is already traced *)
-
-let is_traced clos =
- let rec is_traced = function
- [] -> None
- | tf :: rem -> if tf.closure == clos then Some tf.path else is_traced rem
- in is_traced !traced_functions
-
-(* Get or overwrite the code pointer of a closure *)
-
-let get_code_pointer cls =
- assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
- Obj.raw_field cls 0
-
-let set_code_pointer cls ptr =
- assert (let t = Obj.tag cls in t = Obj.closure_tag || t = Obj.infix_tag);
- Obj.set_raw_field cls 0 ptr
-
-(* Call a traced function (use old code pointer, but new closure as
- environment so that recursive calls are also traced).
- It is necessary to wrap Meta.invoke_traced_function in an ML function
- so that the RETURN at the end of the ML wrapper takes us to the
- code of the function. *)
-
-let invoke_traced_function codeptr env arg =
- Meta.invoke_traced_function codeptr env arg
-
-let print_label ppf l =
- if l <> Asttypes.Nolabel then fprintf ppf "%s:" (Printtyp.string_of_label l)
-
-(* If a function returns a functional value, wrap it into a trace code *)
-
-let rec instrument_result env name ppf clos_typ =
- match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
- | Tarrow(l, t1, t2, _) ->
- let starred_name =
- match name with
- | Lident s -> Lident(s ^ "*")
- | Ldot(lid, s) -> Ldot(lid, s ^ "*")
- | Lapply _ -> fatal_error "Trace.instrument_result" in
- let trace_res = instrument_result env starred_name ppf t2 in
- (fun clos_val ->
- Obj.repr (fun arg ->
- if not !may_trace then
- (Obj.magic clos_val : Obj.t -> Obj.t) arg
- else begin
- may_trace := false;
- try
- fprintf ppf "@[<2>%a <--@ %a%a@]@."
- Printtyp.longident starred_name
- print_label l
- (print_value !toplevel_env arg) t1;
- may_trace := true;
- let res = (Obj.magic clos_val : Obj.t -> Obj.t) arg in
- may_trace := false;
- fprintf ppf "@[<2>%a -->@ %a@]@."
- Printtyp.longident starred_name
- (print_value !toplevel_env res) t2;
- may_trace := true;
- trace_res res
- with exn ->
- may_trace := false;
- fprintf ppf "@[<2>%a raises@ %a@]@."
- Printtyp.longident starred_name
- (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
- may_trace := true;
- raise exn
- end))
- | _ -> (fun v -> v)
-
-(* Same as instrument_result, but for a toplevel closure (modified in place) *)
-
-exception Dummy
-let _ = Dummy
-
-let instrument_closure env name ppf clos_typ =
- match (Ctype.repr(Ctype.expand_head env clos_typ)).desc with
- | Tarrow(l, t1, t2, _) ->
- let trace_res = instrument_result env name ppf t2 in
- (fun actual_code closure arg ->
- if not !may_trace then begin
- try invoke_traced_function actual_code closure arg
- with Dummy -> assert false
- (* do not remove handler, prevents tail-call to invoke_traced_ *)
- end else begin
- may_trace := false;
- try
- fprintf ppf "@[<2>%a <--@ %a%a@]@."
- Printtyp.longident name
- print_label l
- (print_value !toplevel_env arg) t1;
- may_trace := true;
- let res = invoke_traced_function actual_code closure arg in
- may_trace := false;
- fprintf ppf "@[<2>%a -->@ %a@]@."
- Printtyp.longident name
- (print_value !toplevel_env res) t2;
- may_trace := true;
- trace_res res
- with exn ->
- may_trace := false;
- fprintf ppf "@[<2>%a raises@ %a@]@."
- Printtyp.longident name
- (print_value !toplevel_env (Obj.repr exn)) Predef.type_exn;
- may_trace := true;
- raise exn
- end)
- | _ -> assert false
-
-(* Given the address of a closure, find its tracing info *)
-
-let rec find_traced_closure clos = function
- | [] -> fatal_error "Trace.find_traced_closure"
- | f :: rem -> if f.closure == clos then f else find_traced_closure clos rem
-
-(* Trace the application of an (instrumented) closure to an argument *)
-
-let print_trace clos arg =
- let f = find_traced_closure clos !traced_functions in
- f.instrumented_fun f.actual_code clos arg
(* The "trace" facility *)
+(* /!\ Not available in native code /!\
+ functions will raise [Invalid_argument] if called in a native toplevel *)
+
open Format
type codeptr
let new_id = s_ref (-1)
let newty2 level desc =
- incr new_id; { desc; level; scope = lowest_level; id = !new_id }
+ incr new_id;
+ Private_type_expr.create desc ~level ~scope:lowest_level ~id:!new_id
let newgenty desc = newty2 generic_level desc
let newgenvar ?name () = newgenty (Tvar name)
(*
| Ckind of field_kind option ref * field_kind option
| Ccommu of commutable ref * commutable
| Cuniv of type_expr option ref * type_expr option
- | Ctypeset of TypeSet.t ref * TypeSet.t
type changes =
Change of change * changes ref
| Unchanged
| Invalid
-let trail = s_table Weak.create 1
+let trail = s_table ref Unchanged
let log_change ch =
- match Weak.get !trail 0 with None -> ()
- | Some r ->
- let r' = ref Unchanged in
- r := Change (ch, r');
- Weak.set !trail 0 (Some r')
+ let r' = ref Unchanged in
+ !trail := Change (ch, r');
+ trail := r'
(**** Representative of a type ****)
Fvar {contents = Some kind} -> field_kind_repr kind
| kind -> kind
-let rec repr_link compress t d =
+let rec repr_link compress (t : type_expr) d : type_expr -> type_expr =
function
{desc = Tlink t' as d'} ->
repr_link true t d' t'
repr_link true t d' t'
| t' ->
if compress then begin
- log_change (Ccompress (t, t.desc, d)); t.desc <- d
+ log_change (Ccompress (t, t.desc, d)); Private_type_expr.set_desc t d
end;
t'
-let repr t =
+let repr (t : type_expr) =
match t.desc with
Tlink t' as d ->
repr_link false t d t'
| Tconstr (Path.Pdot (_, s), _, _) -> is_row_name s
| _ -> false
+(* TODO: where should this really be *)
+(* Set row_name in Env, cf. GPR#1204/1329 *)
+let set_row_name decl path =
+ match decl.type_manifest with
+ None -> ()
+ | Some ty ->
+ let ty = repr ty in
+ match ty.desc with
+ Tvariant row when static_row row ->
+ let row = {(row_repr row) with
+ row_name = Some (path, decl.type_params)} in
+ Private_type_expr.set_desc ty (Tvariant row)
+ | _ -> ()
+
(**********************************)
(* Utilities for type traversal *)
let iter_row f row =
fold_row (fun () v -> f v) () row
-let fold_type_expr f init ty =
+let rec fold_type_expr f init ty =
match ty.desc with
Tvar _ -> init
| Tarrow (_, ty1, ty2, _) ->
let result = f init ty1 in
f result ty2
| Tnil -> init
- | Tlink ty -> f init ty
- | Tsubst ty -> f init ty
+ | Tlink ty -> fold_type_expr f init ty
+ | Tsubst _ -> assert false
| Tunivar _ -> init
| Tpoly (ty, tyl) ->
let result = f init ty in
List.fold_left f result tyl
- | Tpackage (_, _, l) -> List.fold_left f init l
+ | Tpackage (_, fl) ->
+ List.fold_left (fun result (_n, ty) -> f result ty) init fl
let iter_type_expr f ty =
fold_type_expr (fun () v -> f v) () ty
it_functor_param: type_iterators -> functor_parameter -> unit;
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
- it_type_kind: type_iterators -> type_kind -> unit;
+ it_type_kind: type_iterators -> type_decl_kind -> unit;
it_do_type_expr: type_iterators -> type_expr -> unit;
it_type_expr: type_iterators -> type_expr -> unit;
it_path: Path.t -> unit; }
let iter_type_expr_kind f = function
| Type_abstract -> ()
- | Type_variant cstrs ->
+ | Type_variant (cstrs, _) ->
List.iter
(fun cd ->
iter_type_expr_cstr_args f cd.cd_args;
match ty.desc with
Tconstr (p, _, _)
| Tobject (_, {contents=Some (p, _)})
- | Tpackage (p, _, _) ->
+ | Tpackage (p, _) ->
it.it_path p
| Tvariant row ->
Option.iter (fun (p,_) -> it.it_path p) (row_repr row).row_name
let copy_commu c =
if commu_repr c = Cok then Cok else Clink (ref Cunknown)
-(* Since univars may be used as row variables, we need to do some
- encoding during substitution *)
-let rec norm_univar ty =
- match ty.desc with
- Tunivar _ | Tsubst _ -> ty
- | Tlink ty -> norm_univar ty
- | Ttuple (ty :: _) -> norm_univar ty
- | _ -> assert false
-
let rec copy_type_desc ?(keep_names=false) f = function
Tvar _ as ty -> if keep_names then ty else Tvar None
| Tarrow (p, ty1, ty2, c)-> Tarrow (p, f ty1, f ty2, copy_commu c)
| Tsubst _ -> assert false
| Tunivar _ as ty -> ty (* always keep the name *)
| Tpoly (ty, tyl) ->
- let tyl = List.map (fun x -> norm_univar (f x)) tyl in
+ let tyl = List.map f tyl in
Tpoly (f ty, tyl)
- | Tpackage (p, n, l) -> Tpackage (p, n, List.map f l)
+ | Tpackage (p, fl) -> Tpackage (p, List.map (fun (n, ty) -> (n, f ty)) fl)
(* Utilities for copying *)
(* Restore type descriptions. *)
let cleanup { saved_desc; saved_kinds; _ } =
- List.iter (fun (ty, desc) -> ty.desc <- desc) saved_desc;
+ List.iter (fun (ty, desc) -> Private_type_expr.set_desc ty desc) saved_desc;
List.iter (fun r -> r := None) saved_kinds
let with_scope f =
res
end
-(* Mark a type. *)
-let rec mark_type ty =
- let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
- iter_type_expr mark_type ty
- end
-
-let mark_type_node ty =
- let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
- end
-
-let mark_type_params ty =
- iter_type_expr mark_type ty
-
-let type_iterators =
- let it_type_expr it ty =
- let ty = repr ty in
- if ty.level >= lowest_level then begin
- mark_type_node ty;
- it.it_do_type_expr it ty;
- end
- in
- {type_iterators with it_type_expr}
-
-
-(* Remove marks from a type. *)
-let rec unmark_type ty =
- let ty = repr ty in
- if ty.level < lowest_level then begin
- ty.level <- pivot_level - ty.level;
- iter_type_expr unmark_type ty
- end
-
-let unmark_iterators =
- let it_type_expr _it ty = unmark_type ty in
- {type_iterators with it_type_expr}
-
-let unmark_type_decl decl =
- unmark_iterators.it_type_declaration unmark_iterators decl
-
-let unmark_extension_constructor ext =
- List.iter unmark_type ext.ext_type_params;
- iter_type_expr_cstr_args unmark_type ext.ext_args;
- Option.iter unmark_type ext.ext_ret_type
-
-let unmark_class_signature sign =
- unmark_type sign.csig_self;
- Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars
-
-let unmark_class_type cty =
- unmark_iterators.it_class_type unmark_iterators cty
-
(*******************************************)
(* Memorization of abbreviation expansion *)
(**********************************)
let undo_change = function
- Ctype (ty, desc) -> ty.desc <- desc
- | Ccompress (ty, desc, _) -> ty.desc <- desc
- | Clevel (ty, level) -> ty.level <- level
- | Cscope (ty, scope) -> ty.scope <- scope
+ Ctype (ty, desc) -> Private_type_expr.set_desc ty desc
+ | Ccompress (ty, desc, _) -> Private_type_expr.set_desc ty desc
+ | Clevel (ty, level) -> Private_type_expr.set_level ty level
+ | Cscope (ty, scope) -> Private_type_expr.set_scope ty scope
| Cname (r, v) -> r := v
| Crow (r, v) -> r := v
| Ckind (r, v) -> r := v
| Ccommu (r, v) -> r := v
| Cuniv (r, v) -> r := v
- | Ctypeset (r, v) -> r := v
type snapshot = changes ref * int
let last_snapshot = s_ref 0
let link_type ty ty' =
log_type ty;
let desc = ty.desc in
- ty.desc <- Tlink ty';
+ Private_type_expr.set_desc ty (Tlink ty');
(* Name is a user-supplied name for this unification variable (obtained
* through a type annotation for instance). *)
match desc, ty'.desc with
Tvar name, Tvar name' ->
begin match name, name' with
- | Some _, None -> log_type ty'; ty'.desc <- Tvar name
- | None, Some _ -> ()
+ | Some _, None -> log_type ty'; Private_type_expr.set_desc ty' (Tvar name)
+ | None, Some _ -> ()
| Some _, Some _ ->
- if ty.level < ty'.level then (log_type ty'; ty'.desc <- Tvar name)
- | None, None -> ()
+ if ty.level < ty'.level then
+ (log_type ty'; Private_type_expr.set_desc ty' (Tvar name))
+ | None, None -> ()
end
| _ -> ()
(* ; assert (check_memorized_abbrevs ()) *)
(* ; check_expans [] ty' *)
+(* TODO: consider eliminating set_type_desc, replacing it with link types *)
let set_type_desc ty td =
if td != ty.desc then begin
log_type ty;
- ty.desc <- td
+ Private_type_expr.set_desc ty td
end
-let set_level ty level =
+(* TODO: separate set_level into two specific functions: *)
+(* set_lower_level and set_generic_level *)
+ let set_level ty level =
if level <> ty.level then begin
if ty.id <= !last_snapshot then log_change (Clevel (ty, ty.level));
- ty.level <- level
+ Private_type_expr.set_level ty level
end
+(* TODO: introduce a guard and rename it to set_higher_scope? *)
let set_scope ty scope =
if scope <> ty.scope then begin
if ty.id <= !last_snapshot then log_change (Cscope (ty, ty.scope));
- ty.scope <- scope
+ Private_type_expr.set_scope ty scope
end
let set_univar rty ty =
log_change (Cuniv (rty, !rty)); rty := Some ty
log_change (Ckind (rk, !rk)); rk := Some k
let set_commu rc c =
log_change (Ccommu (rc, !rc)); rc := c
-let set_typeset rs s =
- log_change (Ctypeset (rs, !rs)); rs := s
let snapshot () =
let old = !last_snapshot in
last_snapshot := !new_id;
- match Weak.get !trail 0 with Some r -> (r, old)
- | None ->
- let r = ref Unchanged in
- Weak.set !trail 0 (Some r);
- (r, old)
+ (!trail, old)
let rec rev_log accu = function
Unchanged -> accu
List.iter undo_change backlog;
changes := Unchanged;
last_snapshot := old;
- Weak.set !trail 0 (Some changes)
+ trail := changes
let rec rev_compress_log log r =
match !r with
List.iter
(fun r -> match !r with
Change (Ccompress (ty, desc, d), next) when ty.desc == d ->
- ty.desc <- desc; r := !next
+ Private_type_expr.set_desc ty desc; r := !next
| _ -> ())
log
+
+(* Mark a type. *)
+
+let not_marked_node ty = ty.level >= lowest_level
+ (* type nodes with negative levels are "marked" *)
+
+let flip_mark_node ty = Private_type_expr.set_level ty (pivot_level - ty.level)
+let logged_mark_node ty = set_level ty (pivot_level - ty.level)
+
+let try_mark_node ty = not_marked_node ty && (flip_mark_node ty; true)
+let try_logged_mark_node ty = not_marked_node ty && (logged_mark_node ty; true)
+
+let rec mark_type ty =
+ let ty = repr ty in
+ if not_marked_node ty then begin
+ flip_mark_node ty;
+ iter_type_expr mark_type ty
+ end
+
+let mark_type_params ty =
+ iter_type_expr mark_type ty
+
+let type_iterators =
+ let it_type_expr it ty =
+ let ty = repr ty in
+ if try_mark_node ty then it.it_do_type_expr it ty
+ in
+ {type_iterators with it_type_expr}
+
+
+(* Remove marks from a type. *)
+let rec unmark_type ty =
+ let ty = repr ty in
+ if ty.level < lowest_level then begin
+ (* flip back the marked level *)
+ flip_mark_node ty;
+ iter_type_expr unmark_type ty
+ end
+
+let unmark_iterators =
+ let it_type_expr _it ty = unmark_type ty in
+ {type_iterators with it_type_expr}
+
+let unmark_type_decl decl =
+ unmark_iterators.it_type_declaration unmark_iterators decl
+
+let unmark_extension_constructor ext =
+ List.iter unmark_type ext.ext_type_params;
+ iter_type_expr_cstr_args unmark_type ext.ext_args;
+ Option.iter unmark_type ext.ext_ret_type
+
+let unmark_class_signature sign =
+ unmark_type sign.csig_self;
+ Vars.iter (fun _l (_m, _v, t) -> unmark_type t) sign.csig_vars
+
+let unmark_class_type cty =
+ unmark_iterators.it_class_type unmark_iterators cty
val is_row_name: string -> bool
val is_constr_row: allow_ident:bool -> type_expr -> bool
+(* Set the polymorphic variant row_name field *)
+val set_row_name : type_declaration -> Path.t -> unit
+
(**** Utilities for type traversal ****)
val iter_type_expr: (type_expr -> unit) -> type_expr -> unit
it_functor_param: type_iterators -> functor_parameter -> unit;
it_module_type: type_iterators -> module_type -> unit;
it_class_type: type_iterators -> class_type -> unit;
- it_type_kind: type_iterators -> type_kind -> unit;
+ it_type_kind: type_iterators -> type_decl_kind -> unit;
it_do_type_expr: type_iterators -> type_expr -> unit;
it_type_expr: type_iterators -> type_expr -> unit;
it_path: Path.t -> unit; }
val type_iterators: type_iterators
(* Iteration on arbitrary type information.
- [it_type_expr] calls [mark_type_node] to avoid loops. *)
+ [it_type_expr] calls [mark_node] to avoid loops. *)
val unmark_iterators: type_iterators
(* Unmark any structure containing types. See [unmark_type] below. *)
val lowest_level: int
(* Marked type: ty.level < lowest_level *)
-val pivot_level: int
- (* Type marking: ty.level <- pivot_level - ty.level *)
+
+val not_marked_node: type_expr -> bool
+ (* Return true if a type node is not yet marked *)
+
+val logged_mark_node: type_expr -> unit
+ (* Mark a type node, logging the marking so it can be backtracked.
+ No [repr]'ing *)
+val try_logged_mark_node: type_expr -> bool
+ (* Mark a type node if it is not yet marked, logging the marking so it
+ can be backtracked.
+ Return false if it was already marked *)
+
+val flip_mark_node: type_expr -> unit
+ (* Mark a type node. No [repr]'ing.
+ The marking is not logged and will have to be manually undone using
+ one of the various [unmark]'ing functions below. *)
+val try_mark_node: type_expr -> bool
+ (* Mark a type node if it is not yet marked.
+ The marking is not logged and will have to be manually undone using
+ one of the various [unmark]'ing functions below.
+
+ Return false if it was already marked *)
val mark_type: type_expr -> unit
- (* Mark a type *)
-val mark_type_node: type_expr -> unit
- (* Mark a type node (but not its sons) *)
+ (* Mark a type recursively *)
val mark_type_params: type_expr -> unit
- (* Mark the sons of a type node *)
+ (* Mark the sons of a type node recursively *)
+
val unmark_type: type_expr -> unit
val unmark_type_decl: type_declaration -> unit
val unmark_extension_constructor: extension_constructor -> unit
val set_univar: type_expr option ref -> type_expr -> unit
val set_kind: field_kind option ref -> field_kind -> unit
val set_commu: commutable ref -> commutable -> unit
-val set_typeset: TypeSet.t ref -> TypeSet.t -> unit
(* Set references, logging the old value *)
(**** Forward declarations ****)
val print_raw: (Format.formatter -> type_expr -> unit) ref
-val iter_type_expr_kind: (type_expr -> unit) -> (type_kind -> unit)
+val iter_type_expr_kind: (type_expr -> unit) -> (type_decl_kind -> unit)
val iter_type_expr_cstr_args: (type_expr -> unit) ->
(constructor_arguments -> unit)
open Asttypes
open Types
open Btype
+open Errortrace
open Local_store
(**** Errors ****)
-module Unification_trace = struct
-
- type position = First | Second
- let swap_position = function
- | First -> Second
- | Second -> First
-
- type desc = { t: type_expr; expanded: type_expr option }
- type 'a diff = { got: 'a; expected: 'a}
-
- type 'a escape =
- | Constructor of Path.t
- | Univ of type_expr
- (* The type_expr argument of [Univ] is always a [Tunivar _],
- we keep a [type_expr] to track renaming in {!Printtyp} *)
- | Self
- | Module_type of Path.t
- | Equation of 'a
-
- type fixed_row_case =
- | Cannot_be_closed
- | Cannot_add_tags of string list
-
- type variant =
- | No_intersection
- | No_tags of position * (Asttypes.label * row_field) list
- | Incompatible_types_for of string
- | Fixed_row of position * fixed_row_case * fixed_explanation
-
-
- type obj =
- | Missing_field of position * string
- | Abstract_row of position
- | Self_cannot_be_closed
-
- type 'a elt =
- | Diff of 'a diff
- | Variant of variant
- | Obj of obj
- | Escape of {context:type_expr option; kind: 'a escape}
- | Incompatible_fields of {name:string; diff:type_expr diff }
- | Rec_occur of type_expr * type_expr
-
- type t = desc elt list
- let short t = { t; expanded = None }
- let map_diff f r =
- (* ordering is often meaningful when dealing with type_expr *)
- let got = f r.got in
- let expected = f r.expected in
- { got; expected}
- let diff got expected = Diff (map_diff short {got;expected})
-
- let map_elt f = function
- | Diff x -> Diff (map_diff f x)
- | Escape {kind=Equation x; context} -> Escape {kind=Equation(f x); context}
- | Rec_occur (_,_)
- | Escape {kind=(Univ _ | Self|Constructor _ | Module_type _ ); _}
- | Variant _ | Obj _
- | Incompatible_fields _ as x -> x
- let map f = List.map (map_elt f)
-
-
- (* Convert desc to type_expr * type_expr *)
- let flatten_desc f x = match x.expanded with
- | None -> f x.t x.t
- | Some expanded -> f x.t expanded
- let flatten f = map (flatten_desc f)
-
- (* Permute the expected and actual values *)
- let swap_diff x = { got = x.expected; expected = x.got }
- let swap_elt = function
- | Diff x -> Diff (swap_diff x)
- | Incompatible_fields {name;diff} ->
- Incompatible_fields { name; diff = swap_diff diff}
- | Obj (Missing_field(pos,s)) -> Obj(Missing_field(swap_position pos,s))
- | Obj (Abstract_row pos) -> Obj(Abstract_row (swap_position pos))
- | Variant (Fixed_row(pos,k,f)) -> Variant (Fixed_row(swap_position pos,k,f))
- | Variant (No_tags(pos,f)) -> Variant (No_tags(swap_position pos,f))
- | x -> x
- let swap x = List.map swap_elt x
-
- exception Unify of t
-
- let escape kind = Escape { kind; context = None}
- let scope_escape x = Unify[escape (Equation (short x))]
- let rec_occur x y = Unify[Rec_occur(x, y)]
- let incompatible_fields name got expected =
- Incompatible_fields {name; diff={got; expected} }
-
- let explain trace f =
- let rec explain = function
- | [] -> None
- | [h] -> f ~prev:None h
- | h :: (prev :: _ as rem) ->
- match f ~prev:(Some prev) h with
- | Some _ as m -> m
- | None -> explain rem in
- explain (List.rev trace)
-
-end
-module Trace = Unification_trace
-
-exception Unify = Trace.Unify
+exception Unify of unification Errortrace.t
+exception Equality of comparison Errortrace.t
+exception Moregen of comparison Errortrace.t
+exception Subtype of Errortrace.Subtype.t * unification Errortrace.t
+
+exception Escape of desc Errortrace.escape
+
+(* For local use: throw the appropriate exception. Can be passed into local
+ functions as a parameter *)
+type _ trace_exn =
+| Unify : unification trace_exn
+| Moregen : comparison trace_exn
+| Equality : comparison trace_exn
+
+let raise_trace_for
+ (type variant)
+ (tr_exn : variant trace_exn)
+ (tr : variant Errortrace.t) : 'a =
+ match tr_exn with
+ | Unify -> raise (Unify tr)
+ | Equality -> raise (Equality tr)
+ | Moregen -> raise (Moregen tr)
+
+(* Uses of this function are a bit suspicious, as we usually want to maintain
+ trace information; sometimes it makes sense, however, since we're maintaining
+ the trace at an outer exception handler. *)
+let raise_unexplained_for tr_exn =
+ raise_trace_for tr_exn []
+
+let raise_for tr_exn e =
+ raise_trace_for tr_exn [e]
+
+(* Thrown from [moregen_kind] *)
+exception Public_method_to_private_method
+
+let escape kind = {kind; context = None}
+let escape_exn kind = Escape (escape kind)
+let scope_escape_exn ty = escape_exn (Equation (short ty))
+let raise_escape_exn kind = raise (escape_exn kind)
+let raise_scope_escape_exn ty = raise (scope_escape_exn ty)
exception Tags of label * label
| _ -> None
)
-exception Subtype of Unification_trace.t * Unification_trace.t
-
exception Cannot_expand
exception Cannot_apply
+exception Cannot_subst
+
+exception Cannot_unify_universal_variables
+
+exception Matches_failure of Env.t * unification Errortrace.t
+
+exception Incompatible
+
(**** Type level management ****)
let current_level = s_ref 0
*)
let rec free_vars_rec real ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
- begin match ty.desc, !really_closed with
+ if try_mark_node ty then
+ match ty.desc, !really_closed with
Tvar _, _ ->
free_variables := (ty, real) :: !free_variables
| Tconstr (path, tl, _), Some env ->
if not (static_row row) then free_vars_rec false row.row_more
| _ ->
iter_type_expr (free_vars_rec true) ty
- end;
- end
let free_vars ?env ty =
free_variables := [];
begin match decl.type_kind with
Type_abstract ->
()
- | Type_variant v ->
+ | Type_variant (v, _rep) ->
List.iter
(fun {cd_args; cd_res; _} ->
match cd_res with
(fun (lab, _, ty) -> if lab = dummy_method then mark_type ty)
fields;
try
- mark_type_node (repr sign.csig_self);
+ ignore (try_mark_node (repr sign.csig_self));
List.iter
(fun (lab, kind, ty) ->
if field_kind_repr kind = Fpresent then
let ty = repr ty in
if (ty.level > !current_level) && (ty.level <> generic_level) then begin
set_level ty generic_level;
+ (* recur into abbrev for the speed *)
begin match ty.desc with
Tconstr (_, _, abbrev) ->
iter_abbrev generalize !abbrev
(* Generalize the structure and lower the variables *)
-let rec generalize_structure var_level ty =
+let rec generalize_structure ty =
let ty = repr ty in
if ty.level <> generic_level then begin
- if is_Tvar ty && ty.level > var_level then
- set_level ty var_level
+ if is_Tvar ty && ty.level > !current_level then
+ set_level ty !current_level
else if
ty.level > !current_level &&
match ty.desc with
| _ -> true
then begin
set_level ty generic_level;
- iter_type_expr (generalize_structure var_level) ty
+ iter_type_expr generalize_structure ty
end
end
let generalize_structure ty =
simple_abbrevs := Mnil;
- generalize_structure !current_level ty
+ generalize_structure ty
(* Generalize the spine of a function, if the level >= !current_level *)
| Tpoly (ty', _) ->
set_level ty generic_level;
generalize_spine ty'
- | Ttuple tyl
- | Tpackage (_, _, tyl) ->
+ | Ttuple tyl ->
set_level ty generic_level;
List.iter generalize_spine tyl
+ | Tpackage (_, fl) ->
+ set_level ty generic_level;
+ List.iter (fun (_n, ty) -> generalize_spine ty) fl
| Tconstr (p, tyl, memo) when not (is_object_type p) ->
set_level ty generic_level;
memo := Mnil;
List.iter generalize_spine tyl
| _ -> ()
-let forward_try_expand_once = (* Forward declaration *)
- ref (fun _env _ty -> raise Cannot_expand)
+let forward_try_expand_safe = (* Forward declaration *)
+ ref (fun _env _ty -> assert false)
(*
Lower the levels of a type (assume [level] is not
| _ -> p
let rec check_scope_escape env level ty =
- let mark ty =
- (* Mark visited types with [ty.level < lowest_level]. *)
- set_level ty (pivot_level - ty.level)
- in
let ty = repr ty in
- (* If the type hasn't been marked, check it. Otherwise, we have already
- checked it.
- *)
- if ty.level >= lowest_level then begin
+ let orig_level = ty.level in
+ if try_logged_mark_node ty then begin
if level < ty.scope then
- raise(Trace.scope_escape ty);
+ raise_scope_escape_exn ty;
begin match ty.desc with
| Tconstr (p, _, _) when level < Path.scope p ->
- begin match !forward_try_expand_once env ty with
+ begin match !forward_try_expand_safe env ty with
| ty' ->
- mark ty;
check_scope_escape env level ty'
| exception Cannot_expand ->
- raise Trace.(Unify [escape (Constructor p)])
+ raise_escape_exn (Constructor p)
end
- | Tpackage (p, nl, tl) when level < Path.scope p ->
+ | Tpackage (p, fl) when level < Path.scope p ->
let p' = normalize_package_path env p in
- if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
- let orig_level = ty.level in
- mark ty;
+ if Path.same p p' then raise_escape_exn (Module_type p);
check_scope_escape env level
- (Btype.newty2 orig_level (Tpackage (p', nl, tl)))
+ (Btype.newty2 orig_level (Tpackage (p', fl)))
| _ ->
- mark ty;
iter_type_expr (check_scope_escape env level) ty
end;
end
let check_scope_escape env level ty =
let snap = snapshot () in
try check_scope_escape env level ty; backtrack snap
- with Unify [Trace.Escape x] ->
+ with Escape e ->
backtrack snap;
- raise Trace.(Unify[Escape { x with context = Some ty }])
+ raise (Escape { e with context = Some ty })
-let update_scope scope ty =
+let rec update_scope scope ty =
let ty = repr ty in
- let scope = max scope ty.scope in
- if ty.level < scope then raise (Trace.scope_escape ty);
- set_scope ty scope
+ if ty.scope < scope then begin
+ if ty.level < scope then raise_scope_escape_exn ty;
+ set_scope ty scope;
+ (* Only recurse in principal mode as this is not necessary for soundness *)
+ if !Clflags.principal then iter_type_expr (update_scope scope) ty
+ end
+
+let update_scope_for tr_exn scope ty =
+ try
+ update_scope scope ty
+ with Escape e -> raise_for tr_exn (Escape e)
(* Note: the level of a type constructor must be greater than its binding
time. That way, a type constructor cannot escape the scope of its
let rec update_level env level expand ty =
let ty = repr ty in
if ty.level > level then begin
- if level < ty.scope then raise (Trace.scope_escape ty);
+ if level < ty.scope then raise_scope_escape_exn ty;
match ty.desc with
Tconstr(p, _tl, _abbrev) when level < Path.scope p ->
(* Try first to replace an abbreviation by its expansion. *)
begin try
- link_type ty (!forward_try_expand_once env ty);
+ link_type ty (!forward_try_expand_safe env ty);
update_level env level expand ty
with Cannot_expand ->
- raise Trace.(Unify [escape(Constructor p)])
+ raise_escape_exn (Constructor p)
end
| Tconstr(p, (_ :: _ as tl), _) ->
let variance =
in
begin try
if not needs_expand then raise Cannot_expand;
- link_type ty (!forward_try_expand_once env ty);
+ link_type ty (!forward_try_expand_safe env ty);
update_level env level expand ty
with Cannot_expand ->
set_level ty level;
iter_type_expr (update_level env level expand) ty
end
- | Tpackage (p, nl, tl) when level < Path.scope p ->
+ | Tpackage (p, fl) when level < Path.scope p ->
let p' = normalize_package_path env p in
- if Path.same p p' then raise Trace.(Unify [escape (Module_type p)]);
- set_type_desc ty (Tpackage (p', nl, tl));
+ if Path.same p p' then raise_escape_exn (Module_type p);
+ set_type_desc ty (Tpackage (p', fl));
update_level env level expand ty
| Tobject(_, ({contents=Some(p, _tl)} as nm))
when level < Path.scope p ->
iter_type_expr (update_level env level expand) ty
| Tfield(lab, _, ty1, _)
when lab = dummy_method && (repr ty1).level > level ->
- raise Trace.(Unify [escape Self])
+ raise_escape_exn Self
| _ ->
set_level ty level;
(* XXX what about abbreviations in Tconstr ? *)
let snap = snapshot () in
try
update_level env level false ty
- with Unify _ ->
+ with Escape _ ->
backtrack snap;
update_level env level true ty
end
+let update_level_for tr_exn env level ty =
+ try
+ update_level env level ty
+ with Escape e -> raise_for tr_exn (Escape e)
+
(* Lower level of type variables inside contravariant branches *)
let rec lower_contravariant env var_level visited contra ty =
else lower_rec contra t)
variance tyl in
if maybe_expand then (* we expand cautiously to avoid missing cmis *)
- match !forward_try_expand_once env ty with
+ match !forward_try_expand_safe env ty with
| ty -> lower_rec contra ty
| exception Cannot_expand -> not_expanded ()
else not_expanded ()
- | Tpackage (_, _, tyl) ->
- List.iter (lower_rec true) tyl
+ | Tpackage (_, fl) ->
+ List.iter (fun (_n, ty) -> lower_rec true ty) fl
| Tarrow (_, t1, t2, _) ->
lower_rec true t1;
lower_rec contra t2
let fully_generic ty =
- let rec aux acc ty =
- acc &&
+ let rec aux ty =
let ty = repr ty in
- ty.level < lowest_level || (
- ty.level = generic_level && (
- mark_type_node ty;
- fold_type_expr aux true ty
- )
- )
+ if not_marked_node ty then
+ if ty.level = generic_level then
+ (flip_mark_node ty; iter_type_expr aux ty)
+ else raise Exit
in
- let res = aux true ty in
+ let res = try aux ty; true with Exit -> false in
unmark_type ty;
res
let copy = copy ?partial ?keep_names scope in
let ty = repr ty in
match ty.desc with
- Tsubst ty -> ty
+ Tsubst (ty, _) -> ty
| _ ->
if ty.level <> generic_level && partial = None then ty else
(* We only forget types that are non generic and do not contain
For_copy.save_desc scope ty desc;
let t = newvar() in (* Stub *)
set_scope t ty.scope;
- ty.desc <- Tsubst t;
- t.desc <-
+ Private_type_expr.set_desc ty (Tsubst (t, None));
+ Private_type_expr.set_desc t
begin match desc with
| Tconstr (p, tl, _) ->
let abbrevs = proper_abbrevs p tl !abbreviations in
(* We must substitute in a subtle way *)
(* Tsubst takes a tuple containing the row var and the variant *)
begin match more.desc with
- Tsubst {desc = Ttuple [_;ty2]} ->
+ Tsubst (_, Some ty2) ->
(* This variant type has been already copied *)
- ty.desc <- Tsubst ty2; (* avoid Tlink in the new type *)
+ Private_type_expr.set_desc ty (Tsubst (ty2, None));
+ (* avoid Tlink in the new type *)
Tlink ty2
| _ ->
(* If the row variable is not generic, we must keep it *)
let keep = more.level <> generic_level && partial = None in
let more' =
match more.desc with
- Tsubst ty -> ty
+ Tsubst (ty, None) -> ty
+ (* TODO: is this case possible?
+ possibly an interaction with (copy more) below? *)
| Tconstr _ | Tnil ->
For_copy.save_desc scope more more.desc;
copy more
match partial with
Some (free_univars, false) ->
let more' =
- if more.id != more'.id then more' else
- let lv = if keep then more.level else !current_level in
- newty2 lv (Tvar None)
+ if more.id <> more'.id then
+ more' (* we've already made a copy *)
+ else
+ newvar ()
in
let not_reither (_, f) =
match row_field_repr f with
| _ -> (more', row)
in
(* Register new type first for recursion *)
- more.desc <- Tsubst(newgenty(Ttuple[more';t]));
+ Private_type_expr.set_desc
+ more (Tsubst (more', Some t));
(* Return a new copy *)
Tvariant (copy_row copy true row keep more')
end
if index = 0 && s <> "" && s.[String.length s - 1] <> '$' then s else
Printf.sprintf "%s%d" s index
-let new_declaration expansion_scope manifest =
+let new_local_type ?(loc = Location.none) ?manifest_and_scope () =
+ let manifest, expansion_scope =
+ match manifest_and_scope with
+ None -> None, Btype.lowest_level
+ | Some (ty, scope) -> Some ty, scope
+ in
{
type_params = [];
type_arity = 0;
type_separability = [];
type_is_newtype = true;
type_expansion_scope = expansion_scope;
- type_loc = Location.none;
+ type_loc = loc;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
}
For_copy.with_scope (fun scope ->
begin match in_pattern with
| None -> ()
- | Some (env, expansion_scope) ->
+ | Some (env, fresh_constr_scope) ->
let process existential =
- let decl = new_declaration expansion_scope None in
+ let decl = new_local_type () in
let name = existential_name cstr existential in
- let path =
- Path.Pident
- (Ident.create_scoped ~scope:expansion_scope
- (get_new_abstract_name name))
- in
- let new_env = Env.add_local_type path decl !env in
+ let (id, new_env) =
+ Env.enter_type (get_new_abstract_name name) decl !env
+ ~scope:fresh_constr_scope in
env := new_env;
- let to_unify = newty (Tconstr (path,[],ref Mnil)) in
+ let to_unify = newty (Tconstr (Path.Pident id,[],ref Mnil)) in
let tv = copy scope existential in
assert (is_Tvar tv);
link_type tv to_unify
end;
let ty_res = copy scope cstr.cstr_res in
let ty_args = List.map (copy scope) cstr.cstr_args in
- (ty_args, ty_res)
+ let ty_ex = List.map (copy scope) cstr.cstr_existentials in
+ (ty_args, ty_res, ty_ex)
)
let instance_parameterized_type ?keep_names sch_args sch =
let map_kind f = function
| Type_abstract -> Type_abstract
| Type_open -> Type_open
- | Type_variant cl ->
+ | Type_variant (cl, rep) ->
Type_variant (
List.map
(fun c ->
cd_args = map_type_expr_cstr_args f c.cd_args;
cd_res = Option.map f c.cd_res
})
- cl)
+ cl, rep)
| Type_record (fl, rr) ->
Type_record (
List.map
if ty.level <> generic_level then ty else
let t = newvar () in
delayed_copy :=
- lazy (t.desc <- Tlink (copy cleanup_scope ty))
+ lazy (Private_type_expr.set_desc t (Tlink (copy cleanup_scope ty)))
:: !delayed_copy;
t
else try
match ty.desc with
Tarrow _ | Ttuple _ | Tvariant _ | Tconstr _ | Tobject _ | Tpackage _ ->
(ty,(t,bound)) :: visited
- | Tvar _ | Tfield _ | Tnil | Tpoly _ | Tunivar _ | Tlink _ | Tsubst _ ->
+ | Tvar _ | Tfield _ | Tnil | Tpoly _ | Tunivar _ ->
visited
+ | Tlink _ | Tsubst _ ->
+ assert false
in
let copy_rec = copy_sep cleanup_scope fixed free bound visited in
- t.desc <-
+ Private_type_expr.set_desc t
begin match ty.desc with
| Tvariant row0 ->
let row = row_repr row0 in
end
let instance_poly' cleanup_scope ~keep_names fixed univars sch =
+ (* In order to compute univars below, [sch] schould not contain [Tsubst] *)
let univars = List.map repr univars in
let copy_var ty =
match ty.desc with
let instance_label fixed lbl =
For_copy.with_scope (fun scope ->
- let ty_res = copy scope lbl.lbl_res in
let vars, ty_arg =
match repr lbl.lbl_arg with
{desc = Tpoly (ty, tl)} ->
| _ ->
[], copy scope lbl.lbl_arg
in
+ (* call [copy] after [instance_poly] to avoid introducing [Tsubst] *)
+ let ty_res = copy scope lbl.lbl_res in
(vars, ty_arg, ty_res)
)
(**** Instantiation with parameter substitution ****)
let unify' = (* Forward declaration *)
- ref (fun _env _ty1 _ty2 -> raise (Unify []))
+ ref (fun _env _ty1 _ty2 -> assert false)
+
let subst env level priv abbrev ty params args body =
- if List.length params <> List.length args then raise (Unify []);
+ if List.length params <> List.length args then raise Cannot_subst;
let old_level = !current_level in
current_level := level;
- try
- let body0 = newvar () in (* Stub *)
- begin match ty with
- None -> ()
+ let body0 = newvar () in (* Stub *)
+ let undo_abbrev =
+ match ty with
+ | None -> fun () -> () (* No abbreviation added *)
| Some ({desc = Tconstr (path, tl, _)} as ty) ->
let abbrev = proper_abbrevs path tl abbrev in
- memorize_abbrev abbrev priv path ty body0
+ memorize_abbrev abbrev priv path ty body0;
+ fun () -> forget_abbrev abbrev path
| _ ->
assert false
- end;
- abbreviations := abbrev;
- let (params', body') = instance_parameterized_type params body in
- abbreviations := ref Mnil;
+ in
+ abbreviations := abbrev;
+ let (params', body') = instance_parameterized_type params body in
+ abbreviations := ref Mnil;
+ try
!unify' env body0 body';
List.iter2 (!unify' env) params' args;
current_level := old_level;
body'
- with Unify _ as exn ->
+ with Unify _ ->
current_level := old_level;
- raise exn
+ undo_abbrev ();
+ raise Cannot_subst
(*
Only the shape of the type matters, not whether it is generic or
try
subst env generic_level Public (ref Mnil) None params args body
with
- Unify _ -> raise Cannot_apply
+ Cannot_subst -> raise Cannot_apply
let () = Subst.ctype_apply_env_empty := apply Env.empty
if level <> generic_level then
begin try
update_level env level ty'
- with Unify _ ->
+ with Escape _ ->
(* XXX This should not happen.
However, levels are not correctly restored after a
typing error *)
end;
begin try
update_scope scope ty';
- with Unify _ ->
+ with Escape _ ->
(* XXX This should not happen.
However, levels are not correctly restored after a
typing error *)
| (params, body, lv) ->
(* prerr_endline
("add a "^string_of_kind kind^" expansion for "^Path.name path);*)
- let ty' = subst env level kind abbrev (Some ty) params args body in
+ let ty' =
+ try
+ subst env level kind abbrev (Some ty) params args body
+ with Cannot_subst -> raise_escape_exn Constraint
+ in
(* For gadts, remember type as non exportable *)
(* The ambiguous level registered for ty' should be the highest *)
- if !trace_gadt_instances then begin
- let scope = max lv ty.scope in
- if level < scope then raise (Trace.scope_escape ty);
- set_scope ty scope;
- set_scope ty' scope
- end;
+ (* if !trace_gadt_instances then begin *)
+ let scope = Int.max lv ty.scope in
+ update_scope scope ty;
+ update_scope scope ty';
ty'
end
| _ ->
(* Expand once the head of a type *)
let expand_head_once env ty =
- try expand_abbrev env (repr ty) with Cannot_expand -> assert false
+ try
+ expand_abbrev env (repr ty)
+ with Cannot_expand | Escape _ -> assert false
(* Check whether a type can be expanded *)
let safe_abbrev env ty =
let snap = Btype.snapshot () in
- try ignore (expand_abbrev env ty); true
- with Cannot_expand | Unify _ ->
- Btype.backtrack snap;
- false
+ try ignore (expand_abbrev env ty); true with
+ Cannot_expand ->
+ Btype.backtrack snap;
+ false
+ | Escape _ ->
+ Btype.backtrack snap;
+ cleanup_abbrev ();
+ false
(* Expand the head of a type once.
Raise Cannot_expand if the type cannot be expanded.
- May raise Unify, if a recursion was hidden in the type. *)
+ May raise Escape, if a recursion was hidden in the type. *)
let try_expand_once env ty =
let ty = repr ty in
match ty.desc with
let try_expand_safe env ty =
let snap = Btype.snapshot () in
try try_expand_once env ty
- with Unify _ ->
- Btype.backtrack snap; raise Cannot_expand
+ with Escape _ ->
+ Btype.backtrack snap; cleanup_abbrev (); raise Cannot_expand
(* Fully expand the head of a type. *)
let rec try_expand_head try_once env ty =
try try_expand_head try_once env ty'
with Cannot_expand -> ty'
-(* Unsafe full expansion, may raise Unify. *)
+(* Unsafe full expansion, may raise [Unify [Escape _]]. *)
let expand_head_unif env ty =
- try try_expand_head try_expand_once env ty with Cannot_expand -> repr ty
+ try
+ try_expand_head try_expand_once env ty
+ with
+ | Cannot_expand -> repr ty
+ | Escape e -> raise_for Unify (Escape e)
(* Safe version of expand_head, never fails *)
let expand_head env ty =
try try_expand_head try_expand_safe env ty with Cannot_expand -> repr ty
-let _ = forward_try_expand_once := try_expand_safe
+let _ = forward_try_expand_safe := try_expand_safe
(* Expand until we find a non-abstract type declaration,
normally hidden to the type-checker out of the implementation module of
the private abbreviation. *)
-let expand_abbrev_opt =
- expand_abbrev_gen Private Env.find_type_expansion_opt
+let expand_abbrev_opt env ty =
+ expand_abbrev_gen Private Env.find_type_expansion_opt env ty
+
+let safe_abbrev_opt env ty =
+ let snap = Btype.snapshot () in
+ try ignore (expand_abbrev_opt env ty); true
+ with Cannot_expand | Escape _ ->
+ Btype.backtrack snap;
+ false
let try_expand_once_opt env ty =
let ty = repr ty in
Tconstr _ -> repr (expand_abbrev_opt env ty)
| _ -> raise Cannot_expand
-let rec try_expand_head_opt env ty =
- let ty' = try_expand_once_opt env ty in
- begin try
- try_expand_head_opt env ty'
- with Cannot_expand ->
- ty'
- end
-
-let expand_head_opt env ty =
+let try_expand_safe_opt env ty =
let snap = Btype.snapshot () in
- try try_expand_head_opt env ty
- with Cannot_expand | Unify _ -> (* expand_head shall never fail *)
- Btype.backtrack snap;
- repr ty
+ try try_expand_once_opt env ty
+ with Escape _ ->
+ Btype.backtrack snap; raise Cannot_expand
-(* Make sure that the type parameters of the type constructor [ty]
- respect the type constraints *)
-let enforce_constraints env ty =
- match ty with
- {desc = Tconstr (path, args, _abbrev); level = level} ->
- begin try
- let decl = Env.find_type path env in
- ignore
- (subst env level Public (ref Mnil) None decl.type_params args
- (newvar2 level))
- with Not_found -> ()
- end
- | _ ->
- assert false
+let expand_head_opt env ty =
+ try try_expand_head try_expand_safe_opt env ty with Cannot_expand -> repr ty
(* Recursively expand the head of a type.
- Also expand #-types. *)
-let full_expand env ty =
- let ty = repr (expand_head env ty) in
+ Also expand #-types.
+
+ Error printing relies on [full_expand] returning exactly its input (i.e., a
+ physically equal type) when nothing changes. *)
+let full_expand ~may_forget_scope env ty =
+ let ty =
+ if may_forget_scope then
+ let ty = repr ty in
+ try expand_head_unif env ty with Unify _ ->
+ (* #10277: forget scopes when printing trace *)
+ begin_def ();
+ init_def ty.level;
+ let ty =
+ (* The same as [expand_head], except in the failing case we return the
+ *original* type, not [correct_levels ty].*)
+ try try_expand_head try_expand_safe env (correct_levels ty) with
+ | Cannot_expand -> repr ty
+ in
+ end_def ();
+ ty
+ else expand_head env ty
+ in
+ let ty = repr ty in
match ty.desc with
Tobject (fi, {contents = Some (_, v::_)}) when is_Tvar (repr v) ->
newty2 ty.level (Tobject (fi, ref None))
merge type_changed old
with exn ->
merge type_changed old;
- match exn with
- | Occur -> raise (Trace.rec_occur ty0 ty)
- | _ -> raise exn
+ raise exn
+
+let occur_for tr_exn env t1 t2 =
+ try
+ occur env t1 t2
+ with Occur -> raise_for tr_exn (Rec_occur(t1, t2))
let occur_in env ty0 t =
- try occur env ty0 t; false with Unify _ -> true
+ try occur env ty0 t; false with Occur -> true
(* Check that a local constraint is well-founded *)
(* PR#6405: not needed since we allow recursion and work on normalized types *)
begin try
(* try expanding, since [p] could be hidden *)
local_non_recursive_abbrev ~allow_rec strict visited env p
- (try_expand_head try_expand_once_opt env ty)
+ (try_expand_head try_expand_safe_opt env ty)
with Cannot_expand ->
let params =
try (Env.find_type p' env).type_params
(* Since we cannot duplicate universal variables, unification must
be done at meta-level, using bindings in univar_pairs *)
+(* TODO: use find_opt *)
let rec unify_univar t1 t2 = function
(cl1, cl2) :: rem ->
let find_univ t cl =
| None, None ->
unify_univar t1 t2 rem
| _ ->
- raise (Unify [])
+ raise Cannot_unify_universal_variables
end
- | [] -> raise (Unify [])
+ | [] -> raise Cannot_unify_universal_variables
+
+(* The same as [unify_univar], but raises the appropriate exception instead of
+ [Cannot_unify_universal_variables] *)
+let unify_univar_for tr_exn t1 t2 univar_pairs =
+ try unify_univar t1 t2 univar_pairs
+ with Cannot_unify_universal_variables -> raise_unexplained_for tr_exn
(* Test the occurrence of free univars in a type *)
-(* that's way too expensive. Must do some kind of caching *)
-let occur_univar env ty =
+(* That's way too expensive. Must do some kind of caching *)
+(* If [inj_only=true], only check injective positions *)
+let occur_univar ?(inj_only=false) env ty =
let visited = ref TypeMap.empty in
let rec occur_rec bound ty =
let ty = repr ty in
- if ty.level >= lowest_level &&
+ if not_marked_node ty then
if TypeSet.is_empty bound then
- (ty.level <- pivot_level - ty.level; true)
+ (flip_mark_node ty; occur_desc bound ty)
else try
let bound' = TypeMap.find ty !visited in
- if TypeSet.exists (fun x -> not (TypeSet.mem x bound)) bound' then
- (visited := TypeMap.add ty (TypeSet.inter bound bound') !visited;
- true)
- else false
+ if not (TypeSet.subset bound' bound) then begin
+ visited := TypeMap.add ty (TypeSet.inter bound bound') !visited;
+ occur_desc bound ty
+ end
with Not_found ->
visited := TypeMap.add ty bound !visited;
- true
- then
+ occur_desc bound ty
+ and occur_desc bound ty =
match ty.desc with
Tunivar _ ->
if not (TypeSet.mem ty bound) then
- raise Trace.(Unify [escape (Univ ty)])
+ raise_escape_exn (Univ ty)
| Tpoly (ty, tyl) ->
let bound = List.fold_right TypeSet.add (List.map repr tyl) bound in
occur_rec bound ty
in this position. Physical expansion, as done in `occur`,
would be costly here, since we need to check inside
object and variant types too. *)
- if not Variance.(eq v null) then occur_rec bound t)
+ if Variance.(if inj_only then mem Inj v else not (eq v null))
+ then occur_rec bound t)
tl td.type_variance
with Not_found ->
- List.iter (occur_rec bound) tl
+ if not inj_only then List.iter (occur_rec bound) tl
end
| _ -> iter_type_expr (occur_rec bound) ty
in
)
~always:(fun () -> unmark_type ty)
+let has_free_univars env ty =
+ try occur_univar ~inj_only:false env ty; false with Escape _ -> true
+let has_injective_univars env ty =
+ try occur_univar ~inj_only:true env ty; false with Escape _ -> true
+
+let occur_univar_for tr_exn env ty =
+ try
+ occur_univar env ty
+ with Escape e -> raise_for tr_exn (Escape e)
+
(* Grouping univars by families according to their binders *)
let add_univars =
List.fold_left (fun s (t,_) -> TypeSet.add (repr t) s)
Tpoly (t, tl) ->
if List.exists (fun t -> TypeSet.mem (repr t) family) tl then ()
else occur t
- | Tunivar _ ->
- if TypeSet.mem t family then raise Trace.(Unify [escape(Univ t)])
+ | Tunivar _ -> if TypeSet.mem t family then raise_escape_exn (Univ t)
| Tconstr (_, [], _) -> ()
| Tconstr (p, tl, _) ->
begin try
Misc.try_finally (fun () -> f t1 t2)
~always:(fun () -> univar_pairs := old_univars)
+let enter_poly_for tr_exn env univar_pairs t1 tl1 t2 tl2 f =
+ try
+ enter_poly env univar_pairs t1 tl1 t2 tl2 f
+ with Escape e -> raise_for tr_exn (Escape e)
+
let univar_pairs = ref []
(**** Instantiate a generic type into a poly type ***)
| Tvar name when ty.level = generic_level ->
For_copy.save_desc scope ty ty.desc;
let t = newty (Tunivar name) in
- ty.desc <- Tsubst t;
+ Private_type_expr.set_desc ty (Tsubst (t, None));
Some t
| _ -> None
in
(**** Transform error trace ****)
(* +++ Move it to some other place ? *)
-let expand_trace env trace =
- let expand_desc x = match x.Trace.expanded with
- | None -> Trace.{ t = repr x.t; expanded= Some(full_expand env x.t) }
+let expand_any_trace map env trace =
+ let expand_desc x = match x.Errortrace.expanded with
+ | None ->
+ let expanded = full_expand ~may_forget_scope:true env x.t in
+ Errortrace.{ t = repr x.t; expanded = Some expanded }
| Some _ -> x in
- Unification_trace.map expand_desc trace
+ map expand_desc trace
+
+let expand_trace env trace =
+ expand_any_trace Errortrace.map env trace
+
+let expand_subtype_trace env trace =
+ expand_any_trace Subtype.map env trace
(**** Unification ****)
let deep_occur t0 ty =
let rec occur_rec ty =
let ty = repr ty in
- if ty.level >= t0.level then begin
+ if ty.level >= t0.level && try_mark_node ty then begin
if ty == t0 then raise Occur;
- ty.level <- pivot_level - ty.level;
iter_type_expr occur_rec ty
end
in
with Occur ->
unmark_type ty; true
-(*
- 1. When unifying two non-abbreviated types, one type is made a link
- to the other. When unifying an abbreviated type with a
- non-abbreviated type, the non-abbreviated type is made a link to
- the other one. When unifying to abbreviated types, these two
- types are kept distincts, but they are made to (temporally)
- expand to the same type.
- 2. Abbreviations with at least one parameter are systematically
- expanded. The overhead does not seem too high, and that way
- abbreviations where some parameters does not appear in the
- expansion, such as ['a t = int], are correctly handled. In
- particular, for this example, unifying ['a t] with ['b t] keeps
- ['a] and ['b] distincts. (Is it really important ?)
- 3. Unifying an abbreviation ['a t = 'a] with ['a] should not yield
- ['a t as 'a]. Indeed, the type variable would otherwise be lost.
- This problem occurs for abbreviations expanding to a type
- variable, but also to many other constrained abbreviations (for
- instance, [(< x : 'a > -> unit) t = <x : 'a>]). The solution is
- that, if an abbreviation is unified with some subpart of its
- parameters, then the parameter actually does not get
- abbreviated. It would be possible to check whether some
- information is indeed lost, but it probably does not worth it.
-*)
-
let gadt_equations_level = ref None
let get_gadt_equations_level () =
let fresh_constr_scope = get_gadt_equations_level () in
let create_fresh_constr lev name =
let name = match name with Some s -> "$'"^s | _ -> "$" in
- let path =
- Path.Pident
- (Ident.create_scoped ~scope:fresh_constr_scope
- (get_new_abstract_name name))
- in
- let decl = new_declaration fresh_constr_scope None in
- let new_env = Env.add_local_type path decl !env in
+ let decl = new_local_type () in
+ let (id, new_env) =
+ Env.enter_type (get_new_abstract_name name) decl !env
+ ~scope:fresh_constr_scope in
+ let path = Path.Pident id in
let t = newty2 lev (Tconstr (path,[],ref Mnil)) in
env := new_env;
path, t
let path, t = create_fresh_constr ty.level o in
link_type ty t;
if ty.level < fresh_constr_scope then
- raise Trace.(Unify [escape (Constructor path)])
+ raise_for Unify (Escape (escape (Constructor path)))
| Tvariant r ->
let r = row_repr r in
if not (static_row r) then begin
{r with row_fields=[]; row_fixed; row_more = t} in
link_type m (newty2 m.level (Tvariant row));
if m.level < fresh_constr_scope then
- raise Trace.(Unify [escape (Constructor path)])
+ raise_for Unify (Escape (escape (Constructor path)))
| _ -> assert false
end;
iter_row iterator r
| Tconstr (p, _, _) when is_object_type p ->
- iter_type_expr iterator (full_expand !env ty)
+ iter_type_expr iterator (full_expand ~may_forget_scope:false !env ty)
| _ ->
iter_type_expr iterator ty
end
Tconstr (p, _, _) ->
begin try
is_datatype (Env.find_type p env) ||
- expands_to_datatype env (try_expand_once env ty)
+ expands_to_datatype env (try_expand_safe env ty)
with Not_found | Cannot_expand -> false
end
| _ -> false
+(* [mcomp] tests if two types are "compatible" -- i.e., if they could ever
+ unify. (This is distinct from [eqtype], which checks if two types *are*
+ exactly the same.) This is used to decide whether GADT cases are
+ unreachable. It is broadly part of unification. *)
+
(* mcomp type_pairs subst env t1 t2 does not raise an
exception if it is possible that t1 and t2 are actually
equal, assuming the types in type_pairs are equal and
mcomp_list type_pairs env tl1 tl2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _)) ->
mcomp_type_decl type_pairs env p1 p2 tl1 tl2
+ | (Tconstr (_, [], _), _) when has_injective_univars env t2' ->
+ raise (Unify [])
+ | (_, Tconstr (_, [], _)) when has_injective_univars env t1' ->
+ raise (Unify [])
| (Tconstr (p, _, _), _) | (_, Tconstr (p, _, _)) ->
begin try
let decl = Env.find_type p env in
- if non_aliasable p decl || is_datatype decl then raise (Unify [])
+ if non_aliasable p decl || is_datatype decl then
+ raise Incompatible
with Not_found -> ()
end
(*
| (Tpoly (t1, []), Tpoly (t2, [])) ->
mcomp type_pairs env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly env univar_pairs t1 tl1 t2 tl2
- (mcomp type_pairs env)
+ (try
+ enter_poly env univar_pairs
+ t1 tl1 t2 tl2 (mcomp type_pairs env)
+ with Escape _ -> raise Incompatible)
| (Tunivar _, Tunivar _) ->
- unify_univar t1' t2' !univar_pairs
+ (try unify_univar t1' t2' !univar_pairs
+ with Cannot_unify_universal_variables -> raise Incompatible)
| (_, _) ->
- raise (Unify [])
+ raise Incompatible
end
and mcomp_list type_pairs env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
- raise (Unify []);
+ raise Incompatible;
List.iter2 (mcomp type_pairs env) tl1 tl2
and mcomp_fields type_pairs env ty1 ty2 =
List.exists (fun (_, k, _) -> field_kind_repr k = Fpresent) in
mcomp type_pairs env rest1 rest2;
if has_present miss1 && (object_row ty2).desc = Tnil
- || has_present miss2 && (object_row ty1).desc = Tnil then raise (Unify []);
+ || has_present miss2 && (object_row ty1).desc = Tnil then raise Incompatible;
List.iter
(function (_n, k1, t1, k2, t2) ->
mcomp_kind k1 k2;
let k2 = field_kind_repr k2 in
match k1, k2 with
(Fpresent, Fabsent)
- | (Fabsent, Fpresent) -> raise (Unify [])
+ | (Fabsent, Fpresent) -> raise Incompatible
| _ -> ()
and mcomp_row type_pairs env row1 row2 =
| Rabsent | Reither _ -> false
in
if row1.row_closed && List.exists cannot_erase r2
- || row2.row_closed && List.exists cannot_erase r1 then raise (Unify []);
+ || row2.row_closed && List.exists cannot_erase r1 then raise Incompatible;
List.iter
(fun (_,f1,f2) ->
match row_field_repr f1, row_field_repr f2 with
| Rpresent (Some _), (Rpresent None | Reither (true, _, _, _) | Rabsent)
| (Reither (_, _::_, _, _) | Rabsent), Rpresent None
| (Reither (true, _, _, _) | Rabsent), Rpresent (Some _) ->
- raise (Unify [])
+ raise Incompatible
| Rpresent(Some t1), Rpresent(Some t2) ->
mcomp type_pairs env t1 t2
| Rpresent(Some t1), Reither(false, tl2, _, _) ->
(fun i (t1,t2) -> if i then mcomp type_pairs env t1 t2)
inj (List.combine tl1 tl2)
end else if non_aliasable p1 decl && non_aliasable p2 decl' then
- raise (Unify [])
+ raise Incompatible
else
match decl.type_kind, decl'.type_kind with
| Type_record (lst,r), Type_record (lst',r') when r = r' ->
mcomp_list type_pairs env tl1 tl2;
mcomp_record_description type_pairs env lst lst'
- | Type_variant v1, Type_variant v2 ->
+ | Type_variant (v1,r), Type_variant (v2,r') when r = r' ->
mcomp_list type_pairs env tl1 tl2;
mcomp_variant_description type_pairs env v1 v2
| Type_open, Type_open ->
| Type_abstract, Type_abstract -> ()
| Type_abstract, _ when not (non_aliasable p1 decl)-> ()
| _, Type_abstract when not (non_aliasable p2 decl') -> ()
- | _ -> raise (Unify [])
+ | _ -> raise Incompatible
with Not_found -> ()
and mcomp_type_option type_pairs env t t' =
match t, t' with
None, None -> ()
| Some t, Some t' -> mcomp type_pairs env t t'
- | _ -> raise (Unify [])
+ | _ -> raise Incompatible
and mcomp_variant_description type_pairs env xs ys =
let rec iter = fun x y ->
| Cstr_tuple l1, Cstr_tuple l2 -> mcomp_list type_pairs env l1 l2
| Cstr_record l1, Cstr_record l2 ->
mcomp_record_description type_pairs env l1 l2
- | _ -> raise (Unify [])
+ | _ -> raise Incompatible
end;
if Ident.name c1.cd_id = Ident.name c2.cd_id
then iter xs ys
- else raise (Unify [])
+ else raise Incompatible
| [],[] -> ()
- | _ -> raise (Unify [])
+ | _ -> raise Incompatible
in
iter xs ys
if Ident.name l1.ld_id = Ident.name l2.ld_id &&
l1.ld_mutable = l2.ld_mutable
then iter xs ys
- else raise (Unify [])
+ else raise Incompatible
| [], [] -> ()
- | _ -> raise (Unify [])
+ | _ -> raise Incompatible
in
iter
let mcomp env t1 t2 =
mcomp (TypePairs.create 4) env t1 t2
+let mcomp_for tr_exn env t1 t2 =
+ try
+ mcomp env t1 t2
+ with Incompatible -> raise_unexplained_for tr_exn
+
(* Real unification *)
let find_lowest_level ty =
let lowest = ref generic_level in
let rec find ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
+ if not_marked_node ty then begin
if ty.level < !lowest then lowest := ty.level;
- ty.level <- pivot_level - ty.level;
+ flip_mark_node ty;
iter_type_expr find ty
end
in find ty; unmark_type ty; !lowest
let add_gadt_equation env source destination =
(* Format.eprintf "@[add_gadt_equation %s %a@]@."
(Path.name source) !Btype.print_raw destination; *)
- if local_non_recursive_abbrev !env source destination then begin
+ if has_free_univars !env destination then
+ occur_univar ~inj_only:true !env destination
+ else if local_non_recursive_abbrev !env source destination then begin
let destination = duplicate_type destination in
let expansion_scope =
- max (Path.scope source) (get_gadt_equations_level ())
+ Int.max (Path.scope source) (get_gadt_equations_level ())
in
- let decl = new_declaration expansion_scope (Some destination) in
+ let decl =
+ new_local_type ~manifest_and_scope:(destination, expansion_scope) () in
env := Env.add_local_type source decl !env;
cleanup_abbrev ()
end
Path.same (normalize_package_path env p1) (normalize_package_path env p2)
let nondep_type' = ref (fun _ _ _ -> assert false)
-let package_subtype = ref (fun _ _ _ _ _ _ _ -> assert false)
+let package_subtype = ref (fun _ _ _ _ _ -> assert false)
exception Nondep_cannot_erase of Ident.t
(* Find the type paths nl1 in the module type mty2, and add them to the
list (nl2, tl2). raise Not_found if impossible *)
-let complete_type_list ?(allow_absent=false) env nl1 lv2 mty2 nl2 tl2 =
+let complete_type_list ?(allow_absent=false) env fl1 lv2 mty2 fl2 =
(* This is morally WRONG: we're adding a (dummy) module without a scope in the
environment. However no operation which cares about levels/scopes is going
to happen while this module exists.
environments though. *)
let id2 = Ident.create_local "Pkg" in
let env' = Env.add_module id2 Mp_present mty2 env in
- let rec complete nl1 ntl2 =
- match nl1, ntl2 with
- [], _ -> ntl2
- | n :: nl, (n2, _ as nt2) :: ntl' when n >= n2 ->
- nt2 :: complete (if n = n2 then nl else nl1) ntl'
- | n :: nl, _ ->
+ let rec complete fl1 fl2 =
+ match fl1, fl2 with
+ [], _ -> fl2
+ | (n, _) :: nl, (n2, _ as nt2) :: ntl' when n >= n2 ->
+ nt2 :: complete (if n = n2 then nl else fl1) ntl'
+ | (n, _) :: nl, _ ->
let lid = concat_longident (Longident.Lident "Pkg") n in
match Env.find_type_by_name lid env' with
| (_, {type_arity = 0; type_kind = Type_abstract;
type_private = Public; type_manifest = Some t2}) ->
begin match nondep_instance env' lv2 id2 t2 with
- | t -> (n, t) :: complete nl ntl2
+ | t -> (n, t) :: complete nl fl2
| exception Nondep_cannot_erase _ ->
if allow_absent then
- complete nl ntl2
+ complete nl fl2
else
raise Exit
end
| (_, {type_arity = 0; type_kind = Type_abstract;
type_private = Public; type_manifest = None})
when allow_absent ->
- complete nl ntl2
+ complete nl fl2
| _ -> raise Exit
| exception Not_found when allow_absent->
- complete nl ntl2
+ complete nl fl2
in
- match complete nl1 (List.combine nl2 tl2) with
+ match complete fl1 fl2 with
| res -> res
| exception Exit -> raise Not_found
(* raise Not_found rather than Unify if the module types are incompatible *)
-let unify_package env unify_list lv1 p1 n1 tl1 lv2 p2 n2 tl2 =
- let ntl2 = complete_type_list env n1 lv2 (Mty_ident p2) n2 tl2
- and ntl1 = complete_type_list env n2 lv1 (Mty_ident p1) n1 tl1 in
+let unify_package env unify_list lv1 p1 fl1 lv2 p2 fl2 =
+ let ntl2 = complete_type_list env fl1 lv2 (Mty_ident p2) fl2
+ and ntl1 = complete_type_list env fl2 lv1 (Mty_ident p1) fl1 in
unify_list (List.map snd ntl1) (List.map snd ntl2);
if eq_package_path env p1 p2
- || !package_subtype env p1 n1 tl1 p2 n2 tl2
- && !package_subtype env p2 n2 tl2 p1 n1 tl1 then () else raise Not_found
+ || !package_subtype env p1 fl1 p2 fl2
+ && !package_subtype env p2 fl2 p1 fl1 then () else raise Not_found
(* force unification in Reither when one side has a non-conjunctive type *)
let unify1_var env t1 t2 =
assert (is_Tvar t1);
- occur env t1 t2;
- occur_univar env t2;
- let d1 = t1.desc in
- link_type t1 t2;
- try
- update_level env t1.level t2;
- update_scope t1.scope t2
- with Unify _ as e ->
- t1.desc <- d1;
- raise e
+ occur_for Unify env t1 t2;
+ match occur_univar_for Unify env t2 with
+ | () ->
+ begin
+ try
+ update_level env t1.level t2;
+ update_scope t1.scope t2
+ with Escape e ->
+ raise_for Unify (Escape e)
+ end;
+ link_type t1 t2;
+ true
+ | exception Unify _ when !umode = Pattern ->
+ false
(* Can only be called when generate_equations is true *)
let record_equation t1 t2 =
| Forbidden -> assert false
| Allowed { equated_types } -> TypePairs.add equated_types (t1, t2) ()
+(* Called from unify3 *)
+let unify3_var env t1' t2 t2' =
+ occur_for Unify !env t1' t2;
+ match occur_univar_for Unify !env t2 with
+ | () -> link_type t1' t2
+ | exception Unify _ when !umode = Pattern ->
+ reify env t1';
+ reify env t2';
+ if can_generate_equations () then begin
+ occur_univar ~inj_only:true !env t2';
+ record_equation t1' t2';
+ end
+
+(*
+ 1. When unifying two non-abbreviated types, one type is made a link
+ to the other. When unifying an abbreviated type with a
+ non-abbreviated type, the non-abbreviated type is made a link to
+ the other one. When unifying to abbreviated types, these two
+ types are kept distincts, but they are made to (temporally)
+ expand to the same type.
+ 2. Abbreviations with at least one parameter are systematically
+ expanded. The overhead does not seem too high, and that way
+ abbreviations where some parameters does not appear in the
+ expansion, such as ['a t = int], are correctly handled. In
+ particular, for this example, unifying ['a t] with ['b t] keeps
+ ['a] and ['b] distincts. (Is it really important ?)
+ 3. Unifying an abbreviation ['a t = 'a] with ['a] should not yield
+ ['a t as 'a]. Indeed, the type variable would otherwise be lost.
+ This problem occurs for abbreviations expanding to a type
+ variable, but also to many other constrained abbreviations (for
+ instance, [(< x : 'a > -> unit) t = <x : 'a>]). The solution is
+ that, if an abbreviation is unified with some subpart of its
+ parameters, then the parameter actually does not get
+ abbreviated. It would be possible to check whether some
+ information is indeed lost, but it probably does not worth it.
+*)
+
let rec unify (env:Env.t ref) t1 t2 =
(* First step: special cases (optimizations) *)
if t1 == t2 then () else
| (Tconstr _, Tvar _) when deep_occur t2 t1 ->
unify2 env t1 t2
| (Tvar _, _) ->
- unify1_var !env t1 t2
+ if unify1_var !env t1 t2 then () else unify2 env t1 t2
| (_, Tvar _) ->
- unify1_var !env t2 t1
+ if unify1_var !env t2 t1 then () else unify2 env t1 t2
| (Tunivar _, Tunivar _) ->
- unify_univar t1 t2 !univar_pairs;
- update_level !env t1.level t2;
- update_scope t1.scope t2;
+ unify_univar_for Unify t1 t2 !univar_pairs;
+ update_level_for Unify !env t1.level t2;
+ update_scope_for Unify t1.scope t2;
link_type t1 t2
| (Tconstr (p1, [], a1), Tconstr (p2, [], a2))
when Path.same p1 p2 (* && actual_mode !env = Old *)
when any of the types has a cached expansion. *)
&& not (has_cached_expansion p1 !a1
|| has_cached_expansion p2 !a2) ->
- update_level !env t1.level t2;
- update_scope t1.scope t2;
+ update_level_for Unify !env t1.level t2;
+ update_scope_for Unify t1.scope t2;
link_type t1 t2
| (Tconstr (p1, [], _), Tconstr (p2, [], _))
when Env.has_local_constraints !env
(* Do not use local constraints more than necessary *)
begin try
if find_expansion_scope !env p1 > find_expansion_scope !env p2 then
- unify env t1 (try_expand_once !env t2)
+ unify env t1 (try_expand_safe !env t2)
else
- unify env (try_expand_once !env t1) t2
+ unify env (try_expand_safe !env t1) t2
with Cannot_expand ->
unify2 env t1 t2
end
reset_trace_gadt_instances reset_tracing;
with Unify trace ->
reset_trace_gadt_instances reset_tracing;
- raise( Unify (Trace.diff t1 t2 :: trace) )
+ raise( Unify (Errortrace.diff t1 t2 :: trace) )
and unify2 env t1 t2 =
(* Second step: expansion of abbreviations *)
ignore (expand_head_unif !env t2);
let t1' = expand_head_unif !env t1 in
let t2' = expand_head_unif !env t2 in
- let lv = min t1'.level t2'.level in
- let scope = max t1'.scope t2'.scope in
- update_level !env lv t2;
- update_level !env lv t1;
- update_scope scope t2;
- update_scope scope t1;
+ let lv = Int.min t1'.level t2'.level in
+ let scope = Int.max t1'.scope t2'.scope in
+ update_level_for Unify !env lv t2;
+ update_level_for Unify !env lv t1;
+ update_scope_for Unify scope t2;
+ update_scope_for Unify scope t1;
if unify_eq t1' t2' then () else
let t1 = repr t1 and t2 = repr t2 in
unify3 env t1 t1' t2 t2'
else
try unify3 env t2 t2' t1 t1' with Unify trace ->
- raise (Unify (Trace.swap trace))
+ raise_trace_for Unify (swap_trace trace)
and unify3 env t1 t1' t2 t2' =
(* Third step: truly unification *)
begin match (d1, d2) with (* handle vars and univars specially *)
(Tunivar _, Tunivar _) ->
- unify_univar t1' t2' !univar_pairs;
+ unify_univar_for Unify t1' t2' !univar_pairs;
link_type t1' t2'
| (Tvar _, _) ->
- occur !env t1' t2;
- occur_univar !env t2;
- link_type t1' t2;
+ unify3_var env t1' t2 t2'
| (_, Tvar _) ->
- occur !env t2' t1;
- occur_univar !env t1;
- link_type t2' t1;
+ unify3_var env t2' t1 t1'
| (Tfield _, Tfield _) -> (* special case for GADTs *)
unify_fields env t1' t2'
| _ ->
begin match !umode with
| Expression ->
- occur !env t1' t2';
+ occur_for Unify !env t1' t2';
if is_self_type d1 (* PR#7711: do not abbreviate self type *)
then link_type t1' t2'
else link_type t1' t2
~allow_recursive:!allow_recursive_equation
(fun () -> unify_list env tl1 tl2)
else if in_current_module p1 (* || in_pervasives p1 *)
- || List.exists (expands_to_datatype !env) [t1'; t1; t2] then
+ || List.exists (expands_to_datatype !env) [t1'; t1; t2]
+ then
unify_list env tl1 tl2
else
let inj =
let snap = snapshot () in
try unify env t1 t2 with Unify _ ->
backtrack snap;
- reify env t1; reify env t2
+ reify env t1;
+ reify env t2
end)
inj (List.combine tl1 tl2)
| (Tconstr (path,[],_),
reify env t1';
reify env t2';
if can_generate_equations () then (
- mcomp !env t1' t2';
+ mcomp_for Unify !env t1' t2';
record_equation t1' t2'
)
| (Tobject (fi1, nm1), Tobject (fi2, _)) ->
reify env t1';
reify env t2';
if can_generate_equations () then (
- mcomp !env t1' t2';
+ mcomp_for Unify !env t1' t2';
record_equation t1' t2'
)
end
else unify env (newty2 rem.level Tnil) rem
| _ ->
if f = dummy_method then
- raise (Unify Trace.[Obj Self_cannot_be_closed])
+ raise_for Unify (Obj Self_cannot_be_closed)
else if d1 = Tnil then
- raise (Unify Trace.[Obj(Missing_field (First, f))])
+ raise_for Unify (Obj (Missing_field(First, f)))
else
- raise (Unify Trace.[Obj(Missing_field (Second, f))])
+ raise_for Unify (Obj (Missing_field(Second, f)))
end
| (Tnil, Tnil) ->
()
| (Tpoly (t1, []), Tpoly (t2, [])) ->
unify env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly !env univar_pairs t1 tl1 t2 tl2 (unify env)
- | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+ enter_poly_for Unify !env univar_pairs t1 tl1 t2 tl2 (unify env)
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package !env (unify_list env)
- t1.level p1 n1 tl1 t2.level p2 n2 tl2
+ t1.level p1 fl1 t2.level p2 fl2
with Not_found ->
- if !umode = Expression then raise (Unify []);
- List.iter (reify env) (tl1 @ tl2);
+ if !umode = Expression then raise_unexplained_for Unify;
+ List.iter (fun (_n, ty) -> reify env ty) (fl1 @ fl2);
(* if !generate_equations then List.iter2 (mcomp !env) tl1 tl2 *)
end
- | (Tnil, Tconstr _ ) -> raise (Unify Trace.[Obj(Abstract_row Second)])
- | (Tconstr _, Tnil ) -> raise (Unify Trace.[Obj(Abstract_row First)])
- | (_, _) -> raise (Unify [])
+ | (Tnil, Tconstr _ ) ->
+ raise (Unify Errortrace.[Obj(Abstract_row Second)])
+ | (Tconstr _, Tnil ) ->
+ raise (Unify Errortrace.[Obj(Abstract_row First)])
+ | (_, _) -> raise_unexplained_for Unify
end;
(* XXX Commentaires + changer "create_recursion"
||| Comments + change "create_recursion" *)
| _ ->
() (* t2 has already been expanded by update_level *)
with Unify trace ->
- t1'.desc <- d1;
- raise (Unify trace)
+ Private_type_expr.set_desc t1' d1;
+ raise_trace_for Unify trace
end
and unify_list env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
- raise (Unify []);
+ raise_unexplained_for Unify;
List.iter2 (unify env) tl1 tl2
(* Build a fresh row variable for unification *)
and (fields2, rest2) = flatten_fields ty2 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
let l1 = (repr ty1).level and l2 = (repr ty2).level in
- let va = make_rowvar (min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
+ let va = make_rowvar (Int.min l1 l2) (miss2=[]) rest1 (miss1=[]) rest2 in
let d1 = rest1.desc and d2 = rest2.desc in
try
unify env (build_fields l1 miss1 va) rest2;
unify_kind k1 k2;
try
if !trace_gadt_instances then begin
- update_level !env va.level t1;
- update_scope va.scope t1
+ update_level_for Unify !env va.level t1;
+ update_scope_for Unify va.scope t1
end;
unify env t1 t2
with Unify trace ->
- raise( Unify (Trace.incompatible_fields n t1 t2 :: trace) )
+ raise( Unify (Errortrace.incompatible_fields n t1 t2 :: trace) )
)
pairs
with exn ->
| Some _, Some _ -> if rm2.level < rm1.level then rm2 else rm1
| Some _, None -> rm1
| None, Some _ -> rm2
- | None, None -> newty2 (min rm1.level rm2.level) (Tvar None)
+ | None, None -> newty2 (Int.min rm1.level rm2.level) (Tvar None)
in
let fixed = merge_fixed_explanation fixed1 fixed2
and closed = row1.row_closed || row2.row_closed in
(fun (_,f1,f2) ->
row_field_repr f1 = Rabsent || row_field_repr f2 = Rabsent)
pairs
- then raise Trace.( Unify [Variant No_intersection] );
+ then raise_for Unify (Variant No_intersection);
let name =
if row1.row_name <> None && (row1.row_closed || empty r2) &&
(not row2.row_closed || keep (fun f1 f2 -> f1, f2) && empty r1)
begin match fixed_explanation row with
| None ->
if rest <> [] && row.row_closed then
- let pos = if row == row1 then Trace.First else Trace.Second in
- raise Trace.(Unify [Variant (No_tags(pos,rest))])
+ let pos = if row == row1 then First else Second in
+ raise_for Unify (Variant (No_tags(pos,rest)))
| Some fixed ->
- let pos = if row == row1 then Trace.First else Trace.Second in
+ let pos = if row == row1 then First else Second in
if closed && not row.row_closed then
- raise Trace.(Unify [Variant(Fixed_row(pos,Cannot_be_closed,fixed))])
+ raise_for Unify (Variant (Fixed_row(pos,Cannot_be_closed,fixed)))
else if rest <> [] then
- let case = Trace.Cannot_add_tags (List.map fst rest) in
- raise Trace.(Unify [Variant(Fixed_row(pos,case,fixed))])
+ let case = Cannot_add_tags (List.map fst rest) in
+ raise_for Unify (Variant (Fixed_row(pos,case,fixed)))
end;
(* The following test is not principal... should rather use Tnil *)
let rm = row_more row in
(*if !trace_gadt_instances && rm.desc = Tnil then () else*)
if !trace_gadt_instances then
- update_level !env rm.level (newgenty (Tvariant row));
+ update_level_for Unify !env rm.level (newgenty (Tvariant row));
if row_fixed row then
if more == rm then () else
if is_Tvar rm then link_type rm more else unify env rm more
else
let ty = newgenty (Tvariant {row0 with row_fields = rest}) in
- update_level !env rm.level ty;
- update_scope rm.scope ty;
+ update_level_for Unify !env rm.level ty;
+ update_scope_for Unify rm.scope ty;
link_type rm ty
in
let md1 = rm1.desc and md2 = rm2.desc in
(fun (l,f1,f2) ->
try unify_row_field env fixed1 fixed2 rm1 rm2 l f1 f2
with Unify trace ->
- raise Trace.( Unify( Variant (Incompatible_types_for l) :: trace ))
+ raise_trace_for Unify (Variant (Incompatible_types_for l) :: trace)
)
pairs;
if static_row row1 then begin
match fixed with
| None -> f ()
| Some fix ->
- let tr = Trace.[ Variant (Fixed_row (pos,Cannot_add_tags [l],fix)) ] in
- raise (Unify tr) in
- let first = Trace.First, fixed1 and second = Trace.Second, fixed2 in
+ let tr = [Variant(Fixed_row(pos,Cannot_add_tags [l],fix))] in
+ raise_trace_for Unify tr in
+ let first = First, fixed1 and second = Second, fixed2 in
let either_fixed = match fixed1, fixed2 with
| None, None -> false
| _ -> true in
!rigid_variants && (List.length tl1 = 1 || List.length tl2 = 1)) &&
begin match tl1 @ tl2 with [] -> false
| t1 :: tl ->
- if c1 || c2 then raise (Unify []);
+ if c1 || c2 then raise_unexplained_for Unify;
List.iter (unify env t1) tl;
!e1 <> None || !e2 <> None
end in
in
let tl1' = remq tl2 tl1 and tl2' = remq tl1 tl2 in
(* PR#6744 *)
- let split_univars =
- List.partition
- (fun ty -> try occur_univar !env ty; true with Unify _ -> false) in
- let (tl1',tlu1) = split_univars tl1'
- and (tl2',tlu2) = split_univars tl2' in
+ let (tlu1,tl1') = List.partition (has_free_univars !env) tl1'
+ and (tlu2,tl2') = List.partition (has_free_univars !env) tl2' in
begin match tlu1, tlu2 with
[], [] -> ()
| (tu1::tlu1), _ :: _ ->
(* Attempt to merge all the types containing univars *)
List.iter (unify env tu1) (tlu1@tlu2)
- | (tu::_, []) | ([], tu::_) -> occur_univar !env tu
+ | (tu::_, []) | ([], tu::_) ->
+ occur_univar_for Unify !env tu
end;
(* Is this handling of levels really principal? *)
List.iter (fun ty ->
let rm = repr rm2 in
- update_level !env rm.level ty;
- update_scope rm.scope ty;
+ update_level_for Unify !env rm.level ty;
+ update_scope_for Unify rm.scope ty;
) tl1';
List.iter (fun ty ->
let rm = repr rm1 in
- update_level !env rm.level ty;
- update_scope rm.scope ty;
+ update_level_for Unify !env rm.level ty;
+ update_scope_for Unify rm.scope ty;
) tl2';
let e = ref None in
let f1' = Reither(c1 || c2, tl2', m1 || m2, e)
if_not_fixed first (fun () ->
set_row_field e1 f2;
let rm = repr rm1 in
- update_level !env rm.level t2;
- update_scope rm.scope t2;
+ update_level_for Unify !env rm.level t2;
+ update_scope_for Unify rm.scope t2;
(try List.iter (fun t1 -> unify env t1 t2) tl
with exn -> e1 := None; raise exn)
)
if_not_fixed second (fun () ->
set_row_field e2 f1;
let rm = repr rm2 in
- update_level !env rm.level t1;
- update_scope rm.scope t1;
+ update_level_for Unify !env rm.level t1;
+ update_scope_for Unify rm.scope t1;
(try List.iter (unify env t1) tl
with exn -> e2 := None; raise exn)
)
if_not_fixed first (fun () -> set_row_field e1 f2)
| Rpresent None, Reither(true, [], _, e2) ->
if_not_fixed second (fun () -> set_row_field e2 f1)
- | _ -> raise (Unify [])
-
+ | _ -> raise_unexplained_for Unify
let unify env ty1 ty2 =
let snap = Btype.snapshot () in
| Tvar _, _ ->
let reset_tracing = check_trace_gadt_instances env in
begin try
- occur env t1 t2;
- update_level env t1.level t2;
- update_scope t1.scope t2;
+ occur_for Unify env t1 t2;
+ update_level_for Unify env t1.level t2;
+ update_scope_for Unify t1.scope t2;
link_type t1 t2;
reset_trace_gadt_instances reset_tracing;
with Unify trace ->
reset_trace_gadt_instances reset_tracing;
- let expanded_trace = expand_trace env @@ Trace.diff t1 t2 :: trace in
- raise (Unify expanded_trace)
+ let expanded_trace =
+ expand_trace env @@ Errortrace.diff t1 t2 :: trace
+ in
+ raise_trace_for Unify expanded_trace
end
| _ ->
unify (ref env) t1 t2
(*
Unify [t] and [l:'a -> 'b]. Return ['a] and ['b].
- In label mode, label mismatch is accepted when
+ In [-nolabels] mode, label mismatch is accepted when
(1) the requested label is ""
(2) the original label is not optional
*)
when l = l' || !Clflags.classic && l = Nolabel && not (is_optional l') ->
(t1, t2)
| _ ->
- raise (Unify [])
+ raise_unexplained_for Unify
(* Used by [filter_method]. *)
let rec filter_method_field env name priv ty =
end else
filter_method_field env name priv ty2
| _ ->
- raise (Unify [])
+ raise_unexplained_for Unify
(* Unify [ty] and [< name : 'a; .. >]. Return ['a]. *)
let filter_method env name priv ty =
Tvar _ ->
let ty1 = newvar () in
let ty' = newobj ty1 in
- update_level env ty.level ty';
- update_scope ty.scope ty';
+ update_level_for Unify env ty.level ty';
+ update_scope_for Unify ty.scope ty';
link_type ty ty';
filter_method_field env name priv ty1
| Tobject(f, _) ->
filter_method_field env name priv f
| _ ->
- raise (Unify [])
+ raise_unexplained_for Unify
let check_filter_method env name priv ty =
ignore(filter_method env name priv ty)
let moregen_occur env level ty =
let rec occur ty =
let ty = repr ty in
- if ty.level > level then begin
- if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur;
- ty.level <- pivot_level - ty.level;
- iter_type_expr occur ty
- end
+ if ty.level <= level then () else
+ if is_Tvar ty && ty.level >= generic_level - 1 then raise Occur else
+ if try_mark_node ty then iter_type_expr occur ty
in
begin try
occur ty; unmark_type ty
with Occur ->
- unmark_type ty; raise (Unify [])
+ unmark_type ty; raise_unexplained_for Moregen
end;
(* also check for free univars *)
- occur_univar env ty;
- update_level env level ty
+ occur_univar_for Moregen env ty;
+ update_level_for Moregen env level ty
let may_instantiate inst_nongen t1 =
if inst_nongen then t1.level <> generic_level - 1
let t1 = repr t1 in
let t2 = repr t2 in
if t1 == t2 then () else
-
try
match (t1.desc, t2.desc) with
- (Tvar _, _) when may_instantiate inst_nongen t1 ->
+ | (Tvar _, _) when may_instantiate inst_nongen t1 ->
moregen_occur env t1.level t2;
- update_scope t1.scope t2;
- occur env t1 t2;
+ update_scope_for Moregen t1.scope t2;
+ occur_for Moregen env t1 t2;
link_type t1 t2
| (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
()
match (t1'.desc, t2'.desc) with
(Tvar _, _) when may_instantiate inst_nongen t1' ->
moregen_occur env t1'.level t2;
- update_scope t1'.scope t2;
+ update_scope_for Moregen t1'.scope t2;
link_type t1' t2
| (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
|| !Clflags.classic && not (is_optional l1 || is_optional l2) ->
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
when Path.same p1 p2 ->
moregen_list inst_nongen type_pairs env tl1 tl2
- | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package env (moregen_list inst_nongen type_pairs env)
- t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
- with Not_found -> raise (Unify [])
+ t1'.level p1 fl1 t2'.level p2 fl2
+ with Not_found -> raise_unexplained_for Moregen
end
+ | (Tnil, Tconstr _ ) -> raise_for Moregen (Obj (Abstract_row Second))
+ | (Tconstr _, Tnil ) -> raise_for Moregen (Obj (Abstract_row First))
| (Tvariant row1, Tvariant row2) ->
moregen_row inst_nongen type_pairs env row1 row2
| (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
| (Tpoly (t1, []), Tpoly (t2, [])) ->
moregen inst_nongen type_pairs env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly env univar_pairs t1 tl1 t2 tl2
+ enter_poly_for Moregen env univar_pairs t1 tl1 t2 tl2
(moregen inst_nongen type_pairs env)
| (Tunivar _, Tunivar _) ->
- unify_univar t1' t2' !univar_pairs
+ unify_univar_for Moregen t1' t2' !univar_pairs
| (_, _) ->
- raise (Unify [])
+ raise_unexplained_for Moregen
end
- with Unify trace -> raise( Unify ( Trace.diff t1 t2 :: trace ) )
+ with Moregen trace -> raise ( Moregen ( Errortrace.diff t1 t2 :: trace ) );
+
and moregen_list inst_nongen type_pairs env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
- raise (Unify []);
+ raise_unexplained_for Moregen;
List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
and moregen_fields inst_nongen type_pairs env ty1 ty2 =
let (fields1, rest1) = flatten_fields ty1
and (fields2, rest2) = flatten_fields ty2 in
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
- if miss1 <> [] then raise (Unify []);
+ begin
+ match miss1 with
+ | (n, _, _) :: _ -> raise_for Moregen (Obj (Missing_field (Second, n)))
+ | [] -> ()
+ end;
moregen inst_nongen type_pairs env rest1
(build_fields (repr ty2).level miss2 rest2);
+
List.iter
(fun (n, k1, t1, k2, t2) ->
+ (* The below call should never throw [Public_method_to_private_method] *)
moregen_kind k1 k2;
- try moregen inst_nongen type_pairs env t1 t2 with Unify trace ->
- let e = Trace.diff
- (newty (Tfield(n, k1, t1, rest2)))
- (newty (Tfield(n, k2, t2, rest2))) in
- raise( Unify ( e :: trace ) )
+ try moregen inst_nongen type_pairs env t1 t2 with Moregen trace ->
+ raise( Moregen ( Errortrace.incompatible_fields n t1 t2 :: trace ) )
)
pairs
match k1, k2 with
(Fvar r, (Fvar _ | Fpresent)) -> set_kind r k2
| (Fpresent, Fpresent) -> ()
- | _ -> raise (Unify [])
+ | (Fpresent, Fvar _) -> raise Public_method_to_private_method
+ | (Fabsent, _) | (_, Fabsent) -> assert false
and moregen_row inst_nongen type_pairs env row1 row2 =
let row1 = row_repr row1 and row2 = row_repr row2 in
filter_row_fields may_inst r1, filter_row_fields false r2
else r1, r2
in
- if r1 <> [] || row1.row_closed && (not row2.row_closed || r2 <> [])
- then raise (Unify []);
+ begin
+ if r1 <> [] then raise_for Moregen (Variant (No_tags (Second, r1)))
+ end;
+ if row1.row_closed then begin
+ match row2.row_closed, r2 with
+ | false, _ -> raise_for Moregen (Variant (Openness Second))
+ | _, _ :: _ -> raise_for Moregen (Variant (No_tags (First, r2)))
+ | _, [] -> ()
+ end;
begin match rm1.desc, rm2.desc with
Tunivar _, Tunivar _ ->
- unify_univar rm1 rm2 !univar_pairs
+ unify_univar_for Moregen rm1 rm2 !univar_pairs
| Tunivar _, _ | _, Tunivar _ ->
- raise (Unify [])
+ raise_unexplained_for Moregen
| _ when static_row row1 -> ()
| _ when may_inst ->
let ext =
newgenty (Tvariant {row2 with row_fields = r2; row_name = None})
in
moregen_occur env rm1.level ext;
- update_scope rm1.scope ext;
+ update_scope_for Moregen rm1.scope ext;
link_type rm1 ext
| Tconstr _, Tconstr _ ->
moregen inst_nongen type_pairs env rm1 rm2
- | _ -> raise (Unify [])
+ | _ -> raise_unexplained_for Moregen
end;
List.iter
- (fun (_l,f1,f2) ->
- let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
- if f1 == f2 then () else
- match f1, f2 with
- Rpresent(Some t1), Rpresent(Some t2) ->
- moregen inst_nongen type_pairs env t1 t2
- | Rpresent None, Rpresent None -> ()
- | Reither(false, tl1, _, e1), Rpresent(Some t2) when may_inst ->
- set_row_field e1 f2;
- List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
- | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
- if e1 != e2 then begin
- if c1 && not c2 then raise(Unify []);
- set_row_field e1 (Reither (c2, [], m2, e2));
- if List.length tl1 = List.length tl2 then
- List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
- else match tl2 with
- t2 :: _ ->
- List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
- tl1
- | [] ->
- if tl1 <> [] then raise (Unify [])
- end
- | Reither(true, [], _, e1), Rpresent None when may_inst ->
- set_row_field e1 f2
- | Reither(_, _, _, e1), Rabsent when may_inst ->
- set_row_field e1 f2
- | Rabsent, Rabsent -> ()
- | _ -> raise (Unify []))
+ (fun (l,f1,f2) ->
+ try
+ let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
+ if f1 == f2 then () else
+ match f1, f2 with
+ | Rpresent(Some t1), Rpresent(Some t2) ->
+ moregen inst_nongen type_pairs env t1 t2
+ | Rpresent None, Rpresent None -> ()
+ | Reither(false, tl1, _, e1), Rpresent(Some t2) when may_inst ->
+ set_row_field e1 f2;
+ List.iter (fun t1 -> moregen inst_nongen type_pairs env t1 t2) tl1
+ | Reither(c1, tl1, _, e1), Reither(c2, tl2, m2, e2) ->
+ if e1 != e2 then begin
+ if c1 && not c2 then raise_unexplained_for Moregen;
+ set_row_field e1 (Reither (c2, [], m2, e2));
+ if List.length tl1 = List.length tl2 then
+ List.iter2 (moregen inst_nongen type_pairs env) tl1 tl2
+ else match tl2 with
+ | t2 :: _ ->
+ List.iter
+ (fun t1 -> moregen inst_nongen type_pairs env t1 t2)
+ tl1
+ | [] -> if tl1 <> [] then raise_unexplained_for Moregen
+ end
+ | Reither(true, [], _, e1), Rpresent None when may_inst ->
+ set_row_field e1 f2
+ | Reither(_, _, _, e1), Rabsent when may_inst -> set_row_field e1 f2
+ | Rabsent, Rabsent -> ()
+ | Rpresent (Some _), Rpresent None -> raise_unexplained_for Moregen
+ | Rpresent None, Rpresent (Some _) -> raise_unexplained_for Moregen
+ | Rpresent _, Reither _ -> raise_unexplained_for Moregen
+ | _ -> raise_unexplained_for Moregen
+ with Moregen err ->
+ raise (Moregen (Variant (Incompatible_types_for l) :: err)))
pairs
(* Must empty univar_pairs first *)
current_level := generic_level;
(* Duplicate generic variables *)
let patt = instance pat_sch in
- let res =
- try moregen inst_nongen (TypePairs.create 13) env patt subj; true with
- Unify _ -> false
- in
- current_level := old_level;
- res
+ Misc.try_finally
+ (fun () -> moregen inst_nongen (TypePairs.create 13) env patt subj)
+ ~always:(fun () -> current_level := old_level)
+
+let is_moregeneral env inst_nongen pat_sch subj_sch =
+ match moregeneral env inst_nongen pat_sch subj_sch with
+ | () -> true
+ | exception Moregen _ -> false
(* Alternative approach: "rigidify" a type scheme,
and check validity after unification *)
let rec rigidify_rec vars ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
- match ty.desc with
+ if try_mark_node ty then
+ begin match ty.desc with
| Tvar _ ->
if not (List.memq ty !vars) then vars := ty :: !vars
| Tvariant row ->
if not (static_row row) then rigidify_rec vars (row_more row)
| _ ->
iter_type_expr (rigidify_rec vars) ty
- end
+ end
let rigidify ty =
let vars = ref [] in
let snap = snapshot () in
let vars = rigidify ty in
cleanup_abbrev ();
- let ok =
- try unify env ty ty'; all_distinct_vars env vars
- with Unify _ -> false
- in
- backtrack snap;
- ok
+ match unify env ty ty' with
+ | () ->
+ if not (all_distinct_vars env vars) then begin
+ backtrack snap;
+ raise (Matches_failure (env, [Errortrace.diff ty ty']))
+ end;
+ backtrack snap
+ | exception Unify trace ->
+ backtrack snap;
+ raise (Matches_failure (env, trace))
+let does_match env ty ty' =
+ match matches env ty ty' with
+ | () -> true
+ | exception Matches_failure (_, _) -> false
(*********************************************)
(* Equivalence between parameterized types *)
try
match (t1.desc, t2.desc) with
- (Tvar _, Tvar _) when rename ->
+ | (Tvar _, Tvar _) when rename ->
begin try
normalize_subst subst;
- if List.assq t1 !subst != t2 then raise (Unify [])
+ if List.assq t1 !subst != t2 then raise_unexplained_for Equality
with Not_found ->
- if List.exists (fun (_, t) -> t == t2) !subst then raise (Unify []);
+ if List.exists (fun (_, t) -> t == t2) !subst then
+ raise_unexplained_for Equality;
subst := (t1, t2) :: !subst
end
| (Tconstr (p1, [], _), Tconstr (p2, [], _)) when Path.same p1 p2 ->
with Not_found ->
TypePairs.add type_pairs (t1', t2') ();
match (t1'.desc, t2'.desc) with
- (Tvar _, Tvar _) when rename ->
+ | (Tvar _, Tvar _) when rename ->
begin try
normalize_subst subst;
- if List.assq t1' !subst != t2' then raise (Unify [])
+ if List.assq t1' !subst != t2' then
+ raise_unexplained_for Equality
with Not_found ->
- if List.exists (fun (_, t) -> t == t2') !subst
- then raise (Unify []);
+ if List.exists (fun (_, t) -> t == t2') !subst then
+ raise_unexplained_for Equality;
subst := (t1', t2') :: !subst
end
| (Tarrow (l1, t1, u1, _), Tarrow (l2, t2, u2, _)) when l1 = l2
| (Tconstr (p1, tl1, _), Tconstr (p2, tl2, _))
when Path.same p1 p2 ->
eqtype_list rename type_pairs subst env tl1 tl2
- | (Tpackage (p1, n1, tl1), Tpackage (p2, n2, tl2)) ->
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
unify_package env (eqtype_list rename type_pairs subst env)
- t1'.level p1 n1 tl1 t2'.level p2 n2 tl2
- with Not_found -> raise (Unify [])
+ t1'.level p1 fl1 t2'.level p2 fl2
+ with Not_found -> raise_unexplained_for Equality
end
+ | (Tnil, Tconstr _ ) ->
+ raise_for Equality (Obj (Abstract_row Second))
+ | (Tconstr _, Tnil ) ->
+ raise_for Equality (Obj (Abstract_row First))
| (Tvariant row1, Tvariant row2) ->
eqtype_row rename type_pairs subst env row1 row2
| (Tobject (fi1, _nm1), Tobject (fi2, _nm2)) ->
| (Tpoly (t1, []), Tpoly (t2, [])) ->
eqtype rename type_pairs subst env t1 t2
| (Tpoly (t1, tl1), Tpoly (t2, tl2)) ->
- enter_poly env univar_pairs t1 tl1 t2 tl2
+ enter_poly_for Equality env univar_pairs t1 tl1 t2 tl2
(eqtype rename type_pairs subst env)
| (Tunivar _, Tunivar _) ->
- unify_univar t1' t2' !univar_pairs
+ unify_univar_for Equality t1' t2' !univar_pairs
| (_, _) ->
- raise (Unify [])
+ raise_unexplained_for Equality
end
- with Unify trace -> raise ( Unify (Trace.diff t1 t2 :: trace) )
+ with Equality trace -> raise ( Equality (Errortrace.diff t1 t2 :: trace) )
and eqtype_list rename type_pairs subst env tl1 tl2 =
if List.length tl1 <> List.length tl2 then
- raise (Unify []);
+ raise_unexplained_for Equality;
List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
and eqtype_fields rename type_pairs subst env ty1 ty2 =
| _ ->
let (pairs, miss1, miss2) = associate_fields fields1 fields2 in
eqtype rename type_pairs subst env rest1 rest2;
- if (miss1 <> []) || (miss2 <> []) then raise (Unify []);
- List.iter
- (function (n, k1, t1, k2, t2) ->
- eqtype_kind k1 k2;
- try eqtype rename type_pairs subst env t1 t2 with Unify trace ->
- let e = Trace.diff
- (newty (Tfield(n, k1, t1, rest2)))
- (newty (Tfield(n, k2, t2, rest2))) in
- raise ( Unify ( e :: trace ) )
- )
- pairs
+ match miss1, miss2 with
+ | ((n, _, _)::_, _) -> raise_for Equality (Obj (Missing_field (Second, n)))
+ | (_, (n, _, _)::_) -> raise_for Equality (Obj (Missing_field (First, n)))
+ | [], [] ->
+ List.iter
+ (function (n, k1, t1, k2, t2) ->
+ eqtype_kind k1 k2;
+ try
+ eqtype rename type_pairs subst env t1 t2;
+ with Equality trace ->
+ raise (Equality (Errortrace.incompatible_fields n t1 t2 :: trace)))
+ pairs
and eqtype_kind k1 k2 =
let k1 = field_kind_repr k1 in
let k2 = field_kind_repr k2 in
match k1, k2 with
- (Fvar _, Fvar _)
+ | (Fvar _, Fvar _)
| (Fpresent, Fpresent) -> ()
- | _ -> raise (Unify [])
+ | _ -> raise_unexplained_for Equality
and eqtype_row rename type_pairs subst env row1 row2 =
(* Try expansion, needed when called from Includecore.type_manifest *)
| _ ->
let row1 = row_repr row1 and row2 = row_repr row2 in
let r1, r2, pairs = merge_row_fields row1.row_fields row2.row_fields in
- if row1.row_closed <> row2.row_closed
- || not row1.row_closed && (r1 <> [] || r2 <> [])
- || filter_row_fields false (r1 @ r2) <> []
- then raise (Unify []);
+ if row1.row_closed <> row2.row_closed then begin
+ raise_for Equality
+ (Variant (Openness (if row2.row_closed then First else Second)))
+ end;
+ if not row1.row_closed then begin
+ match r1, r2 with
+ | _::_, _ -> raise_for Equality (Variant (No_tags (Second, r1)))
+ | _, _::_ -> raise_for Equality (Variant (No_tags (First, r2)))
+ | _, _ -> ()
+ end;
+ begin
+ match filter_row_fields false r1 with
+ | [] -> ();
+ | _ :: _ as r1 -> raise_for Equality (Variant (No_tags (Second, r1)))
+ end;
+ begin
+ match filter_row_fields false r2 with
+ | [] -> ()
+ | _ :: _ as r2 -> raise_for Equality (Variant (No_tags (First, r2)))
+ end;
if not (static_row row1) then
eqtype rename type_pairs subst env row1.row_more row2.row_more;
List.iter
- (fun (_,f1,f2) ->
- match row_field_repr f1, row_field_repr f2 with
- Rpresent(Some t1), Rpresent(Some t2) ->
- eqtype rename type_pairs subst env t1 t2
- | Reither(c1, [], _, _), Reither(c2, [], _, _) when c1 = c2 ->
- ()
- | Reither(c1, t1::tl1, _, _), Reither(c2, t2::tl2, _, _) when c1 = c2 ->
- eqtype rename type_pairs subst env t1 t2;
- if List.length tl1 = List.length tl2 then
- (* if same length allow different types (meaning?) *)
- List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
- else begin
- (* otherwise everything must be equal *)
- List.iter (eqtype rename type_pairs subst env t1) tl2;
- List.iter (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
- end
- | Rpresent None, Rpresent None -> ()
- | Rabsent, Rabsent -> ()
- | _ -> raise (Unify []))
+ (fun (l,f1,f2) ->
+ try
+ match row_field_repr f1, row_field_repr f2 with
+ | Rpresent(Some t1), Rpresent(Some t2) ->
+ eqtype rename type_pairs subst env t1 t2
+ | Reither(c1, [], _, _), Reither(c2, [], _, _) when c1 = c2 -> ()
+ | Reither(c1, t1::tl1, _, _), Reither(c2, t2::tl2, _, _)
+ when c1 = c2 ->
+ eqtype rename type_pairs subst env t1 t2;
+ if List.length tl1 = List.length tl2 then
+ (* if same length allow different types (meaning?) *)
+ List.iter2 (eqtype rename type_pairs subst env) tl1 tl2
+ else begin
+ (* otherwise everything must be equal *)
+ List.iter (eqtype rename type_pairs subst env t1) tl2;
+ List.iter
+ (fun t1 -> eqtype rename type_pairs subst env t1 t2) tl1
+ end
+ | Rpresent None, Rpresent None -> ()
+ | Rabsent, Rabsent -> ()
+ | Rpresent (Some _), Rpresent None -> raise_unexplained_for Equality
+ | Rpresent None, Rpresent (Some _) -> raise_unexplained_for Equality
+ | Rpresent _, Reither _ -> raise_unexplained_for Equality
+ | Reither _, Rpresent _ -> raise_unexplained_for Equality
+ | _ -> raise_unexplained_for Equality
+ with Equality err ->
+ raise (Equality (Variant (Incompatible_types_for l):: err)))
pairs
(* Must empty univar_pairs first *)
(* Two modes: with or without renaming of variables *)
let equal env rename tyl1 tyl2 =
- try
- eqtype_list rename (TypePairs.create 11) (ref []) env tyl1 tyl2; true
- with
- Unify _ -> false
+ eqtype_list rename (TypePairs.create 11) (ref []) env tyl1 tyl2
+
+let is_equal env rename tyl1 tyl2 =
+ match equal env rename tyl1 tyl2 with
+ | () -> true
+ | exception Equality _ -> false
+let rec equal_private env params1 ty1 params2 ty2 =
+ match equal env true (params1 @ [ty1]) (params2 @ [ty2]) with
+ | () -> ()
+ | exception (Equality _ as err) ->
+ match try_expand_safe_opt env (expand_head env ty1) with
+ | ty1' -> equal_private env params1 ty1' params2 ty2
+ | exception Cannot_expand -> raise err
(*************************)
(* Class type matching *)
(*************************)
+type class_match_failure_trace_type =
+ | CM_Equality
+ | CM_Moregen
type class_match_failure =
CM_Virtual_class
| CM_Parameter_arity_mismatch of int * int
- | CM_Type_parameter_mismatch of Env.t * Unification_trace.t
+ | CM_Type_parameter_mismatch of Env.t * comparison Errortrace.t (* Equality *)
| CM_Class_type_mismatch of Env.t * class_type * class_type
- | CM_Parameter_mismatch of Env.t * Unification_trace.t
- | CM_Val_type_mismatch of string * Env.t * Unification_trace.t
- | CM_Meth_type_mismatch of string * Env.t * Unification_trace.t
+ | CM_Parameter_mismatch of Env.t * comparison Errortrace.t (* Moregen *)
+ | CM_Val_type_mismatch of
+ class_match_failure_trace_type * string * Env.t * comparison Errortrace.t
+ | CM_Meth_type_mismatch of
+ class_match_failure_trace_type * string * Env.t * comparison Errortrace.t
| CM_Non_mutable_value of string
| CM_Non_concrete_value of string
| CM_Missing_value of string
| _, Cty_constr (_, _, cty2) ->
moregen_clty true type_pairs env cty1 cty2
| Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
- begin try moregen true type_pairs env ty1 ty2 with Unify trace ->
+ begin try moregen true type_pairs env ty1 ty2 with Moregen trace ->
raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
end;
moregen_clty false type_pairs env cty1' cty2'
let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
List.iter
(fun (lab, _k1, t1, _k2, t2) ->
- begin try moregen true type_pairs env t1 t2 with Unify trace ->
- raise (Failure [CM_Meth_type_mismatch
- (lab, env, expand_trace env trace)])
- end)
- pairs;
+ try moregen true type_pairs env t1 t2 with Moregen trace ->
+ raise (Failure [
+ CM_Meth_type_mismatch
+ (CM_Moregen, lab, env, expand_trace env trace)]))
+ pairs;
Vars.iter
(fun lab (_mut, _v, ty) ->
let (_mut', _v', ty') = Vars.find lab sign1.csig_vars in
- try moregen true type_pairs env ty' ty with Unify trace ->
- raise (Failure [CM_Val_type_mismatch
- (lab, env, expand_trace env trace)]))
+ try moregen true type_pairs env ty' ty with Moregen trace ->
+ raise (Failure [
+ CM_Val_type_mismatch
+ (CM_Moregen, lab, env, expand_trace env trace)]))
sign2.csig_vars
| _ ->
raise (Failure [])
let error =
List.fold_right
(fun (lab, k1, _t1, k2, _t2) err ->
- try moregen_kind k1 k2; err with
- Unify _ -> CM_Public_method lab::err)
+ match moregen_kind k1 k2 with
+ | () -> err
+ | exception Public_method_to_private_method ->
+ CM_Public_method lab :: err)
pairs error
in
let error =
current_level := old_level;
res
-let rec equal_clty trace type_pairs subst env cty1 cty2 =
+let equal_clsig trace type_pairs subst env sign1 sign2 =
try
- match cty1, cty2 with
- Cty_constr (_, _, cty1), Cty_constr (_, _, cty2) ->
- equal_clty true type_pairs subst env cty1 cty2
- | Cty_constr (_, _, cty1), _ ->
- equal_clty true type_pairs subst env cty1 cty2
- | _, Cty_constr (_, _, cty2) ->
- equal_clty true type_pairs subst env cty1 cty2
- | Cty_arrow (l1, ty1, cty1'), Cty_arrow (l2, ty2, cty2') when l1 = l2 ->
- begin try eqtype true type_pairs subst env ty1 ty2 with Unify trace ->
- raise (Failure [CM_Parameter_mismatch (env, expand_trace env trace)])
- end;
- equal_clty false type_pairs subst env cty1' cty2'
- | Cty_signature sign1, Cty_signature sign2 ->
- let ty1 = object_fields (repr sign1.csig_self) in
- let ty2 = object_fields (repr sign2.csig_self) in
- let (fields1, _rest1) = flatten_fields ty1
- and (fields2, _rest2) = flatten_fields ty2 in
- let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
- List.iter
- (fun (lab, _k1, t1, _k2, t2) ->
- begin try eqtype true type_pairs subst env t1 t2 with
- Unify trace ->
- raise (Failure [CM_Meth_type_mismatch
- (lab, env, expand_trace env trace)])
- end)
- pairs;
- Vars.iter
- (fun lab (_, _, ty) ->
- let (_, _, ty') = Vars.find lab sign1.csig_vars in
- try eqtype true type_pairs subst env ty' ty with Unify trace ->
- raise (Failure [CM_Val_type_mismatch
- (lab, env, expand_trace env trace)]))
- sign2.csig_vars
- | _ ->
- raise
- (Failure (if trace then []
- else [CM_Class_type_mismatch (env, cty1, cty2)]))
+ let ty1 = object_fields (repr sign1.csig_self) in
+ let ty2 = object_fields (repr sign2.csig_self) in
+ let (fields1, _rest1) = flatten_fields ty1
+ and (fields2, _rest2) = flatten_fields ty2 in
+ let (pairs, _miss1, _miss2) = associate_fields fields1 fields2 in
+ List.iter
+ (fun (lab, _k1, t1, _k2, t2) ->
+ begin try eqtype true type_pairs subst env t1 t2 with
+ Equality trace ->
+ raise (Failure [CM_Meth_type_mismatch
+ (CM_Equality, lab, env, expand_trace env trace)])
+ end)
+ pairs;
+ Vars.iter
+ (fun lab (_, _, ty) ->
+ let (_, _, ty') = Vars.find lab sign1.csig_vars in
+ try eqtype true type_pairs subst env ty' ty with Equality trace ->
+ raise (Failure [CM_Val_type_mismatch
+ (CM_Equality, lab, env, expand_trace env trace)]))
+ sign2.csig_vars
with
Failure error when trace ->
- raise (Failure (CM_Class_type_mismatch (env, cty1, cty2)::error))
+ raise (Failure (CM_Class_type_mismatch
+ (env, Cty_signature sign1, Cty_signature sign2)::error))
let match_class_declarations env patt_params patt_type subj_params subj_type =
let type_pairs = TypePairs.create 53 in
if lp <> ls then
raise (Failure [CM_Parameter_arity_mismatch (lp, ls)]);
List.iter2 (fun p s ->
- try eqtype true type_pairs subst env p s with Unify trace ->
+ try eqtype true type_pairs subst env p s with Equality trace ->
raise (Failure [CM_Type_parameter_mismatch
(env, expand_trace env trace)]))
patt_params subj_params;
(* old code: equal_clty false type_pairs subst env patt_type subj_type; *)
- equal_clty false type_pairs subst env
- (Cty_signature sign1) (Cty_signature sign2);
+ equal_clsig false type_pairs subst env sign1 sign2;
(* Use moregeneral for class parameters, need to recheck everything to
keeps relationships (PR#4824) *)
let clty_params =
let pred_enlarge n = if n mod 2 = 1 then pred n else n
type change = Unchanged | Equiv | Changed
-let collect l = List.fold_left (fun c1 (_, c2) -> max c1 c2) Unchanged l
+let max_change c1 c2 =
+ match c1, c2 with
+ | _, Changed | Changed, _ -> Changed
+ | Equiv, _ | _, Equiv -> Equiv
+ | _ -> Unchanged
+
+let collect l = List.fold_left (fun c1 (_, c2) -> max_change c1 c2) Unchanged l
let rec filter_visited = function
[] -> []
let visited = t :: visited in
let (t1', c1) = build_subtype env visited loops (not posi) level t1 in
let (t2', c2) = build_subtype env visited loops posi level t2 in
- let c = max c1 c2 in
+ let c = max_change c1 c2 in
if c > Unchanged then (newty (Tarrow(l, t1', t2', Cok)), c)
else (t, Unchanged)
| Ttuple tlist ->
Tobject _ when posi && not (opened_object t') ->
let cl_abbr, body = find_cltype_for_path env p in
let ty =
- subst env !current_level Public abbrev None
- cl_abbr.type_params tl body in
+ try
+ subst env !current_level Public abbrev None
+ cl_abbr.type_params tl body
+ with Cannot_subst -> assert false in
let ty = repr ty in
let ty1, tl1 =
match ty.desc with
as this occurrence might break the occur check.
XXX not clear whether this correct anyway... *)
if List.exists (deep_occur ty) tl1 then raise Not_found;
- ty.desc <- Tvar None;
+ set_type_desc ty (Tvar None);
let t'' = newvar () in
let loops = (ty, t'') :: loops in
(* May discard [visited] as level is going down *)
assert (is_Tvar t'');
let nm =
if c > Equiv || deep_occur ty ty1' then None else Some(p,tl1) in
- t''.desc <- Tobject (ty1', ref nm);
+ set_type_desc t'' (Tobject (ty1', ref nm));
(try unify_var env ty t with Unify _ -> assert false);
(t'', Changed)
| _ -> raise Not_found
| Tfield(s, _, t1, t2) (* Always present *) ->
let (t1', c1) = build_subtype env visited loops posi level t1 in
let (t2', c2) = build_subtype env visited loops posi level t2 in
- let c = max c1 c2 in
+ let c = max_change c1 c2 in
if c > Unchanged then (newty (Tfield(s, Fpresent, t1', t2')), c)
else (t, Unchanged)
| Tnil ->
let subtypes = TypePairs.create 17
let subtype_error env trace =
- raise (Subtype (expand_trace env (List.rev trace), []))
+ raise (Subtype (expand_subtype_trace env (List.rev trace), []))
let rec subtype_rec env trace t1 t2 cstrs =
let t1 = repr t1 in
(trace, t1, t2, !univar_pairs)::cstrs
| (Tarrow(l1, t1, u1, _), Tarrow(l2, t2, u2, _)) when l1 = l2
|| !Clflags.classic && not (is_optional l1 || is_optional l2) ->
- let cstrs = subtype_rec env (Trace.diff t2 t1::trace) t2 t1 cstrs in
- subtype_rec env (Trace.diff u1 u2::trace) u1 u2 cstrs
+ let cstrs = subtype_rec env (Subtype.diff t2 t1::trace) t2 t1 cstrs in
+ subtype_rec env (Subtype.diff u1 u2::trace) u1 u2 cstrs
| (Ttuple tl1, Ttuple tl2) ->
subtype_list env trace tl1 tl2 cstrs
| (Tconstr(p1, [], _), Tconstr(p2, [], _)) when Path.same p1 p2 ->
if cn then
(trace, newty2 t1.level (Ttuple[t1]),
newty2 t2.level (Ttuple[t2]), !univar_pairs) :: cstrs
- else subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+ else subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
else
- if cn then subtype_rec env (Trace.diff t2 t1::trace) t2 t1 cstrs
+ if cn
+ then subtype_rec env (Subtype.diff t2 t1::trace) t2 t1 cstrs
else cstrs)
cstrs decl.type_variance (List.combine tl1 tl2)
with Not_found ->
(trace, t1, t2, !univar_pairs)::cstrs
end
- | (Tconstr(p1, _, _), _) when generic_private_abbrev env p1 ->
+ | (Tconstr(p1, _, _), _)
+ when generic_private_abbrev env p1 && safe_abbrev_opt env t1 ->
subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
(* | (_, Tconstr(p2, _, _)) when generic_private_abbrev false env p2 ->
subtype_rec env trace t1 (expand_abbrev_opt env t2) cstrs *)
begin try
enter_poly env univar_pairs u1 tl1 u2 tl2
(fun t1 t2 -> subtype_rec env trace t1 t2 cstrs)
- with Unify _ ->
+ with Escape _ ->
(trace, t1, t2, !univar_pairs)::cstrs
end
- | (Tpackage (p1, nl1, tl1), Tpackage (p2, nl2, tl2)) ->
+ | (Tpackage (p1, fl1), Tpackage (p2, fl2)) ->
begin try
- let ntl1 = complete_type_list env nl2 t1.level (Mty_ident p1) nl1 tl1
- and ntl2 = complete_type_list env nl1 t2.level (Mty_ident p2) nl2 tl2
+ let ntl1 = complete_type_list env fl2 t1.level (Mty_ident p1) fl1
+ and ntl2 = complete_type_list env fl1 t2.level (Mty_ident p2) fl2
~allow_absent:true in
let cstrs' =
List.map
else begin
(* need to check module subtyping *)
let snap = Btype.snapshot () in
- try
- List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs';
- if !package_subtype env p1 nl1 tl1 p2 nl2 tl2
- then (Btype.backtrack snap; cstrs' @ cstrs)
- else raise (Unify [])
- with Unify _ ->
+ match List.iter (fun (_, t1, t2, _) -> unify env t1 t2) cstrs' with
+ | () when !package_subtype env p1 fl1 p2 fl2 ->
+ Btype.backtrack snap; cstrs' @ cstrs
+ | () | exception Unify _ ->
Btype.backtrack snap; raise Not_found
end
with Not_found ->
if List.length tl1 <> List.length tl2 then
subtype_error env trace;
List.fold_left2
- (fun cstrs t1 t2 -> subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs)
+ (fun cstrs t1 t2 -> subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs)
cstrs tl1 tl2
and subtype_fields env trace ty1 ty2 cstrs =
let cstrs =
if rest2.desc = Tnil then cstrs else
if miss1 = [] then
- subtype_rec env (Trace.diff rest1 rest2::trace) rest1 rest2 cstrs
+ subtype_rec env (Subtype.diff rest1 rest2::trace) rest1 rest2 cstrs
else
(trace, build_fields (repr ty1).level miss1 rest1, rest2,
!univar_pairs) :: cstrs
List.fold_left
(fun cstrs (_, _k1, t1, _k2, t2) ->
(* These fields are always present *)
- subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs)
+ subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs)
cstrs pairs
and subtype_row env trace row1 row2 cstrs =
and more2 = repr row2.row_more in
match more1.desc, more2.desc with
Tconstr(p1,_,_), Tconstr(p2,_,_) when Path.same p1 p2 ->
- subtype_rec env (Trace.diff more1 more2::trace) more1 more2 cstrs
+ subtype_rec env (Subtype.diff more1 more2::trace) more1 more2 cstrs
| (Tvar _|Tconstr _|Tnil), (Tvar _|Tconstr _|Tnil)
when row1.row_closed && r1 = [] ->
List.fold_left
(Rpresent None|Reither(true,_,_,_)), Rpresent None ->
cstrs
| Rpresent(Some t1), Rpresent(Some t2) ->
- subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+ subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
| Reither(false, t1::_, _, _), Rpresent(Some t2) ->
- subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+ subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
| Rabsent, _ -> cstrs
| _ -> raise Exit)
cstrs pairs
| Tunivar _, Tunivar _
when row1.row_closed = row2.row_closed && r1 = [] && r2 = [] ->
let cstrs =
- subtype_rec env (Trace.diff more1 more2::trace) more1 more2 cstrs in
+ subtype_rec env (Subtype.diff more1 more2::trace) more1 more2 cstrs in
List.fold_left
(fun cstrs (_,f1,f2) ->
match row_field_repr f1, row_field_repr f2 with
cstrs
| Rpresent(Some t1), Rpresent(Some t2)
| Reither(false,[t1],_,_), Reither(false,[t2],_,_) ->
- subtype_rec env (Trace.diff t1 t2::trace) t1 t2 cstrs
+ subtype_rec env (Subtype.diff t1 t2::trace) t1 t2 cstrs
| _ -> raise Exit)
cstrs pairs
| _ ->
TypePairs.clear subtypes;
univar_pairs := [];
(* Build constraint set. *)
- let cstrs = subtype_rec env [Trace.diff ty1 ty2] ty1 ty2 [] in
+ let cstrs = subtype_rec env [Subtype.diff ty1 ty2] ty1 ty2 [] in
TypePairs.clear subtypes;
(* Enforce constraints. *)
function () ->
List.iter
(function (trace0, t1, t2, pairs) ->
try unify_pairs (ref env) t1 t2 pairs with Unify trace ->
- raise (Subtype (expand_trace env (List.rev trace0),
+ raise (Subtype (expand_subtype_trace env (List.rev trace0),
List.tl trace)))
(List.rev cstrs)
Tarrow(_, _t1, t2, _) -> 1 + arity t2
| _ -> 0
-(* Check whether an abbreviation expands to itself. *)
-let cyclic_abbrev env id ty =
- let rec check_cycle seen ty =
- let ty = repr ty in
- match ty.desc with
- Tconstr (p, _tl, _abbrev) ->
- p = Path.Pident id || List.memq ty seen ||
- begin try
- check_cycle (ty :: seen) (expand_abbrev_opt env ty)
- with
- Cannot_expand -> false
- | Unify _ -> true
- end
- | _ ->
- false
- in check_cycle [] ty
-
(* Check for non-generalizable type variables *)
exception Non_closed0
let visited = ref TypeSet.empty
List.fold_left
(fun tyl ty ->
if List.exists
- (fun ty' -> equal Env.empty false [ty] [ty']) tyl
- then tyl else ty::tyl)
+ (fun ty' ->
+ match equal Env.empty false [ty] [ty'] with
+ | () -> true
+ | exception Equality _ -> false)
+ tyl
+ then tyl else ty::tyl)
[ty] tyl
in
if f != f0 || List.length tyl' < List.length tyl then
TypeHash.clear nondep_hash; TypeHash.clear nondep_variants
let rec nondep_type_rec ?(expand_private=false) env ids ty =
- let expand_abbrev env t =
- if expand_private then expand_abbrev_opt env t else expand_abbrev env t
+ let try_expand env t =
+ if expand_private then try_expand_safe_opt env t
+ else try_expand_safe env t
in
match ty.desc with
Tvar _ | Tunivar _ -> ty
with Not_found ->
let ty' = newgenvar () in (* Stub *)
TypeHash.add nondep_hash ty ty';
- ty'.desc <-
+ set_type_desc ty'
begin match ty.desc with
| Tconstr(p, tl, _abbrev) ->
- begin match Path.find_free_opt ids p with
- | Some id ->
- begin try
- Tlink (nondep_type_rec ~expand_private env ids
- (expand_abbrev env (newty2 ty.level ty.desc)))
- (*
- The [Tlink] is important. The expanded type may be a
- variable, or may not be completely copied yet
- (recursive type), so one cannot just take its
- description.
- *)
- with Cannot_expand | Unify _ ->
- raise (Nondep_cannot_erase id)
- end
- | None ->
- Tconstr(p, List.map (nondep_type_rec env ids) tl, ref Mnil)
+ begin try
+ (* First, try keeping the same type constructor p *)
+ match Path.find_free_opt ids p with
+ | Some id ->
+ raise (Nondep_cannot_erase id)
+ | None ->
+ Tconstr(p, List.map (nondep_type_rec env ids) tl, ref Mnil)
+ with (Nondep_cannot_erase _) as exn ->
+ (* If that doesn't work, try expanding abbrevs *)
+ try Tlink (nondep_type_rec ~expand_private env ids
+ (try_expand env (newty2 ty.level ty.desc)))
+ (*
+ The [Tlink] is important. The expanded type may be a
+ variable, or may not be completely copied yet
+ (recursive type), so one cannot just take its
+ description.
+ *)
+ with Cannot_expand -> raise exn
end
- | Tpackage(p, nl, tl) when Path.exists_free ids p ->
+ | Tpackage(p, fl) when Path.exists_free ids p ->
let p' = normalize_package_path env p in
begin match Path.find_free_opt ids p' with
| Some id -> raise (Nondep_cannot_erase id)
- | None -> Tpackage (p', nl, List.map (nondep_type_rec env ids) tl)
+ | None ->
+ let nondep_field_rec (n, ty) = (n, nondep_type_rec env ids ty) in
+ Tpackage (p', List.map nondep_field_rec fl)
end
| Tobject (t1, name) ->
Tobject (nondep_type_rec env ids t1,
(* Register new type first for recursion *)
TypeHash.add nondep_variants more ty';
let static = static_row row in
- let more' = if static then newgenty Tnil else more in
+ let more' =
+ if static then newgenty Tnil else nondep_type_rec env ids more
+ in
(* Return a new copy *)
let row =
copy_row (nondep_type_rec env ids) true row true more' in
type_loc = decl.type_loc;
type_attributes = decl.type_attributes;
type_immediate = decl.type_immediate;
- type_unboxed = decl.type_unboxed;
+ type_unboxed_default = decl.type_unboxed_default;
type_uid = decl.type_uid;
}
with Nondep_cannot_erase _ as exn ->
module TypePairs : Hashtbl.S with type key = type_expr * type_expr
-module Unification_trace: sig
- (** Unification traces are used to explain unification errors
- when printing error messages *)
-
- type position = First | Second
- type desc = { t: type_expr; expanded: type_expr option }
- type 'a diff = { got: 'a; expected: 'a}
-
- (** Scope escape related errors *)
- type 'a escape =
- | Constructor of Path.t
- | Univ of type_expr
- (** The type_expr argument of [Univ] is always a [Tunivar _],
- we keep a [type_expr] to track renaming in {!Printtyp} *)
- | Self
- | Module_type of Path.t
- | Equation of 'a
-
- (** Errors for polymorphic variants *)
-
- type fixed_row_case =
- | Cannot_be_closed
- | Cannot_add_tags of string list
-
- type variant =
- | No_intersection
- | No_tags of position * (Asttypes.label * row_field) list
- | Incompatible_types_for of string
- | Fixed_row of position * fixed_row_case * fixed_explanation
- (** Fixed row types, e.g. ['a. [> `X] as 'a] *)
-
- type obj =
- | Missing_field of position * string
- | Abstract_row of position
- | Self_cannot_be_closed
-
- type 'a elt =
- | Diff of 'a diff
- | Variant of variant
- | Obj of obj
- | Escape of {context: type_expr option; kind:'a escape}
- | Incompatible_fields of {name:string; diff: type_expr diff }
- | Rec_occur of type_expr * type_expr
-
- type t = desc elt list
-
- val diff: type_expr -> type_expr -> desc elt
-
- (** [map_diff f {expected;got}] is [{expected=f expected; got=f got}] *)
- val map_diff: ('a -> 'b) -> 'a diff -> 'b diff
-
- (** [flatten f trace] flattens all elements of type {!desc} in
- [trace] to either [f x.t expanded] if [x.expanded=Some expanded]
- or [f x.t x.t] otherwise *)
- val flatten: (type_expr -> type_expr -> 'a) -> t -> 'a elt list
-
- (** Switch [expected] and [got] *)
- val swap: t -> t
-
- (** [explain trace f] calls [f] on trace elements starting from the end
- until [f ~prev elt] is [Some _], returns that
- or [None] if the end of the trace is reached. *)
- val explain:
- 'a elt list ->
- (prev:'a elt option -> 'a elt -> 'b option) ->
- 'b option
-
-end
-
-exception Unify of Unification_trace.t
+exception Unify of Errortrace.unification Errortrace.t
+exception Equality of Errortrace.comparison Errortrace.t
+exception Moregen of Errortrace.comparison Errortrace.t
+exception Subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
+exception Escape of Errortrace.desc Errortrace.escape
+
exception Tags of label * label
-exception Subtype of Unification_trace.t * Unification_trace.t
exception Cannot_expand
exception Cannot_apply
+exception Matches_failure of Env.t * Errortrace.unification Errortrace.t
+ (* Raised from [matches], hence the odd name *)
+exception Incompatible
+ (* Raised from [mcomp] *)
val init_def: int -> unit
(* Set the initial variable level *)
(* Lower level of type variables inside contravariant branches;
to be used before generalize for expansive expressions *)
val generalize_structure: type_expr -> unit
- (* Same, but variables are only lowered to !current_level *)
+ (* Generalize the structure of a type, lowering variables
+ to !current_level *)
val generalize_spine: type_expr -> unit
(* Special function to generalize a method during inference *)
val correct_levels: type_expr -> type_expr
val check_scope_escape : Env.t -> int -> type_expr -> unit
(* [check_scope_escape env lvl ty] ensures that [ty] could be raised
to the level [lvl] without any scope escape.
- Raises [Unify] otherwise *)
+ Raises [Escape] otherwise *)
val instance: ?partial:bool -> type_expr -> type_expr
(* Take an instance of a type scheme *)
(* Same as instance, but new nodes at generic_level *)
val instance_list: type_expr list -> type_expr list
(* Take an instance of a list of type schemes *)
+val new_local_type:
+ ?loc:Location.t ->
+ ?manifest_and_scope:(type_expr * int) -> unit -> type_declaration
val existential_name: constructor_description -> type_expr -> string
val instance_constructor:
?in_pattern:Env.t ref * int ->
- constructor_description -> type_expr list * type_expr
- (* Same, for a constructor *)
+ constructor_description -> type_expr list * type_expr * type_expr list
+ (* Same, for a constructor. Also returns existentials. *)
val instance_parameterized_type:
?keep_names:bool ->
type_expr list -> type_expr -> type_expr list * type_expr
the parameters [pi] and returns the corresponding instance of
[t]. Exception [Cannot_apply] is raised in case of failure. *)
+val try_expand_once_opt: Env.t -> type_expr -> type_expr
+val try_expand_safe_opt: Env.t -> type_expr -> type_expr
+
val expand_head_once: Env.t -> type_expr -> type_expr
val expand_head: Env.t -> type_expr -> type_expr
-val try_expand_once_opt: Env.t -> type_expr -> type_expr
val expand_head_opt: Env.t -> type_expr -> type_expr
(** The compiler's own version of [expand_head] necessary for type-based
optimisations. *)
-val full_expand: Env.t -> type_expr -> type_expr
+val full_expand: may_forget_scope:bool -> Env.t -> type_expr -> type_expr
val extract_concrete_typedecl:
Env.t -> type_expr -> Path.t * Path.t * type_declaration
(* Return the original path of the types, and the first concrete
type declaration found expanding it.
Raise [Not_found] if none appears or not a type constructor. *)
-val enforce_constraints: Env.t -> type_expr -> unit
-
val unify: Env.t -> type_expr -> type_expr -> unit
(* Unify the two types given. Raise [Unify] if not possible. *)
val unify_gadt:
val filter_self_method:
Env.t -> string -> private_flag -> (Ident.t * type_expr) Meths.t ref ->
type_expr -> Ident.t * type_expr
-val moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
+val moregeneral: Env.t -> bool -> type_expr -> type_expr -> unit
(* Check if the first type scheme is more general than the second. *)
-
+val is_moregeneral: Env.t -> bool -> type_expr -> type_expr -> bool
val rigidify: type_expr -> type_expr list
(* "Rigidify" a type and return its type variable *)
val all_distinct_vars: Env.t -> type_expr list -> bool
(* Check those types are all distinct type variables *)
-val matches: Env.t -> type_expr -> type_expr -> bool
+val matches: Env.t -> type_expr -> type_expr -> unit
(* Same as [moregeneral false], implemented using the two above
functions and backtracking. Ignore levels *)
+val does_match: Env.t -> type_expr -> type_expr -> bool
+ (* Same as [matches], but returns a [bool] *)
val reify_univars : Env.t -> Types.type_expr -> Types.type_expr
(* Replaces all the variables of a type by a univar. *)
+type class_match_failure_trace_type =
+ | CM_Equality
+ | CM_Moregen
+
type class_match_failure =
CM_Virtual_class
| CM_Parameter_arity_mismatch of int * int
- | CM_Type_parameter_mismatch of Env.t * Unification_trace.t
+ | CM_Type_parameter_mismatch of Env.t * Errortrace.comparison Errortrace.t
| CM_Class_type_mismatch of Env.t * class_type * class_type
- | CM_Parameter_mismatch of Env.t * Unification_trace.t
- | CM_Val_type_mismatch of string * Env.t * Unification_trace.t
- | CM_Meth_type_mismatch of string * Env.t * Unification_trace.t
+ | CM_Parameter_mismatch of Env.t * Errortrace.comparison Errortrace.t
+ | CM_Val_type_mismatch of
+ class_match_failure_trace_type *
+ string * Env.t * Errortrace.comparison Errortrace.t
+ | CM_Meth_type_mismatch of
+ class_match_failure_trace_type *
+ string * Env.t * Errortrace.comparison Errortrace.t
| CM_Non_mutable_value of string
| CM_Non_concrete_value of string
| CM_Missing_value of string
val match_class_types:
?trace:bool -> Env.t -> class_type -> class_type -> class_match_failure list
(* Check if the first class type is more general than the second. *)
-val equal: Env.t -> bool -> type_expr list -> type_expr list -> bool
+val equal: Env.t -> bool -> type_expr list -> type_expr list -> unit
(* [equal env [x1...xn] tau [y1...yn] sigma]
checks whether the parameterized types
[/\x1.../\xn.tau] and [/\y1.../\yn.sigma] are equivalent. *)
+val is_equal : Env.t -> bool -> type_expr list -> type_expr list -> bool
+val equal_private :
+ Env.t -> type_expr list -> type_expr ->
+ type_expr list -> type_expr -> unit
+(* [equal_private env t1 params1 t2 params2] checks that [t1::params1]
+ equals [t2::params2] but it is allowed to expand [t1] if it is a
+ private abbreviations. *)
+
val match_class_declarations:
Env.t -> type_expr list -> class_type -> type_expr list ->
class_type -> class_match_failure list
Env.t -> Ident.t list -> class_type_declaration -> class_type_declaration
(* Same for class type declarations. *)
(*val correct_abbrev: Env.t -> Path.t -> type_expr list -> type_expr -> unit*)
-val cyclic_abbrev: Env.t -> Ident.t -> type_expr -> bool
val is_contractive: Env.t -> Path.t -> bool
val normalize_type: type_expr -> unit
(* Stubs *)
val package_subtype :
- (Env.t -> Path.t -> Longident.t list -> type_expr list ->
- Path.t -> Longident.t list -> type_expr list -> bool) ref
+ (Env.t -> Path.t -> (Longident.t * type_expr) list ->
+ Path.t -> (Longident.t * type_expr) list -> bool) ref
+(* Raises [Incompatible] *)
val mcomp : Env.t -> type_expr -> type_expr -> unit
let ret = ref TypeSet.empty in
let rec loop ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
- ty.level <- pivot_level - ty.level;
+ if try_mark_node ty then
match ty.desc with
| Tvar _ ->
ret := TypeSet.add ty !ret
(* XXX: What about Tobject ? *)
| _ ->
iter_type_expr loop ty
- end
in
loop ty;
unmark_type ty;
| Cstr_record lbls ->
let arg_vars_set = free_vars ~param:true (newgenty (Ttuple tyl)) in
let type_params = TypeSet.elements arg_vars_set in
- let type_unboxed =
- match rep with
- | Record_unboxed _ -> unboxed_true_default_false
- | _ -> unboxed_false_default_false
- in
let arity = List.length type_params in
let tdecl =
{
type_loc = Location.none;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed;
+ type_unboxed_default = false;
type_uid = Uid.mk ~current_unit;
}
in
[ newgenconstr path type_params ],
Some tdecl
-let constructor_descrs ~current_unit ty_path decl cstrs =
+let constructor_descrs ~current_unit ty_path decl cstrs rep =
let ty_res = newgenconstr ty_path decl.type_params in
let num_consts = ref 0 and num_nonconsts = ref 0 and num_normal = ref 0 in
List.iter
| None -> ty_res
in
let (tag, descr_rem) =
- match cd_args with
- | _ when decl.type_unboxed.unboxed ->
+ match cd_args, rep with
+ | _, Variant_unboxed ->
assert (rem = []);
(Cstr_unboxed, [])
- | Cstr_tuple [] -> (Cstr_constant idx_const,
- describe_constructors (idx_const+1) idx_nonconst rem)
- | _ -> (Cstr_block idx_nonconst,
- describe_constructors idx_const (idx_nonconst+1) rem) in
+ | Cstr_tuple [], Variant_regular ->
+ (Cstr_constant idx_const,
+ describe_constructors (idx_const+1) idx_nonconst rem)
+ | _, Variant_regular ->
+ (Cstr_block idx_nonconst,
+ describe_constructors idx_const (idx_nonconst+1) rem) in
let cstr_name = Ident.name cd_id in
let existentials, cstr_args, cstr_inlined =
let representation =
- if decl.type_unboxed.unboxed
- then Record_unboxed true
- else Record_inlined idx_nonconst
+ match rep with
+ | Variant_unboxed -> Record_unboxed true
+ | Variant_regular -> Record_inlined idx_nonconst
in
constructor_args ~current_unit decl.type_private cd_args cd_res
(Path.Pdot (ty_path, cstr_name)) representation
cstr_uid = ext.ext_uid;
}
-let none = {desc = Ttuple []; level = -1; scope = Btype.generic_level; id = -1}
+let none = Private_type_expr.create (Ttuple [])
+ ~level:(-1) ~scope:Btype.generic_level ~id:(-1)
(* Clearly ill-formed type *)
let dummy_label =
{ lbl_name = ""; lbl_res = none; lbl_arg = none; lbl_mut = Immutable;
let constructors_of_type ~current_unit ty_path decl =
match decl.type_kind with
- | Type_variant cstrs -> constructor_descrs ~current_unit ty_path decl cstrs
+ | Type_variant (cstrs,rep) ->
+ constructor_descrs ~current_unit ty_path decl cstrs rep
| Type_record _ | Type_abstract | Type_open -> []
let labels_of_type ty_path decl =
label_descrs (newgenconstr ty_path decl.type_params)
labels rep decl.type_private
| Type_variant _ | Type_abstract | Type_open -> []
-
-(* Set row_name in Env, cf. GPR#1204/1329 *)
-let set_row_name decl path =
- match decl.type_manifest with
- None -> ()
- | Some ty ->
- let ty = repr ty in
- match ty.desc with
- Tvariant row when static_row row ->
- let row = {(row_repr row) with
- row_name = Some (path, decl.type_params)} in
- ty.desc <- Tvariant row
- | _ -> ()
- the types of the constructor's arguments
- the existential variables introduced by the constructor
*)
-
-
-(* Set the polymorphic variant row_name field *)
-val set_row_name : type_declaration -> Path.t -> unit
let type_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
let module_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16
-type constructor_usage = Positive | Pattern | Privatize
+type constructor_usage = Positive | Pattern | Exported_private | Exported
type constructor_usages =
- {
- mutable cu_positive: bool;
- mutable cu_pattern: bool;
- mutable cu_privatize: bool;
- }
-let add_constructor_usage ~rebind priv cu usage =
- let private_or_rebind =
- match priv with
- | Asttypes.Private -> true
- | Asttypes.Public -> rebind
- in
- if private_or_rebind then begin
- cu.cu_positive <- true
- end else begin
- match usage with
- | Positive -> cu.cu_positive <- true
- | Pattern -> cu.cu_pattern <- true
- | Privatize -> cu.cu_privatize <- true
- end
+ {
+ mutable cu_positive: bool;
+ mutable cu_pattern: bool;
+ mutable cu_exported_private: bool;
+ }
+let add_constructor_usage cu usage =
+ match usage with
+ | Positive -> cu.cu_positive <- true
+ | Pattern -> cu.cu_pattern <- true
+ | Exported_private -> cu.cu_exported_private <- true
+ | Exported ->
+ cu.cu_positive <- true;
+ cu.cu_pattern <- true;
+ cu.cu_exported_private <- true
let constructor_usages () =
- {cu_positive = false; cu_pattern = false; cu_privatize = false}
+ {cu_positive = false; cu_pattern = false; cu_exported_private = false}
+
+let constructor_usage_complaint ~rebind priv cu
+ : Warnings.constructor_usage_warning option =
+ match priv, rebind with
+ | Asttypes.Private, _ | _, true ->
+ if cu.cu_positive || cu.cu_pattern || cu.cu_exported_private then None
+ else Some Unused
+ | Asttypes.Public, false -> begin
+ match cu.cu_positive, cu.cu_pattern, cu.cu_exported_private with
+ | true, _, _ -> None
+ | false, false, false -> Some Unused
+ | false, true, _ -> Some Not_constructed
+ | false, false, true -> Some Only_exported_private
+ end
let used_constructors : constructor_usage usage_tbl ref =
s_table Types.Uid.Tbl.create 16
+type label_usage =
+ Projection | Mutation | Construct | Exported_private | Exported
+type label_usages =
+ {
+ mutable lu_projection: bool;
+ mutable lu_mutation: bool;
+ mutable lu_construct: bool;
+ }
+let add_label_usage lu usage =
+ match usage with
+ | Projection -> lu.lu_projection <- true;
+ | Mutation -> lu.lu_mutation <- true
+ | Construct -> lu.lu_construct <- true
+ | Exported_private ->
+ lu.lu_projection <- true
+ | Exported ->
+ lu.lu_projection <- true;
+ lu.lu_mutation <- true;
+ lu.lu_construct <- true
+
+let label_usages () =
+ {lu_projection = false; lu_mutation = false; lu_construct = false}
+
+let label_usage_complaint priv mut lu
+ : Warnings.field_usage_warning option =
+ match priv, mut with
+ | Asttypes.Private, _ ->
+ if lu.lu_projection then None
+ else Some Unused
+ | Asttypes.Public, Asttypes.Immutable -> begin
+ match lu.lu_projection, lu.lu_construct with
+ | true, _ -> None
+ | false, false -> Some Unused
+ | false, true -> Some Not_read
+ end
+ | Asttypes.Public, Asttypes.Mutable -> begin
+ match lu.lu_projection, lu.lu_mutation, lu.lu_construct with
+ | true, true, _ -> None
+ | false, false, false -> Some Unused
+ | false, _, _ -> Some Not_read
+ | true, false, _ -> Some Not_mutated
+ end
+
+let used_labels : label_usage usage_tbl ref =
+ s_table Types.Uid.Tbl.create 16
+
(** Map indexed by the name of module components. *)
module NameMap = String.Map
| Env_value_unbound of summary * string * value_unbound_reason
| Env_module_unbound of summary * string * module_unbound_reason
+let map_summary f = function
+ Env_empty -> Env_empty
+ | Env_value (s, id, d) -> Env_value (f s, id, d)
+ | Env_type (s, id, d) -> Env_type (f s, id, d)
+ | Env_extension (s, id, d) -> Env_extension (f s, id, d)
+ | Env_module (s, id, p, d) -> Env_module (f s, id, p, d)
+ | Env_modtype (s, id, d) -> Env_modtype (f s, id, d)
+ | Env_class (s, id, d) -> Env_class (f s, id, d)
+ | Env_cltype (s, id, d) -> Env_cltype (f s, id, d)
+ | Env_open (s, p) -> Env_open (f s, p)
+ | Env_functor_arg (s, id) -> Env_functor_arg (f s, id)
+ | Env_constraints (s, m) -> Env_constraints (f s, m)
+ | Env_copy_types s -> Env_copy_types (f s)
+ | Env_persistent (s, id) -> Env_persistent (f s, id)
+ | Env_value_unbound (s, u, r) -> Env_value_unbound (f s, u, r)
+ | Env_module_unbound (s, u, r) -> Env_module_unbound (f s, u, r)
+
type address =
| Aident of Ident.t
| Adot of address * int
bindings for each name, as in comp_labels and
comp_constrs. *)
+ root: Path.t;
+ (** Only used to check removal of open *)
+
using: (string -> ('a * 'a) option -> unit) option;
(** A callback to be applied when a component is used from this
"open". This is used to detect unused "opens". The
let add id x tbl =
{tbl with current = Ident.add id x tbl.current}
- let add_open slot wrap components next =
+ let add_open slot wrap root components next =
let using =
match slot with
| None -> None
in
{
current = Ident.empty;
- opened = Some {using; components; next};
+ opened = Some {using; components; root; next};
}
+ let remove_last_open rt tbl =
+ match tbl.opened with
+ | Some {root; next; _} when Path.same rt root ->
+ { next with current =
+ Ident.fold_all Ident.add tbl.current next.current }
+ | _ ->
+ assert false
+
let rec find_same id tbl =
try Ident.find_same id tbl.current
with Not_found as exn ->
(Ident.find_all name tbl.current) @
match tbl.opened with
| None -> []
- | Some {using; next; components} ->
+ | Some {using; next; components; root = _} ->
let rest = find_all ~mark name next in
let using = if mark then using else None in
match NameMap.find name components with
let rec fold_name f tbl acc =
let acc = Ident.fold_name (fun _id d -> f d) tbl.current acc in
match tbl.opened with
- | Some {using = _; next; components} ->
+ | Some {using = _; next; components; root = _} ->
acc
|> NameMap.fold
(fun _name -> List.fold_right f)
layer = Open {using; root; components; next};
}
+ let remove_last_open rt tbl =
+ match tbl.layer with
+ | Open {root; next; _} when Path.same rt root ->
+ { next with current =
+ Ident.fold_all Ident.add tbl.current next.current }
+ | _ ->
+ assert false
+
let map f next =
{
current = Ident.empty;
end
-type type_descriptions =
- constructor_description list * label_description list
+type type_descr_kind =
+ (label_description, constructor_description) type_kind
+
+type type_descriptions = type_descr_kind
let in_signature_flag = 0x01
}
and module_declaration_lazy =
- (Subst.t * Subst.scoping * module_declaration, module_declaration) EnvLazy.t
+ (Subst.t * Subst.scoping * module_declaration, module_declaration)
+ Lazy_backtrack.t
and module_components =
{
comps:
(components_maker,
(module_components_repr, module_components_failure) result)
- EnvLazy.t;
+ Lazy_backtrack.t;
}
and components_maker = {
| Projection of { parent : address_lazy; pos : int; }
| ModAlias of { env : t; path : Path.t; }
-and address_lazy = (address_unforced, address) EnvLazy.t
+and address_lazy = (address_unforced, address) Lazy_backtrack.t
and value_data =
{ vda_description : value_description;
let lookup_error loc env err =
error (Lookup_error(loc, env, err))
-let copy_local ~from env =
- { env with
- local_constraints = from.local_constraints;
- flags = from.flags }
-
let same_constr = ref (fun _ _ _ -> assert false)
let check_well_formed_module = ref (fun _ -> assert false)
(module_components_repr, module_components_failure) result)
let components_of_functor_appl' =
- ref ((fun ~loc:_ _f _env _p1 _p2 -> assert false) :
- loc:Location.t -> functor_components -> t ->
- Path.t -> Path.t -> module_components)
+ ref ((fun ~loc:_ ~f_path:_ ~f_comp:_ ~arg:_ _env -> assert false) :
+ loc:Location.t -> f_path:Path.t -> f_comp:functor_components ->
+ arg:Path.t -> t -> module_components)
let check_functor_application =
(* to be filled by Includemod *)
- ref ((fun ~errors:_ ~loc:_ _env _mty1 _path1 _mty2 _path2 -> assert false) :
- errors:bool -> loc:Location.t -> t -> module_type ->
- Path.t -> module_type -> Path.t -> unit)
+ ref ((fun ~errors:_ ~loc:_
+ ~lid_whole_app:_ ~f0_path:_ ~args:_
+ ~arg_path:_ ~arg_mty:_ ~param_mty:_
+ _env
+ -> assert false) :
+ errors:bool -> loc:Location.t ->
+ lid_whole_app:Longident.t ->
+ f0_path:Path.t -> args:(Path.t * Types.module_type) list ->
+ arg_path:Path.t -> arg_mty:module_type -> param_mty:module_type ->
+ t -> unit)
let strengthen =
(* to be filled with Mtype.strengthen *)
ref ((fun ~aliasable:_ _env _mty _path -> assert false) :
{
alerts;
uid;
- comps = EnvLazy.create {
+ comps = Lazy_backtrack.create {
cm_env = env;
cm_freshening_subst = fs;
cm_prefixing_subst = ps;
md_uid = Uid.of_compilation_unit_id id;
}
in
- let mda_address = EnvLazy.create_forced (Aident id) in
+ let mda_address = Lazy_backtrack.create_forced (Aident id) in
let mda_declaration =
- EnvLazy.create (Subst.identity, Subst.Make_local, md)
+ Lazy_backtrack.create (Subst.identity, Subst.Make_local, md)
in
let mda_components =
let freshening_subst =
Types.Uid.Tbl.clear !type_declarations;
Types.Uid.Tbl.clear !module_declarations;
Types.Uid.Tbl.clear !used_constructors;
+ Types.Uid.Tbl.clear !used_labels;
()
let reset_cache () =
let get_components_res c =
match Persistent_env.can_load_cmis !persistent_env with
| Persistent_env.Can_load_cmis ->
- EnvLazy.force !components_of_module_maker' c.comps
+ Lazy_backtrack.force !components_of_module_maker' c.comps
| Persistent_env.Cannot_load_cmis log ->
- EnvLazy.force_logged log !components_of_module_maker' c.comps
+ Lazy_backtrack.force_logged log !components_of_module_maker' c.comps
let get_components c =
match get_components_res c with
Hashtbl.add fcomp.fcomp_subst_cache p2 mty;
mty
-let check_functor_appl ~errors ~loc env p1 f arg p2 md =
- if not (Hashtbl.mem f.fcomp_cache p2) then
- !check_functor_application ~errors ~loc env md.md_type p2 arg p1
+let check_functor_appl
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~f_comp
+ ~arg_path ~arg_mty ~param_mty
+ env =
+ if not (Hashtbl.mem f_comp.fcomp_cache arg_path) then
+ !check_functor_application
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~arg_path ~arg_mty ~param_mty
+ env
(* Lookup by identifier *)
| Pdot(p, s) ->
let sc = find_structure_components p env in
(NameMap.find s sc.comp_modules).mda_components
- | Papply(p1, p2) ->
- let fc = find_functor_components p1 env in
+ | Papply(f_path, arg) ->
+ let f_comp = find_functor_components f_path env in
let loc = Location.(in_file !input_name) in
- !components_of_functor_appl' ~loc fc env p1 p2
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg env
and find_structure_components path env =
match get_components (find_module_components path env) with
match path with
| Pident id ->
let data = find_ident_module id env in
- EnvLazy.force subst_modtype_maker data.mda_declaration
+ Lazy_backtrack.force subst_modtype_maker data.mda_declaration
| Pdot(p, s) ->
let sc = find_structure_components p env in
let data = NameMap.find s sc.comp_modules in
- EnvLazy.force subst_modtype_maker data.mda_declaration
+ Lazy_backtrack.force subst_modtype_maker data.mda_declaration
| Papply(p1, p2) ->
let fc = find_functor_components p1 env in
if alias then md (fc.fcomp_res)
let labels =
List.map snd (Datarepr.labels_of_type path decl)
in
- { tda_declaration = decl; tda_descriptions = ([], labels) }
- | _ ->
- assert false
+ begin match decl.type_kind with
+ | Type_record (_, repr) ->
+ {
+ tda_declaration = decl;
+ tda_descriptions = Type_record (labels, repr);
+ }
+ | _ -> assert false
+ end
+ | _ -> assert false
-let find_type_full path env =
+let find_type_data path env =
match Path.constructor_typath path with
| Regular p -> begin
match Path.Map.find p env.local_constraints with
| decl ->
- { tda_declaration = decl; tda_descriptions = [], [] }
+ { tda_declaration = decl; tda_descriptions = Type_abstract }
| exception Not_found -> find_type_full p env
end
| Cstr (ty_path, s) ->
+ (* This case corresponds to an inlined record *)
let tda =
try find_type_full ty_path env
with Not_found -> assert false
in
- let (cstrs, _) = tda.tda_descriptions in
let cstr =
- try List.find (fun cstr -> cstr.cstr_name = s) cstrs
- with Not_found -> assert false
+ begin match tda.tda_descriptions with
+ | Type_variant (cstrs, _) -> begin
+ try
+ List.find (fun cstr -> cstr.cstr_name = s) cstrs
+ with Not_found -> assert false
+ end
+ | Type_record _ | Type_abstract | Type_open -> assert false
+ end
in
type_of_cstr path cstr
| LocalExt id ->
| _ -> assert false
let find_type p env =
- (find_type_full p env).tda_declaration
+ (find_type_data p env).tda_declaration
let find_type_descrs p env =
- (find_type_full p env).tda_descriptions
+ (find_type_data p env).tda_descriptions
let rec find_module_address path env =
match path with
| ModAlias { env; path } -> find_module_address path env
and get_address a =
- EnvLazy.force force_address a
+ Lazy_backtrack.force force_address a
let find_value_address path env =
get_address (find_value_full path env).vda_address
IdTbl.map f env0.values
in
(fun env ->
- if env.values != env0.values then fatal_error "Env.make_copy_of_types";
+ (*if env.values != env0.values then fatal_error "Env.make_copy_of_types";*)
{env with values; summary = Env_copy_types env.summary}
)
let rec iter_components path path' mcomps =
let cont () =
let visit =
- match EnvLazy.get_arg mcomps.comps with
+ match Lazy_backtrack.get_arg mcomps.comps with
| None -> true
| Some { cm_mty; cm_freshening_subst; _ } ->
scrape_alias_for_visit env cm_freshening_subst cm_mty
let value_declaration_address (_ : t) id decl =
match decl.val_kind with
- | Val_prim _ -> EnvLazy.create_failed Not_found
- | _ -> EnvLazy.create_forced (Aident id)
+ | Val_prim _ -> Lazy_backtrack.create_failed Not_found
+ | _ -> Lazy_backtrack.create_forced (Aident id)
let extension_declaration_address (_ : t) id (_ : extension_constructor) =
- EnvLazy.create_forced (Aident id)
+ Lazy_backtrack.create_forced (Aident id)
let class_declaration_address (_ : t) id (_ : class_declaration) =
- EnvLazy.create_forced (Aident id)
+ Lazy_backtrack.create_forced (Aident id)
let module_declaration_address env id presence md =
match presence with
| Mp_absent -> begin
match md.md_type with
- | Mty_alias path -> EnvLazy.create (ModAlias {env; path})
+ | Mty_alias path -> Lazy_backtrack.create (ModAlias {env; path})
| _ -> assert false
end
| Mp_present ->
- EnvLazy.create_forced (Aident id)
+ Lazy_backtrack.create_forced (Aident id)
let is_identchar c =
(* This should be kept in sync with the [identchar_latin1] character class
Projection { parent = cm_addr; pos = !pos }
in
incr pos;
- EnvLazy.create addr
+ Lazy_backtrack.create addr
in
let sub = may_subst Subst.compose freshening_sub prefixing_sub in
List.iter (fun (item, path) ->
let decl' = Subst.value_description sub decl in
let addr =
match decl.val_kind with
- | Val_prim _ -> EnvLazy.create_failed Not_found
+ | Val_prim _ -> Lazy_backtrack.create_failed Not_found
| _ -> next_address ()
in
let vda = { vda_description = decl'; vda_address = addr } in
may_subst Subst.type_declaration freshening_sub decl
in
let final_decl = Subst.type_declaration prefixing_sub fresh_decl in
- Datarepr.set_row_name final_decl
+ Btype.set_row_name final_decl
(Subst.type_path prefixing_sub (Path.Pident id));
- let constructors =
- List.map snd
- (Datarepr.constructors_of_type ~current_unit:(get_unit_name ())
- path final_decl)
+ let descrs =
+ match decl.type_kind with
+ | Type_variant (_,repr) ->
+ let cstrs = List.map snd
+ (Datarepr.constructors_of_type path final_decl
+ ~current_unit:(get_unit_name ()))
+ in
+ List.iter
+ (fun descr ->
+ let cda = {
+ cda_description = descr;
+ cda_address = None }
+ in
+ c.comp_constrs <-
+ add_to_tbl descr.cstr_name cda c.comp_constrs
+ ) cstrs;
+ Type_variant (cstrs, repr)
+ | Type_record (_, repr) ->
+ let lbls = List.map snd
+ (Datarepr.labels_of_type path final_decl)
+ in
+ List.iter
+ (fun descr ->
+ c.comp_labels <-
+ add_to_tbl descr.lbl_name descr c.comp_labels)
+ lbls;
+ Type_record (lbls, repr)
+ | Type_abstract -> Type_abstract
+ | Type_open -> Type_open
in
- let labels =
- List.map snd (Datarepr.labels_of_type path final_decl) in
let tda =
{ tda_declaration = final_decl;
- tda_descriptions = (constructors, labels); }
+ tda_descriptions = descrs; }
in
c.comp_types <- NameMap.add (Ident.name id) tda c.comp_types;
- List.iter
- (fun descr ->
- let cda = { cda_description = descr; cda_address = None } in
- c.comp_constrs <-
- add_to_tbl descr.cstr_name cda c.comp_constrs)
- constructors;
- List.iter
- (fun descr ->
- c.comp_labels <-
- add_to_tbl descr.lbl_name descr c.comp_labels)
- labels;
env := store_type_infos id fresh_decl !env
| Sig_typext(id, ext, _, _) ->
let ext' = Subst.extension_constructor sub ext in
let md' =
(* The prefixed items get the same scope as [cm_path], which is
the prefix. *)
- EnvLazy.create (sub, Subst.Rescope (Path.scope cm_path), md)
+ Lazy_backtrack.create
+ (sub, Subst.Rescope (Path.scope cm_path), md)
in
let addr =
match pres with
match md.md_type with
| Mty_alias p ->
let path = may_subst Subst.module_path freshening_sub p in
- EnvLazy.create (ModAlias {env = !env; path})
+ Lazy_backtrack.create (ModAlias {env = !env; path})
| _ -> assert false
end
| Mp_present -> next_address ()
values = IdTbl.add id (Val_bound vda) env.values;
summary = Env_value(env.summary, id, decl) }
+and store_constructor ~check type_decl type_id cstr_id cstr env =
+ if check && not type_decl.type_loc.Location.loc_ghost
+ && Warnings.is_active (Warnings.Unused_constructor ("", Unused))
+ then begin
+ let ty_name = Ident.name type_id in
+ let name = cstr.cstr_name in
+ let loc = cstr.cstr_loc in
+ let k = cstr.cstr_uid in
+ let priv = type_decl.type_private in
+ if not (Types.Uid.Tbl.mem !used_constructors k) then begin
+ let used = constructor_usages () in
+ Types.Uid.Tbl.add !used_constructors k
+ (add_constructor_usage used);
+ if not (ty_name = "" || ty_name.[0] = '_')
+ then
+ !add_delayed_check_forward
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning loc
+ (Warnings.Unused_constructor(name, complaint)))
+ (constructor_usage_complaint ~rebind:false priv used));
+ end;
+ end;
+ { env with
+ constrs =
+ TycompTbl.add cstr_id
+ { cda_description = cstr; cda_address = None } env.constrs;
+ }
+
+and store_label ~check type_decl type_id lbl_id lbl env =
+ if check && not type_decl.type_loc.Location.loc_ghost
+ && Warnings.is_active (Warnings.Unused_field ("", Unused))
+ then begin
+ let ty_name = Ident.name type_id in
+ let priv = type_decl.type_private in
+ let name = lbl.lbl_name in
+ let loc = lbl.lbl_loc in
+ let mut = lbl.lbl_mut in
+ let k = lbl.lbl_uid in
+ if not (Types.Uid.Tbl.mem !used_labels k) then
+ let used = label_usages () in
+ Types.Uid.Tbl.add !used_labels k
+ (add_label_usage used);
+ if not (ty_name = "" || ty_name.[0] = '_' || name.[0] = '_')
+ then !add_delayed_check_forward
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning
+ loc (Warnings.Unused_field(name, complaint)))
+ (label_usage_complaint priv mut used))
+ end;
+ { env with
+ labels = TycompTbl.add lbl_id lbl env.labels;
+ }
+
and store_type ~check id info env =
let loc = info.type_loc in
if check then
check_usage loc id info.type_uid
(fun s -> Warnings.Unused_type_declaration s)
!type_declarations;
- let path = Pident id in
- let constructors =
- Datarepr.constructors_of_type path info
- ~current_unit:(get_unit_name ())
+ let descrs, env =
+ let path = Pident id in
+ match info.type_kind with
+ | Type_variant (_,repr) ->
+ let constructors = Datarepr.constructors_of_type path info
+ ~current_unit:(get_unit_name ())
+ in
+ Type_variant (List.map snd constructors, repr),
+ List.fold_left
+ (fun env (cstr_id, cstr) ->
+ store_constructor ~check info id cstr_id cstr env)
+ env constructors
+ | Type_record (_, repr) ->
+ let labels = Datarepr.labels_of_type path info in
+ Type_record (List.map snd labels, repr),
+ List.fold_left
+ (fun env (lbl_id, lbl) ->
+ store_label ~check info id lbl_id lbl env)
+ env labels
+ | Type_abstract -> Type_abstract, env
+ | Type_open -> Type_open, env
in
- let labels = Datarepr.labels_of_type path info in
- let descrs = (List.map snd constructors, List.map snd labels) in
let tda = { tda_declaration = info; tda_descriptions = descrs } in
- if check && not loc.Location.loc_ghost &&
- Warnings.is_active (Warnings.Unused_constructor ("", false, false))
- then begin
- let ty_name = Ident.name id in
- let priv = info.type_private in
- List.iter
- begin fun (_, cstr) ->
- let name = cstr.cstr_name in
- let loc = cstr.cstr_loc in
- let k = cstr.cstr_uid in
- if not (Types.Uid.Tbl.mem !used_constructors k) then
- let used = constructor_usages () in
- Types.Uid.Tbl.add !used_constructors k
- (add_constructor_usage ~rebind:false priv used);
- if not (ty_name = "" || ty_name.[0] = '_')
- then !add_delayed_check_forward
- (fun () ->
- if not (is_in_signature env) && not used.cu_positive then
- Location.prerr_warning loc
- (Warnings.Unused_constructor
- (name, used.cu_pattern, used.cu_privatize)))
- end
- constructors
- end;
{ env with
- constrs =
- List.fold_right
- (fun (id, descr) constrs ->
- let cda = { cda_description = descr; cda_address = None } in
- TycompTbl.add id cda constrs)
- constructors env.constrs;
- labels =
- List.fold_right
- (fun (id, descr) labels -> TycompTbl.add id descr labels)
- labels env.labels;
types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
manifest-ness of the type. Used in components_of_module to
keep track of type abbreviations (e.g. type t = float) in the
computation of label representations. *)
- let tda = { tda_declaration = info; tda_descriptions = [], [] } in
+ let tda = { tda_declaration = info; tda_descriptions = Type_abstract } in
{ env with
types = IdTbl.add id tda env.types;
summary = Env_type(env.summary, id, info) }
in
let cda = { cda_description = cstr; cda_address = Some addr } in
if check && not loc.Location.loc_ghost &&
- Warnings.is_active (Warnings.Unused_extension ("", false, false, false))
+ Warnings.is_active (Warnings.Unused_extension ("", false, Unused))
then begin
let priv = ext.ext_private in
let is_exception = Path.same ext.ext_type_path Predef.path_exn in
if not (Types.Uid.Tbl.mem !used_constructors k) then begin
let used = constructor_usages () in
Types.Uid.Tbl.add !used_constructors k
- (add_constructor_usage ~rebind priv used);
+ (add_constructor_usage used);
!add_delayed_check_forward
- (fun () ->
- if not (is_in_signature env) && not used.cu_positive then
- Location.prerr_warning loc
- (Warnings.Unused_extension
- (name, is_exception, used.cu_pattern, used.cu_privatize)
- )
- )
+ (fun () ->
+ Option.iter
+ (fun complaint ->
+ if not (is_in_signature env) then
+ Location.prerr_warning loc
+ (Warnings.Unused_extension
+ (name, is_exception, complaint)))
+ (constructor_usage_complaint ~rebind priv used))
end;
end;
{ env with
let alerts = Builtin_attributes.alerts_of_attrs md.md_attributes in
let module_decl_lazy =
match freshening_sub with
- | None -> EnvLazy.create_forced md
- | Some s -> EnvLazy.create (s, Subst.Rescope (Ident.scope id), md)
+ | None -> Lazy_backtrack.create_forced md
+ | Some s -> Lazy_backtrack.create (s, Subst.Rescope (Ident.scope id), md)
in
let comps =
components_of_module ~alerts ~uid:md.md_uid
(* Compute the components of a functor application in a path. *)
-let components_of_functor_appl ~loc f env p1 p2 =
+let components_of_functor_appl ~loc ~f_path ~f_comp ~arg env =
try
- Hashtbl.find f.fcomp_cache p2
+ let c = Hashtbl.find f_comp.fcomp_cache arg in
+ c
with Not_found ->
- let p = Papply(p1, p2) in
+ let p = Papply(f_path, arg) in
let sub =
- match f.fcomp_arg with
+ match f_comp.fcomp_arg with
| Unit
| Named (None, _) -> Subst.identity
- | Named (Some param, _) -> Subst.add_module param p2 Subst.identity
+ | Named (Some param, _) -> Subst.add_module param arg Subst.identity
in
(* we have to apply eagerly instead of passing sub to [components_of_module]
because of the call to [check_well_formed_module]. *)
- let mty = Subst.modtype (Rescope (Path.scope p)) sub f.fcomp_res in
- let addr = EnvLazy.create_failed Not_found in
+ let mty = Subst.modtype (Rescope (Path.scope p)) sub f_comp.fcomp_res in
+ let addr = Lazy_backtrack.create_failed Not_found in
!check_well_formed_module env loc
("the signature of " ^ Path.name p) mty;
let comps =
(*???*)
env None Subst.identity p addr mty
in
- Hashtbl.add f.fcomp_cache p2 comps;
+ Hashtbl.add f_comp.fcomp_cache arg comps;
comps
(* Define forward functions *)
let add_components slot root env0 comps =
let add_l w comps env0 =
- TycompTbl.add_open slot w comps env0
+ TycompTbl.add_open slot w root comps env0
in
let add w comps env0 = IdTbl.add_open slot w root comps env0 in
let constrs =
| Ok (Structure_comps comps) ->
Ok (add_components slot root env0 comps)
+let remove_last_open root env0 =
+ let rec filter_summary summary =
+ match summary with
+ Env_empty -> raise Exit
+ | Env_open (s, p) ->
+ if Path.same p root then s else raise Exit
+ | Env_value _
+ | Env_type _
+ | Env_extension _
+ | Env_module _
+ | Env_modtype _
+ | Env_class _
+ | Env_cltype _
+ | Env_functor_arg _
+ | Env_constraints _
+ | Env_persistent _
+ | Env_copy_types _
+ | Env_value_unbound _
+ | Env_module_unbound _ ->
+ map_summary filter_summary summary
+ in
+ match filter_summary env0.summary with
+ | summary ->
+ let rem_l tbl = TycompTbl.remove_last_open root tbl
+ and rem tbl = IdTbl.remove_last_open root tbl in
+ Some { env0 with
+ summary;
+ constrs = rem_l env0.constrs;
+ labels = rem_l env0.labels;
+ values = rem env0.values;
+ types = rem env0.types;
+ modtypes = rem env0.modtypes;
+ classes = rem env0.classes;
+ cltypes = rem env0.cltypes;
+ modules = rem env0.modules; }
+ | exception Exit ->
+ None
(* Open a signature from a file *)
(* Read a signature from a file *)
let read_signature modname filename =
let mda = read_pers_mod modname filename in
- let md = EnvLazy.force subst_modtype_maker mda.mda_declaration in
+ let md = Lazy_backtrack.force subst_modtype_maker mda.mda_declaration in
match md.md_type with
| Mty_signature sg -> sg
| Mty_ident _ | Mty_functor _ | Mty_alias _ -> assert false
| mark -> mark usage
| exception Not_found -> ()
+let mark_label_used usage ld =
+ match Types.Uid.Tbl.find !used_labels ld.ld_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
+
let mark_constructor_description_used usage env cstr =
let ty_path =
match repr cstr.cstr_res with
| mark -> mark usage
| exception Not_found -> ()
-let mark_label_description_used () env lbl =
+let mark_label_description_used usage env lbl =
let ty_path =
match repr lbl.lbl_res with
| {desc=Tconstr(path, _, _)} -> path
| _ -> assert false
in
- mark_type_path_used env ty_path
+ mark_type_path_used env ty_path;
+ match Types.Uid.Tbl.find !used_labels lbl.lbl_uid with
+ | mark -> mark usage
+ | exception Not_found -> ()
let mark_class_used uid =
match Types.Uid.Tbl.find !type_declarations uid with
(Path.name path)
end
-let use_label ~use ~loc env lbl =
+let use_label ~use ~loc usage env lbl =
if use then begin
- mark_label_description_used () env lbl;
+ mark_label_description_used usage env lbl;
Builtin_attributes.check_alerts loc lbl.lbl_attributes lbl.lbl_name
end
| exception Not_found ->
may_lookup_error errors loc env (Unbound_cltype (Lident s))
-let lookup_all_ident_labels ~errors ~use ~loc s env =
+let lookup_all_ident_labels ~errors ~use ~loc usage s env =
match TycompTbl.find_all ~mark:use s env.labels with
| [] -> may_lookup_error errors loc env (Unbound_label (Lident s))
| lbls -> begin
List.map
(fun (lbl, use_fn) ->
let use_fn () =
- use_label ~use ~loc env lbl;
+ use_label ~use ~loc usage env lbl;
use_fn ()
in
(lbl, use_fn))
| Ldot(l, s) ->
let path, data = lookup_dot_module ~errors ~use ~loc l s env in
path, data.mda_components
- | Lapply(l1, l2) ->
- let p1, f, arg = lookup_functor_components ~errors ~use ~loc l1 env in
- let p2, md = lookup_module ~errors ~use ~loc l2 env in
- check_functor_appl ~errors ~loc env p1 f arg p2 md;
- let comps = !components_of_functor_appl' ~loc f env p1 p2 in
- (Papply(p1, p2), comps)
+ | Lapply _ as lid ->
+ let f_path, f_comp, arg = lookup_apply ~errors ~use ~loc lid env in
+ let comps =
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg env in
+ Papply (f_path, arg), comps
and lookup_structure_components ~errors ~use ~loc lid env =
let path, comps = lookup_module_components ~errors ~use ~loc lid env in
| Error (No_components_alias p) ->
may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
-and lookup_functor_components ~errors ~use ~loc lid env =
- let path, comps = lookup_module_components ~errors ~use ~loc lid env in
+and get_functor_components ~errors ~loc lid env comps =
match get_components_res comps with
| Ok (Functor_comps fcomps) -> begin
match fcomps.fcomp_arg with
| Unit -> (* PR#7611 *)
may_lookup_error errors loc env (Generative_used_as_applicative lid)
- | Named (_, arg) -> path, fcomps, arg
+ | Named (_, arg) -> fcomps, arg
end
| Ok (Structure_comps _) ->
may_lookup_error errors loc env (Structure_used_as_functor lid)
| Error (No_components_alias p) ->
may_lookup_error errors loc env (Cannot_scrape_alias(lid, p))
+and lookup_all_args ~errors ~use ~loc lid0 env =
+ let rec loop_lid_arg args = function
+ | Lident _ | Ldot _ as f_lid ->
+ (f_lid, args)
+ | Lapply (f_lid, arg_lid) ->
+ let arg_path, arg_md = lookup_module ~errors ~use ~loc arg_lid env in
+ loop_lid_arg ((f_lid,arg_path,arg_md.md_type)::args) f_lid
+ in
+ loop_lid_arg [] lid0
+
+and lookup_apply ~errors ~use ~loc lid0 env =
+ let f0_lid, args0 = lookup_all_args ~errors ~use ~loc lid0 env in
+ let args_for_errors = List.map (fun (_,p,mty) -> (p,mty)) args0 in
+ let f0_path, f0_comp =
+ lookup_module_components ~errors ~use ~loc f0_lid env
+ in
+ let check_one_apply ~errors ~loc ~f_lid ~f_comp ~arg_path ~arg_mty env =
+ let f_comp, param_mty =
+ get_functor_components ~errors ~loc f_lid env f_comp
+ in
+ check_functor_appl
+ ~errors ~loc ~lid_whole_app:lid0
+ ~f0_path ~args:args_for_errors ~f_comp
+ ~arg_path ~arg_mty ~param_mty
+ env;
+ arg_path, f_comp
+ in
+ let rec check_apply ~path:f_path ~comp:f_comp = function
+ | [] -> invalid_arg "Env.lookup_apply: empty argument list"
+ | [ f_lid, arg_path, arg_mty ] ->
+ let arg_path, comps =
+ check_one_apply ~errors ~loc ~f_lid ~f_comp
+ ~arg_path ~arg_mty env
+ in
+ f_path, comps, arg_path
+ | (f_lid, arg_path, arg_mty) :: args ->
+ let arg_path, f_comp =
+ check_one_apply ~errors ~loc ~f_lid ~f_comp
+ ~arg_path ~arg_mty env
+ in
+ let comp =
+ !components_of_functor_appl' ~loc ~f_path ~f_comp ~arg:arg_path env
+ in
+ let path = Papply (f_path, arg_path) in
+ check_apply ~path ~comp args
+ in
+ check_apply ~path:f0_path ~comp:f0_comp args0
+
and lookup_module ~errors ~use ~loc lid env =
match lid with
| Lident s ->
let path, data = lookup_ident_module Load ~errors ~use ~loc s env in
- let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+ let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
path, md
| Ldot(l, s) ->
let path, data = lookup_dot_module ~errors ~use ~loc l s env in
- let md = EnvLazy.force subst_modtype_maker data.mda_declaration in
+ let md = Lazy_backtrack.force subst_modtype_maker data.mda_declaration in
path, md
- | Lapply(l1, l2) ->
- let p1, fc, arg = lookup_functor_components ~errors ~use ~loc l1 env in
- let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
- check_functor_appl ~errors ~loc env p1 fc arg p2 md2;
- let md = md (modtype_of_functor_appl fc p1 p2) in
- Papply(p1, p2), md
+ | Lapply _ as lid ->
+ let path_f, comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
+ let md = md (modtype_of_functor_appl comp_f path_f path_arg) in
+ Papply(path_f, path_arg), md
and lookup_dot_module ~errors ~use ~loc l s env =
let p, comps = lookup_structure_components ~errors ~use ~loc l env in
| exception Not_found ->
may_lookup_error errors loc env (Unbound_cltype (Ldot(l, s)))
-let lookup_all_dot_labels ~errors ~use ~loc l s env =
+let lookup_all_dot_labels ~errors ~use ~loc usage l s env =
let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
match NameMap.find s comps.comp_labels with
| [] | exception Not_found ->
| lbls ->
List.map
(fun lbl ->
- let use_fun () = use_label ~use ~loc env lbl in
+ let use_fun () = use_label ~use ~loc usage env lbl in
(lbl, use_fun))
lbls
else
fst (lookup_ident_module Load ~errors ~use ~loc s env)
| Ldot(l, s) -> fst (lookup_dot_module ~errors ~use ~loc l s env)
- | Lapply(l1, l2) ->
- let (p1, f, arg) = lookup_functor_components ~errors ~use ~loc l1 env in
- let p2, md2 = lookup_module ~errors ~use ~loc l2 env in
- check_functor_appl ~errors ~loc env p1 f arg p2 md2;
- Papply(p1, p2)
+ | Lapply _ as lid ->
+ let path_f, _comp_f, path_arg = lookup_apply ~errors ~use ~loc lid env in
+ Papply(path_f, path_arg)
let lookup_value ~errors ~use ~loc lid env =
match lid with
| Ldot(l, s) -> lookup_dot_cltype ~errors ~use ~loc l s env
| Lapply _ -> assert false
-let lookup_all_labels ~errors ~use ~loc lid env =
+let lookup_all_labels ~errors ~use ~loc usage lid env =
match lid with
- | Lident s -> lookup_all_ident_labels ~errors ~use ~loc s env
- | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc l s env
+ | Lident s -> lookup_all_ident_labels ~errors ~use ~loc usage s env
+ | Ldot(l, s) -> lookup_all_dot_labels ~errors ~use ~loc usage l s env
| Lapply _ -> assert false
-let lookup_label ~errors ~use ~loc lid env =
- match lookup_all_labels ~errors ~use ~loc lid env with
+let lookup_label ~errors ~use ~loc usage lid env =
+ match lookup_all_labels ~errors ~use ~loc usage lid env with
| [] -> assert false
| (desc, use) :: _ -> use (); desc
-let lookup_all_labels_from_type ~use ~loc ty_path env =
+let lookup_all_labels_from_type ~use ~loc usage ty_path env =
match find_type_descrs ty_path env with
| exception Not_found -> []
- | (_, lbls) ->
+ | Type_variant _ | Type_abstract | Type_open -> []
+ | Type_record (lbls, _) ->
List.map
(fun lbl ->
- let use_fun () = use_label ~use ~loc env lbl in
+ let use_fun () = use_label ~use ~loc usage env lbl in
(lbl, use_fun))
lbls
let lookup_all_constructors_from_type ~use ~loc usage ty_path env =
match find_type_descrs ty_path env with
| exception Not_found -> []
- | (cstrs, _) ->
+ | Type_record _ | Type_abstract | Type_open -> []
+ | Type_variant (cstrs, _) ->
List.map
(fun cstr ->
let use_fun () =
let find_label_by_name lid env =
let loc = Location.(in_file !input_name) in
- lookup_label ~errors:false ~use:false ~loc lid env
+ lookup_label ~errors:false ~use:false ~loc Projection lid env
(* Ordinary lookup functions *)
let lookup_all_constructors_from_type ?(use=true) ~loc usage ty_path env =
lookup_all_constructors_from_type ~use ~loc usage ty_path env
-let lookup_all_labels ?(use=true) ~loc lid env =
- match lookup_all_labels ~errors:true ~use ~loc lid env with
+let lookup_all_labels ?(use=true) ~loc usage lid env =
+ match lookup_all_labels ~errors:true ~use ~loc usage lid env with
| exception Error(Lookup_error(loc', env', err)) ->
(Error(loc', env', err) : _ result)
| lbls -> Ok lbls
let lookup_label ?(use=true) ~loc lid env =
lookup_label ~errors:true ~use ~loc lid env
-let lookup_all_labels_from_type ?(use=true) ~loc ty_path env =
- lookup_all_labels_from_type ~use ~loc ty_path env
+let lookup_all_labels_from_type ?(use=true) ~loc usage ty_path env =
+ lookup_all_labels_from_type ~use ~loc usage ty_path env
let lookup_instance_variable ?(use=true) ~loc name env =
match IdTbl.find_name wrap_value ~mark:use name env.values with
| Mod_unbound _ -> acc
| Mod_local mda ->
let md =
- EnvLazy.force subst_modtype_maker mda.mda_declaration
+ Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
in
f name p md acc
| Mod_persistent ->
| None -> acc
| Some mda ->
let md =
- EnvLazy.force subst_modtype_maker mda.mda_declaration
+ Lazy_backtrack.force subst_modtype_maker
+ mda.mda_declaration
in
f name p md acc)
env.modules
NameMap.fold
(fun s mda acc ->
let md =
- EnvLazy.force subst_modtype_maker mda.mda_declaration
+ Lazy_backtrack.force subst_modtype_maker mda.mda_declaration
in
f s (Pdot (p, s)) md acc)
c.comp_modules
summary
else
match summary with
- | Env_empty -> summary
- | Env_value (s, id, vd) ->
- Env_value (filter_summary s ids, id, vd)
- | Env_type (s, id, td) ->
- Env_type (filter_summary s ids, id, td)
- | Env_extension (s, id, ec) ->
- Env_extension (filter_summary s ids, id, ec)
- | Env_module (s, id, mp, md) ->
- Env_module (filter_summary s ids, id, mp, md)
- | Env_modtype (s, id, md) ->
- Env_modtype (filter_summary s ids, id, md)
- | Env_class (s, id, cd) ->
- Env_class (filter_summary s ids, id, cd)
- | Env_cltype (s, id, ctd) ->
- Env_cltype (filter_summary s ids, id, ctd)
- | Env_open (s, p) ->
- Env_open (filter_summary s ids, p)
- | Env_functor_arg (s, id) ->
- Env_functor_arg (filter_summary s ids, id)
- | Env_constraints (s, cstrs) ->
- Env_constraints (filter_summary s ids, cstrs)
- | Env_copy_types s ->
- Env_copy_types (filter_summary s ids)
- | Env_persistent (s, id) ->
- if String.Set.mem (Ident.name id) ids then
- filter_summary s (String.Set.remove (Ident.name id) ids)
- else
- Env_persistent (filter_summary s ids, id)
- | Env_value_unbound (s, n, r) ->
- Env_value_unbound (filter_summary s ids, n, r)
- | Env_module_unbound (s, n, r) ->
- Env_module_unbound (filter_summary s ids, n, r)
+ Env_persistent (s, id) when String.Set.mem (Ident.name id) ids ->
+ filter_summary s (String.Set.remove (Ident.name id) ids)
+ | Env_empty
+ | Env_value _
+ | Env_type _
+ | Env_extension _
+ | Env_module _
+ | Env_modtype _
+ | Env_class _
+ | Env_cltype _
+ | Env_open _
+ | Env_functor_arg _
+ | Env_constraints _
+ | Env_copy_types _
+ | Env_persistent _
+ | Env_value_unbound _
+ | Env_module_unbound _ ->
+ map_summary (fun s -> filter_summary s ids) summary
in
{ env with
modules = remove_ids env.modules to_remove;
val initial_safe_string: t
val initial_unsafe_string: t
val diff: t -> t -> Ident.t list
-val copy_local: from:t -> t -> t
-type type_descriptions =
- constructor_description list * label_description list
+type type_descr_kind =
+ (label_description, constructor_description) type_kind
+
+ (* alias for compatibility *)
+type type_descriptions = type_descr_kind
(* For short-paths *)
type iter_cont
val mark_module_used: Uid.t -> unit
val mark_type_used: Uid.t -> unit
-type constructor_usage = Positive | Pattern | Privatize
+type constructor_usage = Positive | Pattern | Exported_private | Exported
val mark_constructor_used:
constructor_usage -> constructor_declaration -> unit
val mark_extension_used:
constructor_usage -> extension_constructor -> unit
+type label_usage =
+ Projection | Mutation | Construct | Exported_private | Exported
+val mark_label_used:
+ label_usage -> label_declaration -> unit
+
(* Lookup by long identifiers *)
(* Lookup errors *)
(constructor_description * (unit -> unit)) list
val lookup_label:
- ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ ?use:bool -> loc:Location.t -> label_usage -> Longident.t -> t ->
label_description
val lookup_all_labels:
- ?use:bool -> loc:Location.t -> Longident.t -> t ->
+ ?use:bool -> loc:Location.t -> label_usage -> Longident.t -> t ->
((label_description * (unit -> unit)) list,
Location.t * t * lookup_error) result
val lookup_all_labels_from_type:
- ?use:bool -> loc:Location.t -> Path.t -> t ->
+ ?use:bool -> loc:Location.t -> label_usage -> Path.t -> t ->
(label_description * (unit -> unit)) list
val lookup_instance_variable:
val open_pers_signature: string -> t -> (t, [`Not_found]) result
+val remove_last_open: Path.t -> t -> t option
+
(* Insertion by name *)
val enter_value:
(* Forward declaration to break mutual recursion with Includemod. *)
val check_functor_application:
- (errors:bool -> loc:Location.t -> t -> module_type ->
- Path.t -> module_type -> Path.t -> unit) ref
+ (errors:bool -> loc:Location.t ->
+ lid_whole_app:Longident.t ->
+ f0_path:Path.t -> args:(Path.t * Types.module_type) list ->
+ arg_path:Path.t -> arg_mty:Types.module_type ->
+ param_mty:Types.module_type ->
+ t -> unit) ref
(* Forward declaration to break mutual recursion with Typemod. *)
val check_well_formed_module:
(t -> Location.t -> string -> module_type -> unit) ref
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* Antal Spector-Zabusky, Jane Street, New York *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Types
+open Format
+
+type position = First | Second
+
+let swap_position = function
+ | First -> Second
+ | Second -> First
+
+let print_pos ppf = function
+ | First -> fprintf ppf "first"
+ | Second -> fprintf ppf "second"
+
+type desc = { t: type_expr; expanded: type_expr option }
+type 'a diff = { got: 'a; expected: 'a}
+
+let short t = { t; expanded = None }
+let map_diff f r =
+ (* ordering is often meaningful when dealing with type_expr *)
+ let got = f r.got in
+ let expected = f r.expected in
+ { got; expected}
+
+let flatten_desc f x = match x.expanded with
+ | None -> f x.t x.t
+ | Some expanded -> f x.t expanded
+
+let swap_diff x = { got = x.expected; expected = x.got }
+
+type 'a escape_kind =
+ | Constructor of Path.t
+ | Univ of type_expr
+ (* The type_expr argument of [Univ] is always a [Tunivar _],
+ we keep a [type_expr] to track renaming in {!Printtyp} *)
+ | Self
+ | Module_type of Path.t
+ | Equation of 'a
+ | Constraint
+
+type 'a escape =
+ { kind : 'a escape_kind;
+ context : type_expr option }
+
+let explain trace f =
+ let rec explain = function
+ | [] -> None
+ | [h] -> f ~prev:None h
+ | h :: (prev :: _ as rem) ->
+ match f ~prev:(Some prev) h with
+ | Some _ as m -> m
+ | None -> explain rem in
+ explain (List.rev trace)
+
+(* Type indices *)
+type unification = private Unification
+type comparison = private Comparison
+
+type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
+type 'variety variant =
+ (* Common *)
+ | Incompatible_types_for : string -> _ variant
+ | No_tags : position * (Asttypes.label * row_field) list -> _ variant
+ (* Unification *)
+ | No_intersection : unification variant
+ | Fixed_row :
+ position * fixed_row_case * fixed_explanation -> unification variant
+ (* Equality & Moregen *)
+ | Openness : position (* Always [Second] for Moregen *) -> comparison variant
+
+type 'variety obj =
+ (* Common *)
+ | Missing_field : position * string -> _ obj
+ | Abstract_row : position -> _ obj
+ (* Unification *)
+ | Self_cannot_be_closed : unification obj
+
+type ('a, 'variety) elt =
+ (* Common *)
+ | Diff : 'a diff -> ('a, _) elt
+ | Variant : 'variety variant -> ('a, 'variety) elt
+ | Obj : 'variety obj -> ('a, 'variety) elt
+ | Escape : 'a escape -> ('a, _) elt
+ | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+ (* Could move [Incompatible_fields] into [obj] *)
+ (* Unification & Moregen; included in Equality for simplicity *)
+ | Rec_occur : type_expr * type_expr -> ('a, _) elt
+
+type 'variety t =
+ (desc, 'variety) elt list
+
+let diff got expected = Diff (map_diff short { got; expected })
+
+let map_elt (type variety) f : ('a, variety) elt -> ('b, variety) elt = function
+ | Diff x -> Diff (map_diff f x)
+ | Escape {kind = Equation x; context} ->
+ Escape { kind = Equation (f x); context }
+ | Escape {kind = (Univ _ | Self | Constructor _ | Module_type _ | Constraint);
+ _}
+ | Variant _ | Obj _ | Incompatible_fields _ | Rec_occur (_, _) as x -> x
+
+let map f t = List.map (map_elt f) t
+
+(* Convert desc to type_expr * type_expr *)
+let flatten f = map (flatten_desc f)
+
+let incompatible_fields name got expected =
+ Incompatible_fields { name; diff={got; expected} }
+
+
+let swap_elt (type variety) : ('a, variety) elt -> ('a, variety) elt = function
+ | Diff x -> Diff (swap_diff x)
+ | Incompatible_fields { name; diff } ->
+ Incompatible_fields { name; diff = swap_diff diff}
+ | Obj (Missing_field(pos,s)) -> Obj (Missing_field(swap_position pos,s))
+ | Obj (Abstract_row pos) -> Obj (Abstract_row (swap_position pos))
+ | Variant (Fixed_row(pos,k,f)) ->
+ Variant (Fixed_row(swap_position pos,k,f))
+ | Variant (No_tags(pos,f)) ->
+ Variant (No_tags(swap_position pos,f))
+ | x -> x
+
+let swap_trace e = List.map swap_elt e
+
+module Subtype = struct
+ type 'a elt =
+ | Diff of 'a diff
+
+ type t = desc elt list
+
+ let diff got expected = Diff (map_diff short {got;expected})
+
+ let map_elt f = function
+ | Diff x -> Diff (map_diff f x)
+
+ let map f t = List.map (map_elt f) t
+
+ let flatten f t = map (flatten_desc f) t
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* Antal Spector-Zabusky, Jane Street, New York *)
+(* *)
+(* Copyright 2018 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* Copyright 2021 Jane Street Group LLC *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+open Types
+
+type position = First | Second
+
+val swap_position : position -> position
+val print_pos : Format.formatter -> position -> unit
+
+type desc = { t: type_expr; expanded: type_expr option }
+type 'a diff = { got: 'a; expected: 'a}
+
+(** [map_diff f {expected;got}] is [{expected=f expected; got=f got}] *)
+val map_diff: ('a -> 'b) -> 'a diff -> 'b diff
+
+(** Scope escape related errors *)
+type 'a escape_kind =
+ | Constructor of Path.t
+ | Univ of type_expr
+ (* The type_expr argument of [Univ] is always a [Tunivar _],
+ we keep a [type_expr] to track renaming in {!Printtyp} *)
+ | Self
+ | Module_type of Path.t
+ | Equation of 'a
+ | Constraint
+
+type 'a escape =
+ { kind : 'a escape_kind;
+ context : type_expr option }
+
+val short : type_expr -> desc
+
+val explain: 'a list ->
+ (prev:'a option -> 'a -> 'b option) ->
+ 'b option
+
+(* Type indices *)
+type unification = private Unification
+type comparison = private Comparison
+
+type fixed_row_case =
+ | Cannot_be_closed
+ | Cannot_add_tags of string list
+
+type 'variety variant =
+ (* Common *)
+ | Incompatible_types_for : string -> _ variant
+ | No_tags : position * (Asttypes.label * row_field) list -> _ variant
+ (* Unification *)
+ | No_intersection : unification variant
+ | Fixed_row :
+ position * fixed_row_case * fixed_explanation -> unification variant
+ (* Equality & Moregen *)
+ | Openness : position (* Always [Second] for Moregen *) -> comparison variant
+
+type 'variety obj =
+ (* Common *)
+ | Missing_field : position * string -> _ obj
+ | Abstract_row : position -> _ obj
+ (* Unification *)
+ | Self_cannot_be_closed : unification obj
+
+type ('a, 'variety) elt =
+ (* Common *)
+ | Diff : 'a diff -> ('a, _) elt
+ | Variant : 'variety variant -> ('a, 'variety) elt
+ | Obj : 'variety obj -> ('a, 'variety) elt
+ | Escape : 'a escape -> ('a, _) elt
+ | Incompatible_fields : { name:string; diff: type_expr diff } -> ('a, _) elt
+ (* Unification & Moregen; included in Equality for simplicity *)
+ | Rec_occur : type_expr * type_expr -> ('a, _) elt
+
+type 'variety t =
+ (desc, 'variety) elt list
+
+val diff : type_expr -> type_expr -> (desc, _) elt
+
+(** [flatten f trace] flattens all elements of type {!desc} in
+ [trace] to either [f x.t expanded] if [x.expanded=Some expanded]
+ or [f x.t x.t] otherwise *)
+val flatten :
+ (type_expr -> type_expr -> 'a) -> 'variety t -> ('a, 'variety) elt list
+
+val map : ('a -> 'b) -> ('a, 'variety) elt list -> ('b, 'variety) elt list
+
+val incompatible_fields : string -> type_expr -> type_expr -> (desc, _) elt
+
+val swap_trace : 'variety t -> 'variety t
+
+module Subtype : sig
+ type 'a elt =
+ | Diff of 'a diff
+
+ type t = desc elt list
+
+ val diff: type_expr -> type_expr -> desc elt
+
+ val flatten : (type_expr -> type_expr -> 'a) -> t -> 'a elt list
+
+ val map : (desc -> desc) -> desc elt list -> desc elt list
+end
| cty -> cty
*)
+let report_error_for = function
+ | CM_Equality -> Printtyp.report_equality_error
+ | CM_Moregen -> Printtyp.report_moregen_error
+
let include_err ppf =
function
| CM_Virtual_class ->
fprintf ppf
"The classes do not have the same number of type parameters"
| CM_Type_parameter_mismatch (env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_equality_error ppf env trace
(function ppf ->
fprintf ppf "A type parameter has type")
(function ppf ->
"is not matched by the class type"
Printtyp.class_type cty2)
| CM_Parameter_mismatch (env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ Printtyp.report_moregen_error ppf env trace
(function ppf ->
fprintf ppf "A parameter has type")
(function ppf ->
fprintf ppf "but is expected to have type")
- | CM_Val_type_mismatch (lab, env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ | CM_Val_type_mismatch (trace_type, lab, env, trace) ->
+ report_error_for trace_type ppf env trace
(function ppf ->
fprintf ppf "The instance variable %s@ has type" lab)
(function ppf ->
fprintf ppf "but is expected to have type")
- | CM_Meth_type_mismatch (lab, env, trace) ->
- Printtyp.report_unification_error ppf env trace
+ | CM_Meth_type_mismatch (trace_type, lab, env, trace) ->
+ report_error_for trace_type ppf env trace
(function ppf ->
fprintf ppf "The method %s@ has type" lab)
(function ppf ->
open Types
open Typedtree
+type position = Errortrace.position = First | Second
+
(* Inclusion between value descriptions *)
-exception Dont_match
+type primitive_mismatch =
+ | Name
+ | Arity
+ | No_alloc of position
+ | Native_name
+ | Result_repr
+ | Argument_repr of int
+
+let native_repr_args nra1 nra2 =
+ let rec loop i nra1 nra2 =
+ match nra1, nra2 with
+ | [], [] -> None
+ | [], _ :: _ -> assert false
+ | _ :: _, [] -> assert false
+ | nr1 :: nra1, nr2 :: nra2 ->
+ if not (Primitive.equal_native_repr nr1 nr2) then Some (Argument_repr i)
+ else loop (i+1) nra1 nra2
+ in
+ loop 1 nra1 nra2
+
+let primitive_descriptions pd1 pd2 =
+ let open Primitive in
+ if not (String.equal pd1.prim_name pd2.prim_name) then
+ Some Name
+ else if not (Int.equal pd1.prim_arity pd2.prim_arity) then
+ Some Arity
+ else if (not pd1.prim_alloc) && pd2.prim_alloc then
+ Some (No_alloc First)
+ else if pd1.prim_alloc && (not pd2.prim_alloc) then
+ Some (No_alloc Second)
+ else if not (String.equal pd1.prim_native_name pd2.prim_native_name) then
+ Some Native_name
+ else if not
+ (Primitive.equal_native_repr
+ pd1.prim_native_repr_res pd2.prim_native_repr_res) then
+ Some Result_repr
+ else
+ native_repr_args pd1.prim_native_repr_args pd2.prim_native_repr_args
+
+type value_mismatch =
+ | Primitive_mismatch of primitive_mismatch
+ | Not_a_primitive
+ | Type of Env.t * Errortrace.comparison Errortrace.t
+
+exception Dont_match of value_mismatch
let value_descriptions ~loc env name
(vd1 : Types.value_description)
loc
vd1.val_attributes vd2.val_attributes
name;
- if Ctype.moregeneral env true vd1.val_type vd2.val_type then begin
- match (vd1.val_kind, vd2.val_kind) with
- (Val_prim p1, Val_prim p2) ->
- if p1 = p2 then Tcoerce_none else raise Dont_match
+ match Ctype.moregeneral env true vd1.val_type vd2.val_type with
+ | exception Ctype.Moregen trace -> raise (Dont_match (Type (env, trace)))
+ | () -> begin
+ match (vd1.val_kind, vd2.val_kind) with
+ | (Val_prim p1, Val_prim p2) -> begin
+ match primitive_descriptions p1 p2 with
+ | None -> Tcoerce_none
+ | Some err -> raise (Dont_match (Primitive_mismatch err))
+ end
| (Val_prim p, _) ->
- let pc = {pc_desc = p; pc_type = vd2.Types.val_type;
- pc_env = env; pc_loc = vd1.Types.val_loc; } in
+ let pc =
+ { pc_desc = p; pc_type = vd2.Types.val_type;
+ pc_env = env; pc_loc = vd1.Types.val_loc; }
+ in
Tcoerce_primitive pc
- | (_, Val_prim _) -> raise Dont_match
+ | (_, Val_prim _) -> raise (Dont_match Not_a_primitive)
| (_, _) -> Tcoerce_none
- end else
- raise Dont_match
+ end
(* Inclusion between "private" annotations *)
let is_absrow env ty =
match ty.desc with
- Tconstr(Pident _, _, _) ->
- begin match Ctype.expand_head env ty with
- {desc=Tobject _|Tvariant _} -> true
+ | Tconstr(Pident _, _, _) -> begin
+ match Ctype.expand_head env ty with
+ | {desc=Tobject _|Tvariant _} -> true
| _ -> false
end
| _ -> false
-let type_manifest env ty1 params1 ty2 params2 priv2 =
- let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
- match ty1'.desc, ty2'.desc with
- Tvariant row1, Tvariant row2 when is_absrow env (Btype.row_more row2) ->
- let row1 = Btype.row_repr row1 and row2 = Btype.row_repr row2 in
- Ctype.equal env true (ty1::params1) (row2.row_more::params2) &&
- begin match row1.row_more with
- {desc=Tvar _|Tconstr _|Tnil} -> true
- | _ -> false
- end &&
- let r1, r2, pairs =
- Ctype.merge_row_fields row1.row_fields row2.row_fields in
- (not row2.row_closed ||
- row1.row_closed && Ctype.filter_row_fields false r1 = []) &&
- List.for_all
- (fun (_,f) -> match Btype.row_field_repr f with
- Rabsent | Reither _ -> true | Rpresent _ -> false)
- r2 &&
- let to_equal = ref (List.combine params1 params2) in
- List.for_all
- (fun (_, f1, f2) ->
- match Btype.row_field_repr f1, Btype.row_field_repr f2 with
- Rpresent(Some t1),
- (Rpresent(Some t2) | Reither(false, [t2], _, _)) ->
- to_equal := (t1,t2) :: !to_equal; true
- | Rpresent None, (Rpresent None | Reither(true, [], _, _)) -> true
- | Reither(c1,tl1,_,_), Reither(c2,tl2,_,_)
- when List.length tl1 = List.length tl2 && c1 = c2 ->
- to_equal := List.combine tl1 tl2 @ !to_equal; true
- | Rabsent, (Reither _ | Rabsent) -> true
- | _ -> false)
- pairs &&
- let tl1, tl2 = List.split !to_equal in
- Ctype.equal env true tl1 tl2
- | Tobject (fi1, _), Tobject (fi2, _)
- when is_absrow env (snd(Ctype.flatten_fields fi2)) ->
- let (fields2,rest2) = Ctype.flatten_fields fi2 in
- Ctype.equal env true (ty1::params1) (rest2::params2) &&
- let (fields1,rest1) = Ctype.flatten_fields fi1 in
- (match rest1 with {desc=Tnil|Tvar _|Tconstr _} -> true | _ -> false) &&
- let pairs, _miss1, miss2 = Ctype.associate_fields fields1 fields2 in
- miss2 = [] &&
- let tl1, tl2 =
- List.split (List.map (fun (_,_,t1,_,t2) -> t1, t2) pairs) in
- Ctype.equal env true (params1 @ tl1) (params2 @ tl2)
- | _ ->
- let rec check_super ty1 =
- Ctype.equal env true (ty1 :: params1) (ty2 :: params2) ||
- priv2 = Private &&
- try check_super
- (Ctype.try_expand_once_opt env (Ctype.expand_head env ty1))
- with Ctype.Cannot_expand -> false
- in check_super ty1
-
(* Inclusion between type declarations *)
-type position = Ctype.Unification_trace.position = First | Second
-
let choose ord first second =
match ord with
| First -> first
| Second -> choose First first second
type label_mismatch =
- | Type
+ | Type of Env.t * Errortrace.comparison Errortrace.t
| Mutability of position
type record_mismatch =
| Unboxed_float_representation of position
type constructor_mismatch =
- | Type
+ | Type of Env.t * Errortrace.comparison Errortrace.t
| Arity
| Inline_record of record_mismatch
| Kind of position
* Types.extension_constructor
* constructor_mismatch
+type private_variant_mismatch =
+ | Openness
+ | Missing of position * string
+ | Presence of string
+ | Incompatible_types_for of string
+ | Types of Env.t * Errortrace.comparison Errortrace.t
+
+type private_object_mismatch =
+ | Missing of string
+ | Types of Env.t * Errortrace.comparison Errortrace.t
+
type type_mismatch =
| Arity
| Privacy
| Kind
- | Constraint
- | Manifest
+ | Constraint of Env.t * Errortrace.comparison Errortrace.t
+ | Manifest of Env.t * Errortrace.comparison Errortrace.t
+ | Private_variant of type_expr * type_expr * private_variant_mismatch
+ | Private_object of type_expr * type_expr * private_object_mismatch
| Variance
| Record_mismatch of record_mismatch
| Variant_mismatch of variant_mismatch
let report_label_mismatch first second ppf err =
let pr fmt = Format.fprintf ppf fmt in
match (err : label_mismatch) with
- | Type -> pr "The types are not equal."
+ | Type _ -> pr "The types are not equal."
| Mutability ord ->
pr "%s is mutable and %s is not."
(String.capitalize_ascii (choose ord first second))
| Label_mismatch (l1, l2, err) ->
pr
"@[<hv>Fields do not match:@;<1 2>%a@ is not compatible with:\
- @;<1 2>%a@ %a"
+ @;<1 2>%a@ %a@]"
Printtyp.label l1
Printtyp.label l2
(report_label_mismatch first second) err
let report_constructor_mismatch first second decl ppf err =
let pr fmt = Format.fprintf ppf fmt in
match (err : constructor_mismatch) with
- | Type -> pr "The types are not equal."
+ | Type _ -> pr "The types are not equal."
| Arity -> pr "They have different arities."
| Inline_record err -> report_record_mismatch first second decl ppf err
| Kind ord ->
| Constructor_mismatch (c1, c2, err) ->
pr
"@[<hv>Constructors do not match:@;<1 2>%a@ is not compatible with:\
- @;<1 2>%a@ %a"
+ @;<1 2>%a@ %a@]"
Printtyp.constructor c1
Printtyp.constructor c2
(report_constructor_mismatch first second decl) err
| Arity -> pr "They have different arities."
| Privacy -> pr "A private type would be revealed."
| Kind -> pr "Their kinds differ."
- | Constraint -> pr "Their constraints differ."
- | Manifest -> ()
+ | Constraint _ -> pr "Their constraints differ."
+ | Manifest _ -> ()
+ | Private_variant _ -> ()
+ | Private_object _ -> ()
| Variance -> pr "Their variances do not agree."
| Record_mismatch err -> report_record_mismatch first second decl ppf err
| Variant_mismatch err -> report_variant_mismatch first second decl ppf err
first
let report_type_mismatch first second decl ppf err =
- if err = Manifest then () else
- Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
+ match err with
+ | Manifest _ -> ()
+ | Private_variant _ -> ()
+ | Private_object _ -> ()
+ | _ -> Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
let rec compare_constructor_arguments ~loc env params1 params2 arg1 arg2 =
match arg1, arg2 with
| Types.Cstr_tuple arg1, Types.Cstr_tuple arg2 ->
if List.length arg1 <> List.length arg2 then
Some (Arity : constructor_mismatch)
- else if
+ else begin
(* Ctype.equal must be called on all arguments at once, cf. PR#7378 *)
- Ctype.equal env true (params1 @ arg1) (params2 @ arg2)
- then None else Some Type
+ match Ctype.equal env true (params1 @ arg1) (params2 @ arg2) with
+ | exception Ctype.Equality trace -> Some (Type (env, trace))
+ | () -> None
+ end
| Types.Cstr_record l1, Types.Cstr_record l2 ->
Option.map
(fun rec_err -> Inline_record rec_err)
and compare_constructors ~loc env params1 params2 res1 res2 args1 args2 =
match res1, res2 with
- | Some r1, Some r2 ->
- if Ctype.equal env true [r1] [r2] then
- compare_constructor_arguments ~loc env [r1] [r2] args1 args2
- else Some Type
+ | Some r1, Some r2 -> begin
+ match Ctype.equal env true [r1] [r2] with
+ | exception Ctype.Equality trace -> Some (Type (env, trace))
+ | () -> compare_constructor_arguments ~loc env [r1] [r2] args1 args2
+ end
| Some _, None -> Some (Explicit_return_type First)
| None, Some _ -> Some (Explicit_return_type Second)
| None, None ->
| None -> compare_variants ~loc env params1 params2 (n+1) rem1 rem2
end
+and compare_variants_with_representation ~loc env params1 params2 n
+ cstrs1 cstrs2 rep1 rep2
+ =
+ let err = compare_variants ~loc env params1 params2 n cstrs1 cstrs2 in
+ match err, rep1, rep2 with
+ | None, Variant_regular, Variant_regular
+ | None, Variant_unboxed, Variant_unboxed ->
+ None
+ | Some err, _, _ ->
+ Some (Variant_mismatch err)
+ | None, Variant_unboxed, Variant_regular ->
+ Some (Unboxed_representation First)
+ | None, Variant_regular, Variant_unboxed ->
+ Some (Unboxed_representation Second)
+
and compare_labels env params1 params2
- (ld1 : Types.label_declaration)
- (ld2 : Types.label_declaration) =
- if ld1.ld_mutable <> ld2.ld_mutable
- then
- let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
- Some (Mutability ord)
- else
- if Ctype.equal env true (ld1.ld_type::params1) (ld2.ld_type::params2)
- then None
- else Some (Type : label_mismatch)
+ (ld1 : Types.label_declaration) (ld2 : Types.label_declaration) =
+ if ld1.ld_mutable <> ld2.ld_mutable then begin
+ let ord = if ld1.ld_mutable = Asttypes.Mutable then First else Second in
+ Some (Mutability ord)
+ end else begin
+ let tl1 = params1 @ [ld1.ld_type] in
+ let tl2 = params2 @ [ld2.ld_type] in
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality trace ->
+ Some (Type (env, trace) : label_mismatch)
+ | () -> None
+ end
and compare_records ~loc env params1 params2 n
(labels1 : Types.label_declaration list)
labels1 labels2 rep1 rep2
=
match compare_records ~loc env params1 params2 n labels1 labels2 with
- | None when rep1 <> rep2 ->
- let pos = if rep2 = Record_float then Second else First in
- Some (Unboxed_float_representation pos)
- | err -> err
+ | Some err -> Some (Record_mismatch err)
+ | None ->
+ match rep1, rep2 with
+ | Record_unboxed _, Record_unboxed _ -> None
+ | Record_unboxed _, _ -> Some (Unboxed_representation First)
+ | _, Record_unboxed _ -> Some (Unboxed_representation Second)
+
+ | Record_float, Record_float -> None
+ | Record_float, _ ->
+ Some (Record_mismatch (Unboxed_float_representation First))
+ | _, Record_float ->
+ Some (Record_mismatch (Unboxed_float_representation Second))
+
+ | Record_regular, Record_regular
+ | Record_inlined _, Record_inlined _
+ | Record_extension _, Record_extension _ -> None
+ | (Record_regular|Record_inlined _|Record_extension _),
+ (Record_regular|Record_inlined _|Record_extension _) ->
+ assert false
+
+let private_variant env row1 params1 row2 params2 =
+ let r1, r2, pairs =
+ Ctype.merge_row_fields row1.row_fields row2.row_fields
+ in
+ let err =
+ if row2.row_closed && not row1.row_closed then Some Openness
+ else begin
+ match row2.row_closed, Ctype.filter_row_fields false r1 with
+ | true, (s, _) :: _ ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | _, _ -> None
+ end
+ in
+ if err <> None then err else
+ let err =
+ let missing =
+ List.find_opt
+ (fun (_,f) ->
+ match Btype.row_field_repr f with
+ | Rabsent | Reither _ -> false
+ | Rpresent _ -> true)
+ r2
+ in
+ match missing with
+ | None -> None
+ | Some (s, _) -> Some (Missing (First, s) : private_variant_mismatch)
+ in
+ if err <> None then err else
+ let rec loop tl1 tl2 pairs =
+ match pairs with
+ | [] -> begin
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality trace ->
+ Some (Types (env, trace) : private_variant_mismatch)
+ | () -> None
+ end
+ | (s, f1, f2) :: pairs -> begin
+ match Btype.row_field_repr f1, Btype.row_field_repr f2 with
+ | Rpresent to1, Rpresent to2 -> begin
+ match to1, to2 with
+ | Some t1, Some t2 ->
+ loop (t1 :: tl1) (t2 :: tl2) pairs
+ | None, None ->
+ loop tl1 tl2 pairs
+ | Some _, None | None, Some _ ->
+ Some (Incompatible_types_for s)
+ end
+ | Rpresent to1, Reither(const2, ts2, _, _) -> begin
+ match to1, const2, ts2 with
+ | Some t1, false, [t2] -> loop (t1 :: tl1) (t2 :: tl2) pairs
+ | None, true, [] -> loop tl1 tl2 pairs
+ | _, _, _ -> Some (Incompatible_types_for s)
+ end
+ | Rpresent _, Rabsent ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | Reither(const1, ts1, _, _), Reither(const2, ts2, _, _) ->
+ if const1 = const2 && List.length ts1 = List.length ts2 then
+ loop (ts1 @ tl1) (ts2 @ tl2) pairs
+ else
+ Some (Incompatible_types_for s)
+ | Reither _, Rpresent _ ->
+ Some (Presence s)
+ | Reither _, Rabsent ->
+ Some (Missing (Second, s) : private_variant_mismatch)
+ | Rabsent, (Reither _ | Rabsent) ->
+ loop tl1 tl2 pairs
+ | Rabsent, Rpresent _ ->
+ Some (Missing (First, s) : private_variant_mismatch)
+ end
+ in
+ loop params1 params2 pairs
+
+let private_object env fields1 params1 fields2 params2 =
+ let pairs, _miss1, miss2 = Ctype.associate_fields fields1 fields2 in
+ let err =
+ match miss2 with
+ | [] -> None
+ | (f, _, _) :: _ -> Some (Missing f)
+ in
+ if err <> None then err else
+ let tl1, tl2 =
+ List.split (List.map (fun (_,_,t1,_,t2) -> t1, t2) pairs)
+ in
+ begin
+ match Ctype.equal env true (params1 @ tl1) (params2 @ tl2) with
+ | exception Ctype.Equality trace -> Some (Types (env, trace))
+ | () -> None
+ end
+
+let type_manifest env ty1 params1 ty2 params2 priv2 =
+ let ty1' = Ctype.expand_head env ty1 and ty2' = Ctype.expand_head env ty2 in
+ match ty1'.desc, ty2'.desc with
+ | Tvariant row1, Tvariant row2
+ when is_absrow env (Btype.row_more row2) -> begin
+ let row1 = Btype.row_repr row1 and row2 = Btype.row_repr row2 in
+ assert (Ctype.is_equal env true (ty1::params1) (row2.row_more::params2));
+ match private_variant env row1 params1 row2 params2 with
+ | None -> None
+ | Some err -> Some (Private_variant(ty1, ty2, err))
+ end
+ | Tobject (fi1, _), Tobject (fi2, _)
+ when is_absrow env (snd (Ctype.flatten_fields fi2)) -> begin
+ let (fields2,rest2) = Ctype.flatten_fields fi2 in
+ let (fields1,_) = Ctype.flatten_fields fi1 in
+ assert (Ctype.is_equal env true (ty1::params1) (rest2::params2));
+ match private_object env fields1 params1 fields2 params2 with
+ | None -> None
+ | Some err -> Some (Private_object(ty1, ty2, err))
+ end
+ | _ -> begin
+ match
+ match priv2 with
+ | Private -> Ctype.equal_private env params1 ty1 params2 ty2
+ | Public -> Ctype.equal env true (params1 @ [ty1]) (params2 @ [ty2])
+ with
+ | exception Ctype.Equality trace -> Some (Manifest (env, trace))
+ | () -> None
+ end
let type_declarations ?(equality = false) ~loc env ~mark name
decl1 path decl2 =
if not (private_flags decl1 decl2) then Some Privacy else
let err = match (decl1.type_manifest, decl2.type_manifest) with
(_, None) ->
- if Ctype.equal env true decl1.type_params decl2.type_params
- then None else Some Constraint
+ begin
+ match Ctype.equal env true decl1.type_params decl2.type_params with
+ | exception Ctype.Equality trace -> Some (Constraint(env, trace))
+ | () -> None
+ end
| (Some ty1, Some ty2) ->
- if type_manifest env ty1 decl1.type_params ty2 decl2.type_params
- decl2.type_private
- then None else Some Manifest
+ type_manifest env ty1 decl1.type_params ty2 decl2.type_params
+ decl2.type_private
| (None, Some ty2) ->
let ty1 =
Btype.newgenty (Tconstr(path, decl2.type_params, ref Mnil))
in
- if Ctype.equal env true decl1.type_params decl2.type_params then
- if Ctype.equal env false [ty1] [ty2] then None
- else Some Manifest
- else Some Constraint
- in
- if err <> None then err else
- let err =
- match (decl2.type_kind, decl1.type_unboxed.unboxed,
- decl2.type_unboxed.unboxed) with
- | Type_abstract, _, _ -> None
- | _, true, false -> Some (Unboxed_representation First)
- | _, false, true -> Some (Unboxed_representation Second)
- | _ -> None
+ match Ctype.equal env true decl1.type_params decl2.type_params with
+ | exception Ctype.Equality trace -> Some (Constraint(env, trace))
+ | () ->
+ match Ctype.equal env false [ty1] [ty2] with
+ | exception Ctype.Equality trace -> Some (Manifest(env, trace))
+ | () -> None
in
if err <> None then err else
let err = match (decl1.type_kind, decl2.type_kind) with
(_, Type_abstract) -> None
- | (Type_variant cstrs1, Type_variant cstrs2) ->
+ | (Type_variant (cstrs1, rep1), Type_variant (cstrs2, rep2)) ->
if mark then begin
let mark usage cstrs =
List.iter (Env.mark_constructor_used usage) cstrs
in
- let usage =
- if decl2.type_private = Public then Env.Positive
- else Env.Privatize
+ let usage : Env.constructor_usage =
+ if decl2.type_private = Public then Env.Exported
+ else Env.Exported_private
in
mark usage cstrs1;
- if equality then mark Env.Positive cstrs2
+ if equality then mark Env.Exported cstrs2
end;
- Option.map
- (fun var_err -> Variant_mismatch var_err)
- (compare_variants ~loc env decl1.type_params decl2.type_params 1
- cstrs1 cstrs2)
+ compare_variants_with_representation ~loc env
+ decl1.type_params decl2.type_params 1
+ cstrs1 cstrs2
+ rep1 rep2
| (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
- Option.map (fun rec_err -> Record_mismatch rec_err)
- (compare_records_with_representation ~loc env
- decl1.type_params decl2.type_params 1
- labels1 labels2
- rep1 rep2)
+ if mark then begin
+ let mark usage lbls =
+ List.iter (Env.mark_label_used usage) lbls
+ in
+ let usage : Env.label_usage =
+ if decl2.type_private = Public then Env.Exported
+ else Env.Exported_private
+ in
+ mark usage labels1;
+ if equality then mark Env.Exported labels2
+ end;
+ compare_records_with_representation ~loc env
+ decl1.type_params decl2.type_params 1
+ labels1 labels2
+ rep1 rep2
| (Type_open, Type_open) -> None
| (_, _) -> Some Kind
in
let extension_constructors ~loc env ~mark id ext1 ext2 =
if mark then begin
- let usage =
- if ext2.ext_private = Public then Env.Positive
- else Env.Privatize
+ let usage : Env.constructor_usage =
+ if ext2.ext_private = Public then Env.Exported
+ else Env.Exported_private
in
Env.mark_extension_used usage ext1
end;
let ty2 =
Btype.newgenty (Tconstr(ext2.ext_type_path, ext2.ext_type_params, ref Mnil))
in
- if not (Ctype.equal env true (ty1 :: ext1.ext_type_params)
- (ty2 :: ext2.ext_type_params))
- then Some (Constructor_mismatch (id, ext1, ext2, Type))
- else
+ let tl1 = ty1 :: ext1.ext_type_params in
+ let tl2 = ty2 :: ext2.ext_type_params in
+ match Ctype.equal env true tl1 tl2 with
+ | exception Ctype.Equality trace ->
+ Some (Constructor_mismatch (id, ext1, ext2, Type(env, trace)))
+ | () ->
let r =
- compare_constructors ~loc env ext1.ext_type_params ext2.ext_type_params
+ compare_constructors ~loc env
+ ext1.ext_type_params ext2.ext_type_params
ext1.ext_ret_type ext2.ext_ret_type
ext1.ext_args ext2.ext_args
in
match r with
| Some r -> Some (Constructor_mismatch (id, ext1, ext2, r))
- | None -> match ext1.ext_private, ext2.ext_private with
- Private, Public -> Some Constructor_privacy
+ | None ->
+ match ext1.ext_private, ext2.ext_private with
+ | Private, Public -> Some Constructor_privacy
| _, _ -> None
open Typedtree
open Types
-exception Dont_match
+type position = Errortrace.position = First | Second
-type position = Ctype.Unification_trace.position = First | Second
+type primitive_mismatch =
+ | Name
+ | Arity
+ | No_alloc of position
+ | Native_name
+ | Result_repr
+ | Argument_repr of int
+
+type value_mismatch =
+ | Primitive_mismatch of primitive_mismatch
+ | Not_a_primitive
+ | Type of Env.t * Errortrace.comparison Errortrace.t
+
+exception Dont_match of value_mismatch
type label_mismatch =
- | Type
+ | Type of Env.t * Errortrace.comparison Errortrace.t
| Mutability of position
type record_mismatch =
| Unboxed_float_representation of position
type constructor_mismatch =
- | Type
+ | Type of Env.t * Errortrace.comparison Errortrace.t
| Arity
| Inline_record of record_mismatch
| Kind of position
* extension_constructor
* constructor_mismatch
+type private_variant_mismatch =
+ | Openness
+ | Missing of position * string
+ | Presence of string
+ | Incompatible_types_for of string
+ | Types of Env.t * Errortrace.comparison Errortrace.t
+
+type private_object_mismatch =
+ | Missing of string
+ | Types of Env.t * Errortrace.comparison Errortrace.t
+
type type_mismatch =
| Arity
| Privacy
| Kind
- | Constraint
- | Manifest
+ | Constraint of Env.t * Errortrace.comparison Errortrace.t
+ | Manifest of Env.t * Errortrace.comparison Errortrace.t
+ | Private_variant of type_expr * type_expr * private_variant_mismatch
+ | Private_object of type_expr * type_expr * private_object_mismatch
| Variance
| Record_mismatch of record_mismatch
| Variant_mismatch of variant_mismatch
type symptom =
Missing_field of Ident.t * Location.t * string (* kind *)
| Value_descriptions of Ident.t * value_description * value_description
+ * Includecore.value_mismatch
| Type_declarations of Ident.t * type_declaration
* type_declaration * Includecore.type_mismatch
| Extension_constructors of Ident.t * extension_constructor
| Class_declarations of
Ident.t * class_declaration * class_declaration *
Ctype.class_match_failure list
- | Unbound_modtype_path of Path.t
| Unbound_module_path of Path.t
| Invalid_module_alias of Path.t
| Modtype of Ident.t
| Arg of functor_parameter
| Body of functor_parameter
-type error = pos list * Env.t * symptom
-exception Error of error list
-exception Apply_error of Location.t * Path.t * Path.t * error list
+
+module Error = struct
+
+ type functor_arg_descr =
+ | Anonymous
+ | Named of Path.t
+ | Unit
+
+ type ('a,'b) diff = {got:'a; expected:'a; symptom:'b}
+ type 'a core_diff =('a,unit) diff
+ let diff x y s = {got=x;expected=y; symptom=s}
+ let sdiff x y = {got=x; expected=y; symptom=()}
+
+ type core_sigitem_symptom =
+ | Value_descriptions of value_description core_diff
+ | Type_declarations of (type_declaration, Includecore.type_mismatch) diff
+ | Extension_constructors of
+ (extension_constructor, Includecore.extension_constructor_mismatch) diff
+ | Class_type_declarations of
+ (class_type_declaration, Ctype.class_match_failure list) diff
+ | Class_declarations of
+ (class_declaration, Ctype.class_match_failure list) diff
+
+ type core_module_type_symptom =
+ | Not_an_alias
+ | Not_an_identifier
+ | Incompatible_aliases
+ | Abstract_module_type
+ | Unbound_module_path of Path.t
+
+ type module_type_symptom =
+ | Mt_core of core_module_type_symptom
+ | Signature of signature_symptom
+ | Functor of functor_symptom
+ | Invalid_module_alias of Path.t
+ | After_alias_expansion of module_type_diff
+
+
+ and module_type_diff = (module_type, module_type_symptom) diff
+
+ and functor_symptom =
+ | Params of functor_params_diff
+ | Result of module_type_diff
+
+ and ('arg,'path) functor_param_symptom =
+ | Incompatible_params of 'arg * functor_parameter
+ | Mismatch of module_type_diff
+
+ and arg_functor_param_symptom =
+ (functor_parameter, Ident.t) functor_param_symptom
+
+ and functor_params_diff = (functor_parameter list * module_type) core_diff
+
+ and signature_symptom = {
+ env: Env.t;
+ missings: signature_item list;
+ incompatibles: (Ident.t * sigitem_symptom) list;
+ oks: (int * module_coercion) list;
+ }
+ and sigitem_symptom =
+ | Core of core_sigitem_symptom
+ | Module_type_declaration of
+ (modtype_declaration, module_type_declaration_symptom) diff
+ | Module_type of module_type_diff
+
+ and module_type_declaration_symptom =
+ | Illegal_permutation of Typedtree.module_coercion
+ | Not_greater_than of module_type_diff
+ | Not_less_than of module_type_diff
+ | Incomparable of
+ {less_than:module_type_diff; greater_than: module_type_diff}
+
+
+ type all =
+ | In_Compilation_unit of (string, signature_symptom) diff
+ | In_Signature of signature_symptom
+ | In_Module_type of module_type_diff
+ | In_Module_type_substitution of
+ Ident.t * (Types.module_type,module_type_declaration_symptom) diff
+ | In_Type_declaration of Ident.t * core_sigitem_symptom
+ | In_Expansion of core_module_type_symptom
+
+end
type mark =
| Mark_both
(* Inclusion between value descriptions *)
-let value_descriptions ~loc env ~mark cxt subst id vd1 vd2 =
+let value_descriptions ~loc env ~mark subst id vd1 vd2 =
Cmt_format.record_value_dependency vd1 vd2;
if mark_positive mark then
Env.mark_value_used vd1.val_uid;
let vd2 = Subst.value_description subst vd2 in
try
- Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2
- with Includecore.Dont_match ->
- raise(Error[cxt, env, Value_descriptions(id, vd1, vd2)])
+ Ok (Includecore.value_descriptions ~loc env (Ident.name id) vd1 vd2)
+ with Includecore.Dont_match _err ->
+ Error Error.(Core (Value_descriptions (sdiff vd1 vd2)))
(* Inclusion between type declarations *)
-let type_declarations ~loc env ~mark ?old_env:_ cxt subst id decl1 decl2 =
+let type_declarations ~loc env ~mark ?old_env:_ subst id decl1 decl2 =
let mark = mark_positive mark in
if mark then
Env.mark_type_used decl1.type_uid;
Includecore.type_declarations ~loc env ~mark
(Ident.name id) decl1 (Path.Pident id) decl2
with
- | None -> ()
+ | None -> Ok Tcoerce_none
| Some err ->
- raise(Error[cxt, env, Type_declarations(id, decl1, decl2, err)])
+ Error Error.(Core(Type_declarations (diff decl1 decl2 err)))
(* Inclusion between extension constructors *)
-let extension_constructors ~loc env ~mark cxt subst id ext1 ext2 =
+let extension_constructors ~loc env ~mark subst id ext1 ext2 =
let mark = mark_positive mark in
let ext2 = Subst.extension_constructor subst ext2 in
match Includecore.extension_constructors ~loc env ~mark id ext1 ext2 with
- | None -> ()
+ | None -> Ok Tcoerce_none
| Some err ->
- raise(Error[cxt, env, Extension_constructors(id, ext1, ext2, err)])
+ Error Error.(Core(Extension_constructors(diff ext1 ext2 err)))
(* Inclusion between class declarations *)
-let class_type_declarations ~loc ~old_env:_ env cxt subst id decl1 decl2 =
+let class_type_declarations ~loc ~old_env:_ env subst decl1 decl2 =
let decl2 = Subst.cltype_declaration subst decl2 in
match Includeclass.class_type_declarations ~loc env decl1 decl2 with
- [] -> ()
+ [] -> Ok Tcoerce_none
| reason ->
- raise(Error[cxt, env,
- Class_type_declarations(id, decl1, decl2, reason)])
+ Error Error.(Core(Class_type_declarations(diff decl1 decl2 reason)))
-let class_declarations ~old_env:_ env cxt subst id decl1 decl2 =
+let class_declarations ~old_env:_ env subst decl1 decl2 =
let decl2 = Subst.class_declaration subst decl2 in
match Includeclass.class_declarations env decl1 decl2 with
- [] -> ()
+ [] -> Ok Tcoerce_none
| reason ->
- raise(Error[cxt, env, Class_declarations(id, decl1, decl2, reason)])
+ Error Error.(Core(Class_declarations(diff decl1 decl2 reason)))
(* Expand a module type identifier when possible *)
-exception Dont_match
-
-let try_expand_modtype_path env path =
- try
- Env.find_modtype_expansion path env
- with Not_found -> raise Dont_match
+let expand_modtype_path env path =
+ match Env.find_modtype_expansion path env with
+ | exception Not_found -> None
+ | x -> Some x
-let expand_module_alias env cxt path =
- try (Env.find_module path env).md_type
- with Not_found ->
- raise(Error[cxt, env, Unbound_module_path path])
+let expand_module_alias env path =
+ match (Env.find_module path env).md_type with
+ | x -> Ok x
+ | exception Not_found -> Error (Error.Unbound_module_path path)
(* Extract name, kind and ident from a signature item *)
-type field_desc =
- Field_value of string
- | Field_type of string
- | Field_exception of string
- | Field_typext of string
- | Field_module of string
- | Field_modtype of string
- | Field_class of string
- | Field_classtype of string
-
-let kind_of_field_desc = function
- | Field_value _ -> "value"
- | Field_type _ -> "type"
- | Field_exception _ -> "exception"
- | Field_typext _ -> "extension constructor"
- | Field_module _ -> "module"
- | Field_modtype _ -> "module type"
- | Field_class _ -> "class"
- | Field_classtype _ -> "class type"
+type field_kind =
+ | Field_value
+ | Field_type
+ | Field_exception
+ | Field_typext
+ | Field_module
+ | Field_modtype
+ | Field_class
+ | Field_classtype
+
+
+
+type field_desc = { name: string; kind: field_kind }
+
+let kind_of_field_desc fd = match fd.kind with
+ | Field_value -> "value"
+ | Field_type -> "type"
+ | Field_exception -> "exception"
+ | Field_typext -> "extension constructor"
+ | Field_module -> "module"
+ | Field_modtype -> "module type"
+ | Field_class -> "class"
+ | Field_classtype -> "class type"
+
+let field_desc kind id = { kind; name = Ident.name id }
(** Map indexed by both field types and names.
This avoids name clashes between different sorts of fields
end)
let item_ident_name = function
- Sig_value(id, d, _) -> (id, d.val_loc, Field_value(Ident.name id))
- | Sig_type(id, d, _, _) -> (id, d.type_loc, Field_type(Ident.name id))
+ Sig_value(id, d, _) -> (id, d.val_loc, field_desc Field_value id)
+ | Sig_type(id, d, _, _) -> (id, d.type_loc, field_desc Field_type id )
| Sig_typext(id, d, _, _) ->
- let kind =
- if Path.same d.ext_type_path Predef.path_exn
- then Field_exception(Ident.name id)
- else Field_typext(Ident.name id)
- in
- (id, d.ext_loc, kind)
- | Sig_module(id, _, d, _, _) -> (id, d.md_loc, Field_module(Ident.name id))
- | Sig_modtype(id, d, _) -> (id, d.mtd_loc, Field_modtype(Ident.name id))
- | Sig_class(id, d, _, _) -> (id, d.cty_loc, Field_class(Ident.name id))
+ let kind =
+ if Path.same d.ext_type_path Predef.path_exn
+ then Field_exception
+ else Field_typext
+ in
+ (id, d.ext_loc, field_desc kind id)
+ | Sig_module(id, _, d, _, _) -> (id, d.md_loc, field_desc Field_module id)
+ | Sig_modtype(id, d, _) -> (id, d.mtd_loc, field_desc Field_modtype id)
+ | Sig_class(id, d, _, _) -> (id, d.cty_loc, field_desc Field_class id)
| Sig_class_type(id, d, _, _) ->
- (id, d.clty_loc, Field_classtype(Ident.name id))
+ (id, d.clty_loc, field_desc Field_classtype id)
let is_runtime_component = function
| Sig_value(_,{val_kind = Val_prim _}, _)
then Tcoerce_none
else Tcoerce_structure (cc, id_pos_list)
+let retrieve_functor_params env mty =
+ let rec retrieve_functor_params before env =
+ function
+ | Mty_ident p as res ->
+ begin match expand_modtype_path env p with
+ | Some mty -> retrieve_functor_params before env mty
+ | None -> List.rev before, res
+ end
+ | Mty_alias p as res ->
+ begin match expand_module_alias env p with
+ | Ok mty -> retrieve_functor_params before env mty
+ | Error _ -> List.rev before, res
+ end
+ | Mty_functor (p, res) -> retrieve_functor_params (p :: before) env res
+ | Mty_signature _ as res -> List.rev before, res
+ in
+ retrieve_functor_params [] env mty
+
(* Inclusion between module types.
Return the restriction that transforms a value of the smaller type
into a value of the bigger type. *)
-let rec modtypes ~loc env ~mark cxt subst mty1 mty2 =
- try
- try_modtypes ~loc env ~mark cxt subst mty1 mty2
- with
- Dont_match ->
- raise(Error[cxt, env,
- Module_types(mty1, Subst.modtype Make_local subst mty2)])
- | Error reasons as err ->
- match mty1, mty2 with
- Mty_alias _, _
- | _, Mty_alias _ -> raise err
- | _ ->
- raise(Error((cxt, env,
- Module_types(mty1, Subst.modtype Make_local subst mty2))
- :: reasons))
-
-and try_modtypes ~loc env ~mark cxt subst mty1 mty2 =
+let rec modtypes ~loc env ~mark subst mty1 mty2 =
+ match try_modtypes ~loc env ~mark subst mty1 mty2 with
+ | Ok _ as ok -> ok
+ | Error reason ->
+ let mty2 = Subst.modtype Make_local subst mty2 in
+ Error Error.(diff mty1 mty2 reason)
+
+and try_modtypes ~loc env ~mark subst mty1 mty2 =
match mty1, mty2 with
| (Mty_alias p1, Mty_alias p2) ->
if Env.is_functor_arg p2 env then
- raise (Error[cxt, env, Invalid_module_alias p2]);
- if not (equal_module_paths env p1 subst p2) then
- raise Dont_match;
- Tcoerce_none
- | (Mty_alias p1, _) ->
- let p1 = try
+ Error (Error.Invalid_module_alias p2)
+ else if not (equal_module_paths env p1 subst p2) then
+ Error Error.(Mt_core Incompatible_aliases)
+ else Ok Tcoerce_none
+ | (Mty_alias p1, _) -> begin
+ match
Env.normalize_module_path (Some Location.none) env p1
- with Env.Error (Env.Missing_module (_, _, path)) ->
- raise (Error[cxt, env, Unbound_module_path path])
- in
- let mty1 = expand_module_alias env cxt p1 in
- strengthened_modtypes ~loc ~aliasable:true env ~mark cxt
- subst mty1 p1 mty2
+ with
+ | exception Env.Error (Env.Missing_module (_, _, path)) ->
+ Error Error.(Mt_core(Unbound_module_path path))
+ | p1 ->
+ begin match expand_module_alias env p1 with
+ | Error e -> Error (Error.Mt_core e)
+ | Ok mty1 ->
+ match strengthened_modtypes ~loc ~aliasable:true env ~mark
+ subst mty1 p1 mty2
+ with
+ | Ok _ as x -> x
+ | Error reason -> Error (Error.After_alias_expansion reason)
+ end
+ end
| (Mty_ident p1, Mty_ident p2) ->
let p1 = Env.normalize_modtype_path env p1 in
let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
- if Path.same p1 p2 then Tcoerce_none
+ if Path.same p1 p2 then Ok Tcoerce_none
else
- try_modtypes ~loc env ~mark cxt subst
- (try_expand_modtype_path env p1)
- (try_expand_modtype_path env p2)
+ begin match expand_modtype_path env p1, expand_modtype_path env p2 with
+ | Some mty1, Some mty2 ->
+ try_modtypes ~loc env ~mark subst mty1 mty2
+ | None, _ | _, None -> Error (Error.Mt_core Abstract_module_type)
+ end
| (Mty_ident p1, _) ->
let p1 = Env.normalize_modtype_path env p1 in
- try_modtypes ~loc env ~mark cxt subst
- (try_expand_modtype_path env p1) mty2
+ begin match expand_modtype_path env p1 with
+ | Some p1 ->
+ try_modtypes ~loc env ~mark subst p1 mty2
+ | None -> Error (Error.Mt_core Abstract_module_type)
+ end
| (_, Mty_ident p2) ->
let p2 = Env.normalize_modtype_path env (Subst.modtype_path subst p2) in
- try_modtypes ~loc env ~mark cxt subst mty1
- (try_expand_modtype_path env p2)
+ begin match expand_modtype_path env p2 with
+ | Some p2 -> try_modtypes ~loc env ~mark subst mty1 p2
+ | None ->
+ begin match mty1 with
+ | Mty_functor _ ->
+ let params1 = retrieve_functor_params env mty1 in
+ let d = Error.sdiff params1 ([],mty2) in
+ Error Error.(Functor (Params d))
+ | _ -> Error Error.(Mt_core Not_an_identifier)
+ end
+ end
| (Mty_signature sig1, Mty_signature sig2) ->
- signatures ~loc env ~mark cxt subst sig1 sig2
- | (Mty_functor(Unit, res1), Mty_functor(Unit, res2)) ->
- begin
- match modtypes ~loc env ~mark (Body Unit::cxt) subst res1 res2 with
- | Tcoerce_none -> Tcoerce_none
- | cc -> Tcoerce_functor (Tcoerce_none, cc)
- end
- | (Mty_functor(Named (param1, arg1) as arg, res1),
- Mty_functor(Named (param2, arg2), res2)) ->
+ begin match signatures ~loc env ~mark subst sig1 sig2 with
+ | Ok _ as ok -> ok
+ | Error e -> Error (Error.Signature e)
+ end
+ | Mty_functor (param1, res1), Mty_functor (param2, res2) ->
+ let cc_arg, env, subst =
+ functor_param ~loc env ~mark:(negate_mark mark) subst param1 param2
+ in
+ let cc_res = modtypes ~loc env ~mark subst res1 res2 in
+ begin match cc_arg, cc_res with
+ | Ok Tcoerce_none, Ok Tcoerce_none -> Ok Tcoerce_none
+ | Ok cc_arg, Ok cc_res -> Ok (Tcoerce_functor(cc_arg, cc_res))
+ | _, Error {Error.symptom = Error.Functor Error.Params res; _} ->
+ let got_params, got_res = res.got in
+ let expected_params, expected_res = res.expected in
+ let d = Error.sdiff
+ (param1::got_params, got_res)
+ (param2::expected_params, expected_res) in
+ Error Error.(Functor (Params d))
+ | Error _, _ ->
+ let params1, res1 = retrieve_functor_params env res1 in
+ let params2, res2 = retrieve_functor_params env res2 in
+ let d = Error.sdiff (param1::params1, res1) (param2::params2, res2) in
+ Error Error.(Functor (Params d))
+ | Ok _, Error res ->
+ Error Error.(Functor (Result res))
+ end
+ | Mty_functor _, _
+ | _, Mty_functor _ ->
+ let params1 = retrieve_functor_params env mty1 in
+ let params2 = retrieve_functor_params env mty2 in
+ let d = Error.sdiff params1 params2 in
+ Error Error.(Functor (Params d))
+ | _, Mty_alias _ ->
+ Error (Error.Mt_core Error.Not_an_alias)
+
+(* Functor parameters *)
+
+and functor_param ~loc env ~mark subst param1 param2 = match param1, param2 with
+ | Unit, Unit ->
+ Ok Tcoerce_none, env, subst
+ | Named (name1, arg1), Named (name2, arg2) ->
let arg2' = Subst.modtype Keep subst arg2 in
let cc_arg =
- modtypes ~loc env ~mark:(negate_mark mark)
- (Arg arg::cxt) Subst.identity arg2' arg1
+ match modtypes ~loc env ~mark Subst.identity arg2' arg1 with
+ | Ok cc -> Ok cc
+ | Error err -> Error (Error.Mismatch err)
in
let env, subst =
- match param1, param2 with
- | Some p1, Some p2 ->
- Env.add_module p1 Mp_present arg2' env,
- Subst.add_module p2 (Path.Pident p1) subst
- | None, Some p2 ->
- Env.add_module p2 Mp_present arg2' env, subst
- | Some p1, None ->
- Env.add_module p1 Mp_present arg2' env, subst
+ match name1, name2 with
+ | Some id1, Some id2 ->
+ Env.add_module id1 Mp_present arg2' env,
+ Subst.add_module id2 (Path.Pident id1) subst
+ | None, Some id2 ->
+ Env.add_module id2 Mp_present arg2' env, subst
+ | Some id1, None ->
+ Env.add_module id1 Mp_present arg2' env, subst
| None, None ->
env, subst
in
- let cc_res = modtypes ~loc env ~mark (Body arg::cxt) subst res1 res2 in
- begin match (cc_arg, cc_res) with
- (Tcoerce_none, Tcoerce_none) -> Tcoerce_none
- | _ -> Tcoerce_functor(cc_arg, cc_res)
- end
- | (_, _) ->
- raise Dont_match
+ cc_arg, env, subst
+ | _, _ ->
+ Error (Error.Incompatible_params (param1, param2)), env, subst
-and strengthened_modtypes ~loc ~aliasable env ~mark cxt subst mty1 path1 mty2 =
+and strengthened_modtypes ~loc ~aliasable env ~mark subst mty1 path1 mty2 =
match mty1, mty2 with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
- Tcoerce_none
+ Ok Tcoerce_none
| _, _ ->
let mty1 = Mtype.strengthen ~aliasable env mty1 path1 in
- modtypes ~loc env ~mark cxt subst mty1 mty2
+ modtypes ~loc env ~mark subst mty1 mty2
-and strengthened_module_decl ~loc ~aliasable env ~mark cxt subst md1 path1 md2 =
+and strengthened_module_decl ~loc ~aliasable env ~mark subst md1 path1 md2 =
match md1.md_type, md2.md_type with
| Mty_ident p1, Mty_ident p2 when equal_modtype_paths env p1 subst p2 ->
- Tcoerce_none
+ Ok Tcoerce_none
| _, _ ->
let md1 = Mtype.strengthen_decl ~aliasable env md1 path1 in
- modtypes ~loc env ~mark cxt subst md1.md_type md2.md_type
+ modtypes ~loc env ~mark subst md1.md_type md2.md_type
(* Inclusion between signatures *)
-and signatures ~loc env ~mark cxt subst sig1 sig2 =
+and signatures ~loc env ~mark subst sig1 sig2 =
(* Environment used to check inclusion of components *)
let new_env =
Env.add_signature sig1 (Env.in_signature true env) in
and the coercion to be applied to it. *)
let rec pair_components subst paired unpaired = function
[] ->
- begin match unpaired with
- [] ->
- let cc =
- signature_components ~loc env ~mark new_env cxt subst
- (List.rev paired)
- in
- if len1 = len2 then (* see PR#5098 *)
- simplify_structure_coercion cc id_pos_list
- else
- Tcoerce_structure (cc, id_pos_list)
- | _ -> raise(Error unpaired)
+ let oks, errors =
+ signature_components ~loc env ~mark new_env subst (List.rev paired) in
+ begin match unpaired, errors, oks with
+ | [], [], cc ->
+ if len1 = len2 then (* see PR#5098 *)
+ Ok (simplify_structure_coercion cc id_pos_list)
+ else
+ Ok (Tcoerce_structure (cc, id_pos_list))
+ | missings, incompatibles, cc ->
+ Error { env=new_env; Error.missings; incompatibles; oks=cc }
end
| item2 :: rem ->
- let (id2, loc, name2) = item_ident_name item2 in
+ let (id2, _loc, name2) = item_ident_name item2 in
let name2, report =
match item2, name2 with
- Sig_type (_, {type_manifest=None}, _, _), Field_type s
+ Sig_type (_, {type_manifest=None}, _, _), {name=s; kind=Field_type}
when Btype.is_row_name s ->
(* Do not report in case of failure,
as the main type will generate an error *)
- Field_type (String.sub s 0 (String.length s - 4)), false
+ { kind=Field_type; name=String.sub s 0 (String.length s - 4) },
+ false
| _ -> name2, true
in
begin try
with Not_found ->
let unpaired =
if report then
- (cxt, env, Missing_field (id2, loc, kind_of_field_desc name2)) ::
- unpaired
+ item2 :: unpaired
else unpaired in
pair_components subst paired unpaired rem
end in
(* Inclusion between signature components *)
-and signature_components ~loc old_env ~mark env cxt subst paired =
- let comps_rec rem =
- signature_components ~loc old_env ~mark env cxt subst rem
- in
+and signature_components ~loc old_env ~mark env subst paired =
match paired with
- [] -> []
- | (Sig_value(id1, valdecl1, _), Sig_value(_id2, valdecl2, _), pos) :: rem ->
- let cc =
- value_descriptions ~loc env ~mark cxt subst id1 valdecl1 valdecl2
+ | [] -> [], []
+ | (sigi1, sigi2, pos) :: rem ->
+ let id, item, present_at_runtime =
+ match sigi1, sigi2 with
+ | Sig_value(id1, valdecl1, _) ,Sig_value(_id2, valdecl2, _) ->
+ let item =
+ value_descriptions ~loc env ~mark subst id1 valdecl1 valdecl2
+ in
+ let present_at_runtime = match valdecl2.val_kind with
+ | Val_prim _ -> false
+ | _ -> true
+ in
+ id1, item, present_at_runtime
+ | Sig_type(id1, tydec1, _, _), Sig_type(_id2, tydec2, _, _) ->
+ let item =
+ type_declarations ~loc ~old_env env ~mark subst id1 tydec1 tydec2
+ in
+ id1, item, false
+ | Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _) ->
+ let item =
+ extension_constructors ~loc env ~mark subst id1 ext1 ext2
+ in
+ id1, item, true
+ | Sig_module(id1, pres1, mty1, _, _), Sig_module(_, pres2, mty2, _, _)
+ -> begin
+ let item =
+ module_declarations ~loc env ~mark subst id1 mty1 mty2
+ in
+ let item =
+ Result.map_error (fun diff -> Error.Module_type diff) item
+ in
+ let present_at_runtime, item =
+ match pres1, pres2, mty1.md_type with
+ | Mp_present, Mp_present, _ -> true, item
+ | _, Mp_absent, _ -> false, item
+ | Mp_absent, Mp_present, Mty_alias p1 ->
+ true, Result.map (fun i -> Tcoerce_alias (env, p1, i)) item
+ | Mp_absent, Mp_present, _ -> assert false
+ in
+ id1, item, present_at_runtime
+ end
+ | Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _) ->
+ let item =
+ modtype_infos ~loc env ~mark subst id1 info1 info2
+ in
+ id1, item, false
+ | Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _) ->
+ let item =
+ class_declarations ~old_env env subst decl1 decl2
+ in
+ id1, item, true
+ | Sig_class_type(id1, info1, _, _), Sig_class_type(_id2, info2, _, _) ->
+ let item =
+ class_type_declarations ~loc ~old_env env subst info1 info2
+ in
+ id1, item, false
+ | _ ->
+ assert false
in
- begin match valdecl2.val_kind with
- Val_prim _ -> comps_rec rem
- | _ -> (pos, cc) :: comps_rec rem
- end
- | (Sig_type(id1, tydecl1, _, _), Sig_type(_id2, tydecl2, _, _), _pos) :: rem
- ->
- type_declarations ~loc ~old_env env ~mark cxt subst id1 tydecl1 tydecl2;
- comps_rec rem
- | (Sig_typext(id1, ext1, _, _), Sig_typext(_id2, ext2, _, _), pos)
- :: rem ->
- extension_constructors ~loc env ~mark cxt subst id1 ext1 ext2;
- (pos, Tcoerce_none) :: comps_rec rem
- | (Sig_module(id1, pres1, mty1, _, _),
- Sig_module(_id2, pres2, mty2, _, _), pos) :: rem -> begin
- let cc = module_declarations ~loc env ~mark cxt subst id1 mty1 mty2 in
- let rem = comps_rec rem in
- match pres1, pres2, mty1.md_type with
- | Mp_present, Mp_present, _ -> (pos, cc) :: rem
- | _, Mp_absent, _ -> rem
- | Mp_absent, Mp_present, Mty_alias p1 ->
- (pos, Tcoerce_alias (env, p1, cc)) :: rem
- | Mp_absent, Mp_present, _ -> assert false
- end
- | (Sig_modtype(id1, info1, _), Sig_modtype(_id2, info2, _), _pos) :: rem ->
- modtype_infos ~loc env ~mark cxt subst id1 info1 info2;
- comps_rec rem
- | (Sig_class(id1, decl1, _, _), Sig_class(_id2, decl2, _, _), pos) :: rem ->
- class_declarations ~old_env env cxt subst id1 decl1 decl2;
- (pos, Tcoerce_none) :: comps_rec rem
- | (Sig_class_type(id1, info1, _, _),
- Sig_class_type(_id2, info2, _, _), _pos) :: rem ->
- class_type_declarations ~loc ~old_env env cxt subst id1 info1 info2;
- comps_rec rem
- | _ ->
- assert false
-
-and module_declarations ~loc env ~mark cxt subst id1 md1 md2 =
+ let oks, errors =
+ signature_components ~loc old_env ~mark env subst rem
+ in
+ match item with
+ | Ok x when present_at_runtime -> (pos,x) :: oks, errors
+ | Ok _ -> oks, errors
+ | Error y -> oks , (id,y) :: errors
+
+and module_declarations ~loc env ~mark subst id1 md1 md2 =
Builtin_attributes.check_alerts_inclusion
~def:md1.md_loc
~use:md2.md_loc
let p1 = Path.Pident id1 in
if mark_positive mark then
Env.mark_module_used md1.md_uid;
- strengthened_modtypes ~loc ~aliasable:true env ~mark (Module id1::cxt) subst
+ strengthened_modtypes ~loc ~aliasable:true env ~mark subst
md1.md_type p1 md2.md_type
(* Inclusion between module type specifications *)
-and modtype_infos ~loc env ~mark cxt subst id info1 info2 =
+and modtype_infos ~loc env ~mark subst id info1 info2 =
Builtin_attributes.check_alerts_inclusion
~def:info1.mtd_loc
~use:info2.mtd_loc
info1.mtd_attributes info2.mtd_attributes
(Ident.name id);
let info2 = Subst.modtype_declaration Keep subst info2 in
- let cxt' = Modtype id :: cxt in
- try
+ let r =
match (info1.mtd_type, info2.mtd_type) with
- (None, None) -> ()
- | (Some _, None) -> ()
+ (None, None) -> Ok Tcoerce_none
+ | (Some _, None) -> Ok Tcoerce_none
| (Some mty1, Some mty2) ->
- check_modtype_equiv ~loc env ~mark cxt' mty1 mty2
+ check_modtype_equiv ~loc env ~mark mty1 mty2
| (None, Some mty2) ->
- check_modtype_equiv ~loc env ~mark cxt' (Mty_ident(Path.Pident id)) mty2
- with Error reasons ->
- raise(Error((cxt, env, Modtype_infos(id, info1, info2)) :: reasons))
+ check_modtype_equiv ~loc env ~mark (Mty_ident(Path.Pident id)) mty2 in
+ match r with
+ | Ok _ as ok -> ok
+ | Error e -> Error Error.(Module_type_declaration (diff info1 info2 e))
-and check_modtype_equiv ~loc env ~mark cxt mty1 mty2 =
+and check_modtype_equiv ~loc env ~mark mty1 mty2 =
match
- (modtypes ~loc env ~mark cxt Subst.identity mty1 mty2,
- modtypes ~loc env ~mark:(negate_mark mark) cxt Subst.identity mty2 mty1)
+ (modtypes ~loc env ~mark Subst.identity mty1 mty2,
+ modtypes ~loc env ~mark:(negate_mark mark) Subst.identity mty2 mty1)
with
- (Tcoerce_none, Tcoerce_none) -> ()
- | (c1, _c2) ->
+ (Ok Tcoerce_none, Ok Tcoerce_none) -> Ok Tcoerce_none
+ | (Ok c1, Ok _c2) ->
(* Format.eprintf "@[c1 = %a@ c2 = %a@]@."
print_coercion _c1 print_coercion _c2; *)
- raise(Error [cxt, env, Modtype_permutation (mty1, c1)])
+ Error Error.(Illegal_permutation c1)
+ | Ok _, Error e -> Error Error.(Not_greater_than e)
+ | Error e, Ok _ -> Error Error.(Not_less_than e)
+ | Error less_than, Error greater_than ->
+ Error Error.(Incomparable {less_than; greater_than})
+
(* Simplified inclusion check between module types (for Env) *)
in
no_apply path && not (Env.is_functor_arg path env)
-let check_modtype_inclusion ~loc env mty1 path1 mty2 =
+
+
+type explanation = Env.t * Error.all
+exception Error of explanation
+
+exception Apply_error of {
+ loc : Location.t ;
+ env : Env.t ;
+ lid_app : Longident.t option ;
+ mty_f : module_type ;
+ args : (Error.functor_arg_descr * module_type) list ;
+ }
+
+let check_modtype_inclusion_raw ~loc env mty1 path1 mty2 =
let aliasable = can_alias env path1 in
- ignore
- (strengthened_modtypes ~loc ~aliasable env ~mark:Mark_both []
- Subst.identity mty1 path1 mty2)
+ strengthened_modtypes ~loc ~aliasable env ~mark:Mark_both
+ Subst.identity mty1 path1 mty2
+
+let check_modtype_inclusion ~loc env mty1 path1 mty2 =
+ match check_modtype_inclusion_raw ~loc env mty1 path1 mty2 with
+ | Ok _ -> None
+ | Error e -> Some (env, Error.In_Module_type e)
+
+let check_functor_application_in_path
+ ~errors ~loc ~lid_whole_app ~f0_path ~args
+ ~arg_path ~arg_mty ~param_mty env =
+ match check_modtype_inclusion_raw ~loc env arg_mty arg_path param_mty with
+ | Ok _ -> ()
+ | Error _errs ->
+ if errors then
+ let prepare_arg (arg_path, arg_mty) =
+ let aliasable = can_alias env arg_path in
+ let smd = Mtype.strengthen ~aliasable env arg_mty arg_path in
+ (Error.Named arg_path, smd)
+ in
+ let mty_f = (Env.find_module f0_path env).md_type in
+ let args = List.map prepare_arg args in
+ let lid_app = Some lid_whole_app in
+ raise (Apply_error {loc; env; lid_app; mty_f; args})
+ else
+ raise Not_found
let () =
- Env.check_functor_application :=
- (fun ~errors ~loc env mty1 path1 mty2 path2 ->
- try
- check_modtype_inclusion ~loc env mty1 path1 mty2
- with Error errs ->
- if errors then
- raise (Apply_error(loc, path1, path2, errs))
- else
- raise Not_found)
+ Env.check_functor_application := check_functor_application_in_path
+
(* Check that an implementation of a compilation unit meets its
interface. *)
let compunit env ~mark impl_name impl_sig intf_name intf_sig =
- try
- signatures ~loc:(Location.in_file impl_name) env ~mark []
- Subst.identity impl_sig intf_sig
- with Error reasons ->
- raise(Error(([], Env.empty,Interface_mismatch(impl_name, intf_name))
- :: reasons))
+ match
+ signatures ~loc:(Location.in_file impl_name) env ~mark Subst.identity
+ impl_sig intf_sig
+ with Result.Error reasons ->
+ let cdiff =
+ Error.In_Compilation_unit(Error.diff impl_name intf_name reasons) in
+ raise(Error(env, cdiff))
+ | Ok x -> x
+
+(* Functor diffing computation:
+ The diffing computation uses the internal typing function
+ *)
+
+module Functor_inclusion_diff = struct
+ open Diffing
+
+ let param_name = function
+ | Named(x,_) -> x
+ | Unit -> None
+
+ let weight = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Change _ -> 10
+ | Keep (param1, param2, _) -> begin
+ match param_name param1, param_name param2 with
+ | None, None
+ -> 0
+ | Some n1, Some n2
+ when String.equal (Ident.name n1) (Ident.name n2)
+ -> 0
+ | Some _, Some _ -> 1
+ | Some _, None | None, Some _ -> 1
+ end
-(* Hide the context and substitution parameters to the outside world *)
+ type state = {
+ res: module_type option;
+ env: Env.t;
+ subst: Subst.t;
+ }
+
+ let keep_expansible_param = function
+ | Mty_ident _ | Mty_alias _ as mty -> Some mty
+ | Mty_signature _ | Mty_functor _ -> None
+
+ let lookup_expansion { env ; res ; _ } = match res with
+ | None -> None
+ | Some res ->
+ match retrieve_functor_params env res with
+ | [], _ -> None
+ | params, res ->
+ let more = Array.of_list params in
+ Some (keep_expansible_param res, more)
+
+ let expand_params state =
+ match lookup_expansion state with
+ | None -> state, [||]
+ | Some (res, expansion) -> { state with res }, expansion
+
+ let update d st = match d with
+ | Insert (Unit | Named (None,_))
+ | Delete (Unit | Named (None,_))
+ | Keep (Unit,_,_)
+ | Keep (_,Unit,_)
+ | Change (_,(Unit | Named (None,_)), _) ->
+ st, [||]
+ | Insert (Named (Some id, arg))
+ | Delete (Named (Some id, arg))
+ | Change (Unit, Named (Some id, arg), _) ->
+ let arg' = Subst.modtype Keep st.subst arg in
+ let env = Env.add_module id Mp_present arg' st.env in
+ expand_params { st with env }
+ | Keep (Named (name1, _), Named (name2, arg2), _)
+ | Change (Named (name1, _), Named (name2, arg2), _) -> begin
+ let arg' = Subst.modtype Keep st.subst arg2 in
+ match name1, name2 with
+ | Some id1, Some id2 ->
+ let env = Env.add_module id1 Mp_present arg' st.env in
+ let subst = Subst.add_module id2 (Path.Pident id1) st.subst in
+ expand_params { st with env; subst }
+ | None, Some id2 ->
+ let env = Env.add_module id2 Mp_present arg' st.env in
+ { st with env }, [||]
+ | Some id1, None ->
+ let env = Env.add_module id1 Mp_present arg' st.env in
+ expand_params { st with env }
+ | None, None ->
+ st, [||]
+ end
-let modtypes ~loc env ~mark mty1 mty2 =
- modtypes ~loc env ~mark [] Subst.identity mty1 mty2
-let signatures env ~mark sig1 sig2 =
- signatures ~loc:Location.none env ~mark [] Subst.identity sig1 sig2
-let type_declarations ~loc env ~mark id decl1 decl2 =
- type_declarations ~loc env ~mark [] Subst.identity id decl1 decl2
-let strengthened_module_decl ~loc ~aliasable env ~mark
- md1 path1 md2 =
- strengthened_module_decl ~loc ~aliasable env ~mark [] Subst.identity
- md1 path1 md2
-
-(*
-let modtypes env m1 m2 =
- let c = modtypes env m1 m2 in
- Format.eprintf "@[<2>modtypes@ %a@ %a =@ %a@]@."
- Printtyp.modtype m1 Printtyp.modtype m2
- print_coercion c;
- c
-*)
-
-(* Error report *)
-
-module Illegal_permutation = struct
- (** Extraction of information in case of illegal permutation
- in a module type *)
-
- (** When examining coercions, we only have runtime component indices,
- we use thus a limited version of {!pos}. *)
- type coerce_pos =
- | Item of int
- | InArg
- | InBody
-
- let either f x g y = match f x with
- | None -> g y
- | Some _ as v -> v
-
- (** We extract a lone transposition from a full tree of permutations. *)
- let rec transposition_under path = function
- | Tcoerce_structure(c,_) ->
- either
- (not_fixpoint path 0) c
- (first_non_id path 0) c
- | Tcoerce_functor(arg,res) ->
- either
- (transposition_under (InArg::path)) arg
- (transposition_under (InBody::path)) res
- | Tcoerce_none -> None
- | Tcoerce_alias _ | Tcoerce_primitive _ ->
- (* these coercions are not inversible, and raise an error earlier when
- checking for module type equivalence *)
- assert false
- (* we search the first point which is not invariant at the current level *)
- and not_fixpoint path pos = function
- | [] -> None
- | (n, _) :: q ->
- if n = pos then
- not_fixpoint path (pos+1) q
- else
- Some(List.rev path, pos, n)
- (* we search the first item with a non-identity inner coercion *)
- and first_non_id path pos = function
- | [] -> None
- | (_,Tcoerce_none) :: q -> first_non_id path (pos + 1) q
- | (_,c) :: q ->
- either
- (transposition_under (Item pos :: path)) c
- (first_non_id path (pos + 1)) q
-
- let transposition c =
- match transposition_under [] c with
- | None -> raise Not_found
- | Some x -> x
-
- let rec runtime_item k = function
- | [] -> raise Not_found
- | item :: q ->
- if not(is_runtime_component item) then
- runtime_item k q
- else if k = 0 then
- item
- else
- runtime_item (k-1) q
-
- (* Find module type at position [path] and convert the [coerce_pos] path to
- a [pos] path *)
- let rec find env ctx path mt = match mt, path with
- | (Mty_ident p | Mty_alias p), _ ->
- begin match (Env.find_modtype p env).mtd_type with
- | None -> raise Not_found
- | Some mt -> find env ctx path mt
+ let diff env (l1,res1) (l2,_) =
+ let update = Diffing.With_left_extensions update in
+ let test st mty1 mty2 =
+ let loc = Location.none in
+ let res, _, _ =
+ functor_param ~loc st.env ~mark:Mark_neither st.subst mty1 mty2
+ in
+ res
+ in
+ let param1 = Array.of_list l1 in
+ let param2 = Array.of_list l2 in
+ let state =
+ { env; subst = Subst.identity; res = keep_expansible_param res1}
+ in
+ Diffing.variadic_diff ~weight ~test ~update state param1 param2
+
+end
+
+module Functor_app_diff = struct
+ module I = Functor_inclusion_diff
+ open Diffing
+
+ let weight = function
+ | Insert _ -> 10
+ | Delete _ -> 10
+ | Change _ -> 10
+ | Keep (param1, param2, _) ->
+ (* We assign a small penalty to named arguments with
+ non-matching names *)
+ begin
+ let desc1 : Error.functor_arg_descr = fst param1 in
+ match desc1, I.param_name param2 with
+ | (Unit | Anonymous) , None
+ -> 0
+ | Named (Path.Pident n1), Some n2
+ when String.equal (Ident.name n1) (Ident.name n2)
+ -> 0
+ | Named _, Some _ -> 1
+ | Named _, None | (Unit | Anonymous), Some _ -> 1
+ end
+
+ let update (d: (_,Types.functor_parameter,_,_) change) (st:I.state) =
+ let open Error in
+ match d with
+ | Insert _
+ | Delete _
+ | Keep ((Unit,_),_,_)
+ | Keep (_,Unit,_)
+ | Change (_,(Unit | Named (None,_)), _ )
+ | Change ((Unit,_), Named (Some _, _), _) ->
+ st, [||]
+ | Keep ((Named arg, _mty) , Named (param_name, _param), _)
+ | Change ((Named arg, _mty), Named (param_name, _param), _) ->
+ begin match param_name with
+ | Some param ->
+ let res =
+ Option.map (fun res ->
+ let scope = Ctype.create_scope () in
+ let subst = Subst.add_module param arg Subst.identity in
+ Subst.modtype (Rescope scope) subst res
+ )
+ st.res
+ in
+ let subst = Subst.add_module param arg st.subst in
+ I.expand_params { st with subst; res }
+ | None ->
+ st, [||]
end
- | Mty_signature s , [] -> List.rev ctx, s
- | Mty_signature s, Item k :: q ->
- begin match runtime_item k s with
- | Sig_module (id, _, md,_,_) -> find env (Module id :: ctx) q md.md_type
- | _ -> raise Not_found
+ | Keep ((Anonymous, mty) , Named (param_name, _param), _)
+ | Change ((Anonymous, mty), Named (param_name, _param), _) -> begin
+ begin match param_name with
+ | Some param ->
+ let mty' = Subst.modtype Keep st.subst mty in
+ let env =
+ Env.add_module ~arg:true param Mp_present mty' st.env in
+ let res =
+ Option.map (Mtype.nondep_supertype env [param]) st.res in
+ I.expand_params { st with env; res}
+ | None ->
+ st, [||]
end
- | Mty_functor(Named (_,mt) as arg,_), InArg :: q ->
- find env (Arg arg :: ctx) q mt
- | Mty_functor(arg, mt), InBody :: q ->
- find env (Body arg :: ctx) q mt
- | _ -> raise Not_found
-
- let find env path mt = find env [] path mt
- let item mt k = item_ident_name (runtime_item k mt)
-
- let pp_item ppf (id,_,kind) =
- Format.fprintf ppf "%s %S" (kind_of_field_desc kind) (Ident.name id)
-
- let pp ctx_printer env ppf (mty,c) =
- try
- let p, k, l = transposition c in
- let ctx, mt = find env p mty in
- Format.fprintf ppf
- "@[<hv 2>Illegal permutation of runtime components in a module type.@ \
- @[For example,@ %a@[the %a@ and the %a are not in the same order@ \
- in the expected and actual module types.@]@]"
- ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
- with Not_found -> (* this should not happen *)
- Format.fprintf ppf
- "Illegal permutation of runtime components in a module type."
+ end
+
+ let diff env ~f ~args =
+ let params, res = retrieve_functor_params env f in
+ let update = Diffing.With_right_extensions update in
+ let test (state:I.state) (arg,arg_mty) param =
+ let loc = Location.none in
+ let res = match (arg:Error.functor_arg_descr), param with
+ | Unit, Unit -> Ok Tcoerce_none
+ | Unit, Named _ | (Anonymous | Named _), Unit ->
+ Result.Error (Error.Incompatible_params(arg,param))
+ | ( Anonymous | Named _ ) , Named (_, param) ->
+ match
+ modtypes ~loc state.env ~mark:Mark_neither state.subst
+ arg_mty param
+ with
+ | Error mty -> Result.Error (Error.Mismatch mty)
+ | Ok _ as x -> x
+ in
+ res
+ in
+ let args = Array.of_list args in
+ let params = Array.of_list params in
+ let state : I.state =
+ { env; subst = Subst.identity; res = I.keep_expansible_param res }
+ in
+ Diffing.variadic_diff ~weight ~test ~update state args params
end
-open Format
-
-let show_loc msg ppf loc =
- let pos = loc.Location.loc_start in
- if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
- else fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
-
-let show_locs ppf (loc1, loc2) =
- show_loc "Expected declaration" ppf loc2;
- show_loc "Actual declaration" ppf loc1
-
-let path_of_context = function
- Module id :: rem ->
- let rec subm path = function
- | [] -> path
- | Module id :: rem -> subm (Path.Pdot (path, Ident.name id)) rem
- | _ -> assert false
- in subm (Path.Pident id) rem
- | _ -> assert false
-
-
-let rec context ppf = function
- Module id :: rem ->
- fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
- | Modtype id :: rem ->
- fprintf ppf "@[<2>module type %a =@ %a@]"
- Printtyp.ident id context_mty rem
- | Body x :: rem ->
- fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
- | Arg x :: rem ->
- fprintf ppf "functor (%s : %a) -> ..." (argname x) context_mty rem
- | [] ->
- fprintf ppf "<here>"
-and context_mty ppf = function
- (Module _ | Modtype _) :: _ as rem ->
- fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
- | cxt -> context ppf cxt
-and args ppf = function
- Body x :: rem ->
- fprintf ppf "(%s)%a" (argname x) args rem
- | Arg x :: rem ->
- fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
- | cxt ->
- fprintf ppf " :@ %a" context_mty cxt
-and argname = function
- | Unit -> ""
- | Named (None, _) -> "_"
- | Named (Some id, _) -> Ident.name id
-
-let alt_context ppf cxt =
- if cxt = [] then () else
- if List.for_all (function Module _ -> true | _ -> false) cxt then
- fprintf ppf "in module %a,@ " Printtyp.path (path_of_context cxt)
- else
- fprintf ppf "@[<hv 2>at position@ %a,@]@ " context cxt
-
-let context ppf cxt =
- if cxt = [] then () else
- if List.for_all (function Module _ -> true | _ -> false) cxt then
- fprintf ppf "In module %a:@ " Printtyp.path (path_of_context cxt)
- else
- fprintf ppf "@[<hv 2>At position@ %a@]@ " context cxt
-
-let include_err env ppf = function
- | Missing_field (id, loc, kind) ->
- fprintf ppf "The %s `%a' is required but not provided"
- kind Printtyp.ident id;
- show_loc "Expected declaration" ppf loc
- | Value_descriptions(id, d1, d2) ->
- fprintf ppf
- "@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]"
- !Oprint.out_sig_item (Printtyp.tree_of_value_description id d1)
- !Oprint.out_sig_item (Printtyp.tree_of_value_description id d2);
- show_locs ppf (d1.val_loc, d2.val_loc)
- | Type_declarations(id, d1, d2, err) ->
- fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a@]"
- "Type declarations do not match"
- !Oprint.out_sig_item
- (Printtyp.tree_of_type_declaration id d1 Trec_first)
- "is not included in"
- !Oprint.out_sig_item
- (Printtyp.tree_of_type_declaration id d2 Trec_first)
- (Includecore.report_type_mismatch
- "the first" "the second" "declaration") err
- show_locs (d1.type_loc, d2.type_loc)
- | Extension_constructors(id, x1, x2, err) ->
- fprintf ppf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a@]"
- "Extension declarations do not match"
- !Oprint.out_sig_item
- (Printtyp.tree_of_extension_constructor id x1 Text_first)
- "is not included in"
- !Oprint.out_sig_item
- (Printtyp.tree_of_extension_constructor id x2 Text_first)
- (Includecore.report_extension_constructor_mismatch
- "the first" "the second" "declaration") err
- show_locs (x1.ext_loc, x2.ext_loc)
- | Module_types(mty1, mty2)->
- fprintf ppf
- "@[<hv 2>Modules do not match:@ \
- %a@;<1 -2>is not included in@ %a@]"
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
- !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
- | Modtype_infos(id, d1, d2) ->
- fprintf ppf
- "@[<hv 2>Module type declarations do not match:@ \
- %a@;<1 -2>does not match@ %a@]"
- !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d1)
- !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d2)
- | Modtype_permutation (mty,c) ->
- Illegal_permutation.pp alt_context env ppf (mty,c)
- | Interface_mismatch(impl_name, intf_name) ->
- fprintf ppf "@[The implementation %s@ does not match the interface %s:"
- impl_name intf_name
- | Class_type_declarations(id, d1, d2, reason) ->
- fprintf ppf
- "@[<hv 2>Class type declarations do not match:@ \
- %a@;<1 -2>does not match@ %a@]@ %a"
- !Oprint.out_sig_item
- (Printtyp.tree_of_cltype_declaration id d1 Trec_first)
- !Oprint.out_sig_item
- (Printtyp.tree_of_cltype_declaration id d2 Trec_first)
- Includeclass.report_error reason
- | Class_declarations(id, d1, d2, reason) ->
- fprintf ppf
- "@[<hv 2>Class declarations do not match:@ \
- %a@;<1 -2>does not match@ %a@]@ %a"
- !Oprint.out_sig_item (Printtyp.tree_of_class_declaration id d1 Trec_first)
- !Oprint.out_sig_item (Printtyp.tree_of_class_declaration id d2 Trec_first)
- Includeclass.report_error reason
- | Unbound_modtype_path path ->
- fprintf ppf "Unbound module type %a" Printtyp.path path
- | Unbound_module_path path ->
- fprintf ppf "Unbound module %a" Printtyp.path path
- | Invalid_module_alias path ->
- fprintf ppf "Module %a cannot be aliased" Printtyp.path path
-
-let include_err ppf (cxt, env, err) =
- Printtyp.wrap_printing_env ~error:true env (fun () ->
- fprintf ppf "@[<v>%a%a@]" context (List.rev cxt) (include_err env) err)
-
-let buffer = ref Bytes.empty
-let is_big obj =
- let size = !Clflags.error_size in
- size > 0 &&
- begin
- if Bytes.length !buffer < size then buffer := Bytes.create size;
- try ignore (Marshal.to_buffer !buffer 0 size obj []); false
- with _ -> true
- end
-
-let report_error ppf errs =
- if errs = [] then () else
- let (errs , err) = split_last errs in
- let pe = ref true in
- let include_err' ppf (_,_,obj as err) =
- if not (is_big obj) then fprintf ppf "%a@ " include_err err
- else if !pe then (fprintf ppf "...@ "; pe := false)
- in
- let print_errs ppf = List.iter (include_err' ppf) in
- Printtyp.Conflicts.reset();
- fprintf ppf "@[<v>%a%a%t@]" print_errs errs include_err err
- Printtyp.Conflicts.print_explanations
+(* Hide the context and substitution parameters to the outside world *)
-let report_apply_error p1 p2 ppf errs =
- fprintf ppf "@[The type of %a does not match %a's parameter@ %a@]"
- Printtyp.path p1 Printtyp.path p2 report_error errs
+let modtypes ~loc env ~mark mty1 mty2 =
+ match modtypes ~loc env ~mark Subst.identity mty1 mty2 with
+ | Ok x -> x
+ | Error reason -> raise (Error (env, Error.(In_Module_type reason)))
+let signatures env ~mark sig1 sig2 =
+ match signatures ~loc:Location.none env ~mark Subst.identity sig1 sig2 with
+ | Ok x -> x
+ | Error reason -> raise (Error(env,Error.(In_Signature reason)))
-(* We could do a better job to split the individual error items
- as sub-messages of the main interface mismatch on the whole unit. *)
-let () =
- Location.register_error_of_exn
- (function
- | Error err -> Some (Location.error_of_printer_file report_error err)
- | Apply_error(loc, p1, p2, err) ->
- Some (Location.error_of_printer ~loc (report_apply_error p1 p2) err)
- | _ -> None
- )
+let type_declarations ~loc env ~mark id decl1 decl2 =
+ match type_declarations ~loc env ~mark Subst.identity id decl1 decl2 with
+ | Ok _ -> ()
+ | Error (Error.Core reason) ->
+ raise (Error(env,Error.(In_Type_declaration(id,reason))))
+ | Error _ -> assert false
+
+let strengthened_module_decl ~loc ~aliasable env ~mark md1 path1 md2 =
+ match strengthened_module_decl ~loc ~aliasable env ~mark Subst.identity
+ md1 path1 md2 with
+ | Ok x -> x
+ | Error mdiff ->
+ raise (Error(env,Error.(In_Module_type mdiff)))
+
+let expand_module_alias env path =
+ match expand_module_alias env path with
+ | Ok x -> x
+ | Result.Error _ ->
+ raise (Error(env,In_Expansion(Error.Unbound_module_path path)))
+
+let check_modtype_equiv ~loc env id mty1 mty2 =
+ match check_modtype_equiv ~loc env ~mark:Mark_both mty1 mty2 with
+ | Ok _ -> ()
+ | Error e ->
+ raise (Error(env,
+ Error.(In_Module_type_substitution (id,diff mty1 mty2 e)))
+ )
open Typedtree
open Types
-open Format
(** Type describing which arguments of an inclusion to consider as used
for the usage warnings. [Mark_both] is the default. *)
| Mark_neither
(** Do not mark definitions used from either argument *)
+module Error: sig
+
+ type ('elt,'explanation) diff = {
+ got:'elt;
+ expected:'elt;
+ symptom:'explanation
+ }
+ type 'elt core_diff =('elt,unit) diff
+
+ type functor_arg_descr =
+ | Anonymous
+ | Named of Path.t
+ | Unit
+
+ type core_sigitem_symptom =
+ | Value_descriptions of Types.value_description core_diff
+ | Type_declarations of
+ (Types.type_declaration, Includecore.type_mismatch) diff
+ | Extension_constructors of
+ (Types.extension_constructor,
+ Includecore.extension_constructor_mismatch) diff
+ | Class_type_declarations of
+ (Types.class_type_declaration, Ctype.class_match_failure list) diff
+ | Class_declarations of
+ (Types.class_declaration, Ctype.class_match_failure list) diff
+
+ type core_module_type_symptom =
+ | Not_an_alias
+ | Not_an_identifier
+ | Incompatible_aliases
+ | Abstract_module_type
+ | Unbound_module_path of Path.t
+
+ type module_type_symptom =
+ | Mt_core of core_module_type_symptom
+ | Signature of signature_symptom
+ | Functor of functor_symptom
+ | Invalid_module_alias of Path.t
+ | After_alias_expansion of module_type_diff
+
+
+ and module_type_diff = (Types.module_type, module_type_symptom) diff
+
+ and functor_symptom =
+ | Params of functor_params_diff
+ | Result of module_type_diff
+
+ and ('arg,'path) functor_param_symptom =
+ | Incompatible_params of 'arg * Types.functor_parameter
+ | Mismatch of module_type_diff
+
+ and arg_functor_param_symptom =
+ (Types.functor_parameter, Ident.t) functor_param_symptom
+
+ and functor_params_diff =
+ (Types.functor_parameter list * Types.module_type) core_diff
+
+ and signature_symptom = {
+ env: Env.t;
+ missings: Types.signature_item list;
+ incompatibles: (Ident.t * sigitem_symptom) list;
+ oks: (int * Typedtree.module_coercion) list;
+ }
+ and sigitem_symptom =
+ | Core of core_sigitem_symptom
+ | Module_type_declaration of
+ (Types.modtype_declaration, module_type_declaration_symptom) diff
+ | Module_type of module_type_diff
+
+ and module_type_declaration_symptom =
+ | Illegal_permutation of Typedtree.module_coercion
+ | Not_greater_than of module_type_diff
+ | Not_less_than of module_type_diff
+ | Incomparable of
+ {less_than:module_type_diff; greater_than: module_type_diff}
+
+
+ type all =
+ | In_Compilation_unit of (string, signature_symptom) diff
+ | In_Signature of signature_symptom
+ | In_Module_type of module_type_diff
+ | In_Module_type_substitution of
+ Ident.t * (Types.module_type,module_type_declaration_symptom) diff
+ | In_Type_declaration of Ident.t * core_sigitem_symptom
+ | In_Expansion of core_module_type_symptom
+end
+type explanation = Env.t * Error.all
+
+(* Extract name, kind and ident from a signature item *)
+type field_kind =
+ | Field_value
+ | Field_type
+ | Field_exception
+ | Field_typext
+ | Field_module
+ | Field_modtype
+ | Field_class
+ | Field_classtype
+
+type field_desc = { name: string; kind: field_kind }
+
+val kind_of_field_desc: field_desc -> string
+val field_desc: field_kind -> Ident.t -> field_desc
+
+(** Map indexed by both field types and names.
+ This avoids name clashes between different sorts of fields
+ such as values and types. *)
+module FieldMap: Map.S with type key = field_desc
+
+val item_ident_name: Types.signature_item -> Ident.t * Location.t * field_desc
+val is_runtime_component: Types.signature_item -> bool
+
+
+(* Typechecking *)
+
val modtypes:
loc:Location.t -> Env.t -> mark:mark ->
module_type -> module_type -> module_coercion
val check_modtype_inclusion :
loc:Location.t -> Env.t -> Types.module_type -> Path.t -> Types.module_type ->
- unit
+ explanation option
(** [check_modtype_inclusion ~loc env mty1 path1 mty2] checks that the
functor application F(M) is well typed, where mty2 is the type of
the argument of F and path1/mty1 is the path/unstrenghened type of M. *)
+val check_modtype_equiv:
+ loc:Location.t -> Env.t -> Ident.t -> module_type -> module_type -> unit
+
val signatures: Env.t -> mark:mark ->
signature -> signature -> module_coercion
loc:Location.t -> Env.t -> mark:mark ->
Ident.t -> type_declaration -> type_declaration -> unit
-val print_coercion: formatter -> module_coercion -> unit
+val print_coercion: Format.formatter -> module_coercion -> unit
type symptom =
Missing_field of Ident.t * Location.t * string (* kind *)
- | Value_descriptions of Ident.t * value_description * value_description
+ | Value_descriptions of
+ Ident.t * value_description * value_description
+ * Includecore.value_mismatch
| Type_declarations of Ident.t * type_declaration
* type_declaration * Includecore.type_mismatch
| Extension_constructors of Ident.t * extension_constructor
| Class_declarations of
Ident.t * class_declaration * class_declaration *
Ctype.class_match_failure list
- | Unbound_modtype_path of Path.t
| Unbound_module_path of Path.t
| Invalid_module_alias of Path.t
| Modtype of Ident.t
| Arg of functor_parameter
| Body of functor_parameter
-type error = pos list * Env.t * symptom
-exception Error of error list
+exception Error of explanation
+exception Apply_error of {
+ loc : Location.t ;
+ env : Env.t ;
+ lid_app : Longident.t option ;
+ mty_f : module_type ;
+ args : (Error.functor_arg_descr * Types.module_type) list ;
+ }
+
+val expand_module_alias: Env.t -> Path.t -> Types.module_type
+
+module Functor_inclusion_diff: sig
+ val diff: Env.t ->
+ Types.functor_parameter list * Types.module_type ->
+ Types.functor_parameter list * Types.module_type ->
+ (Types.functor_parameter, Types.functor_parameter,
+ Typedtree.module_coercion,
+ (Types.functor_parameter, 'c) Error.functor_param_symptom)
+ Diffing.patch
+end
-val report_error: formatter -> error list -> unit
-val expand_module_alias: Env.t -> pos list -> Path.t -> Types.module_type
+module Functor_app_diff: sig
+ val diff:
+ Env.t ->
+ f:Types.module_type ->
+ args:(Error.functor_arg_descr * Types.module_type) list ->
+ (Error.functor_arg_descr * Types.module_type,
+ Types.functor_parameter, Typedtree.module_coercion,
+ (Error.functor_arg_descr, 'a) Error.functor_param_symptom)
+ Diffing.patch
+end
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+
+module Context = struct
+ type pos =
+ | Module of Ident.t
+ | Modtype of Ident.t
+ | Arg of Types.functor_parameter
+ | Body of Types.functor_parameter
+
+ let path_of_context = function
+ Module id :: rem ->
+ let rec subm path = function
+ | [] -> path
+ | Module id :: rem -> subm (Path.Pdot (path, Ident.name id)) rem
+ | _ -> assert false
+ in subm (Path.Pident id) rem
+ | _ -> assert false
+
+
+ let rec context ppf = function
+ Module id :: rem ->
+ Format.fprintf ppf "@[<2>module %a%a@]" Printtyp.ident id args rem
+ | Modtype id :: rem ->
+ Format.fprintf ppf "@[<2>module type %a =@ %a@]"
+ Printtyp.ident id context_mty rem
+ | Body x :: rem ->
+ Format.fprintf ppf "functor (%s) ->@ %a" (argname x) context_mty rem
+ | Arg x :: rem ->
+ Format.fprintf ppf "functor (%s : %a) -> ..."
+ (argname x) context_mty rem
+ | [] ->
+ Format.fprintf ppf "<here>"
+ and context_mty ppf = function
+ (Module _ | Modtype _) :: _ as rem ->
+ Format.fprintf ppf "@[<2>sig@ %a@;<1 -2>end@]" context rem
+ | cxt -> context ppf cxt
+ and args ppf = function
+ Body x :: rem ->
+ Format.fprintf ppf "(%s)%a" (argname x) args rem
+ | Arg x :: rem ->
+ Format.fprintf ppf "(%s :@ %a) : ..." (argname x) context_mty rem
+ | cxt ->
+ Format.fprintf ppf " :@ %a" context_mty cxt
+ and argname = function
+ | Types.Unit -> ""
+ | Types.Named (None, _) -> "_"
+ | Types.Named (Some id, _) -> Ident.name id
+
+ let alt_pp ppf cxt =
+ if cxt = [] then () else
+ if List.for_all (function Module _ -> true | _ -> false) cxt then
+ Format.fprintf ppf "in module %a," Printtyp.path (path_of_context cxt)
+ else
+ Format.fprintf ppf "@[<hv 2>at position@ %a,@]" context cxt
+
+ let pp ppf cxt =
+ if cxt = [] then () else
+ if List.for_all (function Module _ -> true | _ -> false) cxt then
+ Format.fprintf ppf "In module %a:@ " Printtyp.path (path_of_context cxt)
+ else
+ Format.fprintf ppf "@[<hv 2>At position@ %a@]@ " context cxt
+end
+
+module Illegal_permutation = struct
+ (** Extraction of information in case of illegal permutation
+ in a module type *)
+
+ (** When examining coercions, we only have runtime component indices,
+ we use thus a limited version of {!pos}. *)
+ type coerce_pos =
+ | Item of int
+ | InArg
+ | InBody
+
+ let either f x g y = match f x with
+ | None -> g y
+ | Some _ as v -> v
+
+ (** We extract a lone transposition from a full tree of permutations. *)
+ let rec transposition_under path (coerc:Typedtree.module_coercion) =
+ match coerc with
+ | Tcoerce_structure(c,_) ->
+ either
+ (not_fixpoint path 0) c
+ (first_non_id path 0) c
+ | Tcoerce_functor(arg,res) ->
+ either
+ (transposition_under (InArg::path)) arg
+ (transposition_under (InBody::path)) res
+ | Tcoerce_none -> None
+ | Tcoerce_alias _ | Tcoerce_primitive _ ->
+ (* these coercions are not inversible, and raise an error earlier when
+ checking for module type equivalence *)
+ assert false
+ (* we search the first point which is not invariant at the current level *)
+ and not_fixpoint path pos = function
+ | [] -> None
+ | (n, _) :: q ->
+ if n = pos then
+ not_fixpoint path (pos+1) q
+ else
+ Some(List.rev path, pos, n)
+ (* we search the first item with a non-identity inner coercion *)
+ and first_non_id path pos = function
+ | [] -> None
+ | (_, Typedtree.Tcoerce_none) :: q -> first_non_id path (pos + 1) q
+ | (_,c) :: q ->
+ either
+ (transposition_under (Item pos :: path)) c
+ (first_non_id path (pos + 1)) q
+
+ let transposition c =
+ match transposition_under [] c with
+ | None -> raise Not_found
+ | Some x -> x
+
+ let rec runtime_item k = function
+ | [] -> raise Not_found
+ | item :: q ->
+ if not(Includemod.is_runtime_component item) then
+ runtime_item k q
+ else if k = 0 then
+ item
+ else
+ runtime_item (k-1) q
+
+ (* Find module type at position [path] and convert the [coerce_pos] path to
+ a [pos] path *)
+ let rec find env ctx path (mt:Types.module_type) = match mt, path with
+ | (Mty_ident p | Mty_alias p), _ ->
+ begin match (Env.find_modtype p env).mtd_type with
+ | None -> raise Not_found
+ | Some mt -> find env ctx path mt
+ end
+ | Mty_signature s , [] -> List.rev ctx, s
+ | Mty_signature s, Item k :: q ->
+ begin match runtime_item k s with
+ | Sig_module (id, _, md,_,_) ->
+ find env (Context.Module id :: ctx) q md.md_type
+ | _ -> raise Not_found
+ end
+ | Mty_functor(Named (_,mt) as arg,_), InArg :: q ->
+ find env (Context.Arg arg :: ctx) q mt
+ | Mty_functor(arg, mt), InBody :: q ->
+ find env (Context.Body arg :: ctx) q mt
+ | _ -> raise Not_found
+
+ let find env path mt = find env [] path mt
+ let item mt k = Includemod.item_ident_name (runtime_item k mt)
+
+ let pp_item ppf (id,_,kind) =
+ Format.fprintf ppf "%s %S"
+ (Includemod.kind_of_field_desc kind)
+ (Ident.name id)
+
+ let pp ctx_printer env ppf (mty,c) =
+ try
+ let p, k, l = transposition c in
+ let ctx, mt = find env p mty in
+ Format.fprintf ppf
+ "@[<hv 2>Illegal permutation of runtime components in a module type.@ \
+ @[For example,@ %a@]@ @[the %a@ and the %a are not in the same order@ \
+ in the expected and actual module types.@]@]"
+ ctx_printer ctx pp_item (item mt k) pp_item (item mt l)
+ with Not_found -> (* this should not happen *)
+ Format.fprintf ppf
+ "Illegal permutation of runtime components in a module type."
+
+end
+
+
+
+module Err = Includemod.Error
+
+let buffer = ref Bytes.empty
+let is_big obj =
+ let size = !Clflags.error_size in
+ size > 0 &&
+ begin
+ if Bytes.length !buffer < size then buffer := Bytes.create size;
+ try ignore (Marshal.to_buffer !buffer 0 size obj []); false
+ with _ -> true
+ end
+
+let show_loc msg ppf loc =
+ let pos = loc.Location.loc_start in
+ if List.mem pos.Lexing.pos_fname [""; "_none_"; "//toplevel//"] then ()
+ else Format.fprintf ppf "@\n@[<2>%a:@ %s@]" Location.print_loc loc msg
+
+let show_locs ppf (loc1, loc2) =
+ show_loc "Expected declaration" ppf loc2;
+ show_loc "Actual declaration" ppf loc1
+
+
+let dmodtype mty =
+ let tmty = Printtyp.tree_of_modtype mty in
+ Format.dprintf "%a" !Oprint.out_module_type tmty
+
+let space ppf () = Format.fprintf ppf "@ "
+
+(**
+ In order to display a list of functor arguments in a compact format,
+ we introduce a notion of shorthand for functor arguments.
+ The aim is to first present the lists of actual and expected types with
+ shorthands:
+
+ (X: $S1) (Y: $S2) (Z: An_existing_module_type) ...
+ does not match
+ (X: $T1) (Y: A_real_path) (Z: $T3) ...
+
+ and delay the full display of the module types corresponding to $S1, $S2,
+ $T1, and $T3 to the suberror message.
+
+*)
+module With_shorthand = struct
+
+ (** A item with a potential shorthand name *)
+ type 'a named = {
+ item: 'a;
+ name : string;
+ }
+
+ type 'a t =
+ | Original of 'a (** The shorthand has been discarded *)
+ | Synthetic of 'a named
+ (** The shorthand is potentially useful *)
+
+ type functor_param =
+ | Unit
+ | Named of (Ident.t option * Types.module_type t)
+
+ (** Shorthand generation *)
+ type kind =
+ | Got
+ | Expected
+ | Unneeded
+
+ type variant =
+ | App
+ | Inclusion
+
+ let elide_if_app ctx s = match ctx with
+ | App -> Unneeded
+ | Inclusion -> s
+
+ let make side pos =
+ match side with
+ | Got -> Format.sprintf "$S%d" pos
+ | Expected -> Format.sprintf "$T%d" pos
+ | Unneeded -> "..."
+
+ (** Add shorthands to a patch *)
+ let patch ctx p =
+ let add_shorthand side pos mty =
+ {name = (make side pos); item = mty }
+ in
+ let aux i d =
+ let pos = i + 1 in
+ let d = match d with
+ | Diffing.Insert mty ->
+ Diffing.Insert (add_shorthand Expected pos mty)
+ | Diffing.Delete mty ->
+ Diffing.Delete (add_shorthand (elide_if_app ctx Got) pos mty)
+ | Diffing.Change (g, e, p) ->
+ Diffing.Change
+ (add_shorthand Got pos g,
+ add_shorthand Expected pos e, p)
+ | Diffing.Keep (g, e, p) ->
+ Diffing.Keep (add_shorthand Got pos g,
+ add_shorthand (elide_if_app ctx Expected) pos e, p)
+ in
+ pos, d
+ in
+ List.mapi aux p
+
+ (** Shorthand computation from named item *)
+ let modtype (r : _ named) = match r.item with
+ | Types.Mty_ident _
+ | Types.Mty_alias _
+ | Types.Mty_signature []
+ -> Original r.item
+ | Types.Mty_signature _ | Types.Mty_functor _
+ -> Synthetic r
+
+ let functor_param (ua : _ named) = match ua.item with
+ | Types.Unit -> Unit
+ | Types.Named (from, mty) ->
+ Named (from, modtype { ua with item = mty })
+
+ (** Printing of arguments with shorthands *)
+ let pp ppx = function
+ | Original x -> ppx x
+ | Synthetic s -> Format.dprintf "%s" s.name
+
+ let pp_orig ppx = function
+ | Original x | Synthetic { item=x; _ } -> ppx x
+
+ let definition x = match functor_param x with
+ | Unit -> Format.dprintf "()"
+ | Named(_,short_mty) ->
+ match short_mty with
+ | Original mty -> dmodtype mty
+ | Synthetic {name; item = mty} ->
+ Format.dprintf
+ "%s@ =@ %t" name (dmodtype mty)
+
+ let param x = match functor_param x with
+ | Unit -> Format.dprintf "()"
+ | Named (_, short_mty) ->
+ pp dmodtype short_mty
+
+ let qualified_param x = match functor_param x with
+ | Unit -> Format.dprintf "()"
+ | Named (None, Original (Mty_signature []) ) ->
+ Format.dprintf "(sig end)"
+ | Named (None, short_mty) ->
+ pp dmodtype short_mty
+ | Named (Some p, short_mty) ->
+ Format.dprintf "(%s : %t)"
+ (Ident.name p) (pp dmodtype short_mty)
+
+ let definition_of_argument ua =
+ let arg, mty = ua.item in
+ match (arg: Err.functor_arg_descr) with
+ | Unit -> Format.dprintf "()"
+ | Named p ->
+ let mty = modtype { ua with item = mty } in
+ Format.dprintf
+ "%a@ :@ %t"
+ Printtyp.path p
+ (pp_orig dmodtype mty)
+ | Anonymous ->
+ let short_mty = modtype { ua with item = mty } in
+ begin match short_mty with
+ | Original mty -> dmodtype mty
+ | Synthetic {name; item=mty} ->
+ Format.dprintf "%s@ :@ %t" name (dmodtype mty)
+ end
+
+ let arg ua =
+ let arg, mty = ua.item in
+ match (arg: Err.functor_arg_descr) with
+ | Unit -> Format.dprintf "()"
+ | Named p -> fun ppf -> Printtyp.path ppf p
+ | Anonymous ->
+ let short_mty = modtype { ua with item=mty } in
+ pp dmodtype short_mty
+
+end
+
+
+module Functor_suberror = struct
+ open Err
+
+ let style = function
+ | Diffing.Keep _ -> Misc.Color.[ FG Green ]
+ | Diffing.Delete _ -> Misc.Color.[ FG Red; Bold]
+ | Diffing.Insert _ -> Misc.Color.[ FG Red; Bold]
+ | Diffing.Change _ -> Misc.Color.[ FG Magenta; Bold]
+
+ let prefix ppf (pos, p) =
+ let sty = style p in
+ Format.pp_open_stag ppf (Misc.Color.Style sty);
+ Format.fprintf ppf "%i." pos;
+ Format.pp_close_stag ppf ()
+
+ let param_id x = match x.With_shorthand.item with
+ | Types.Named (Some _ as x,_) -> x
+ | Types.(Unit | Named(None,_)) -> None
+
+ (** Print the list of params with style *)
+ let pretty_params sep proj printer patch =
+ let elt (x,param) =
+ let sty = style x in
+ Format.dprintf "%a%t%a"
+ Format.pp_open_stag (Misc.Color.Style sty)
+ (printer param)
+ Format.pp_close_stag ()
+ in
+ let params = List.filter_map proj @@ List.map snd patch in
+ Printtyp.functor_parameters ~sep elt params
+
+ let expected d =
+ let extract = function
+ | Diffing.Insert mty
+ | Diffing.Keep(_,mty,_)
+ | Diffing.Change (_,mty,_) as x ->
+ Some (param_id mty,(x, mty))
+ | Diffing.Delete _ -> None
+ in
+ pretty_params space extract With_shorthand.qualified_param d
+
+ let drop_inserted_suffix patch =
+ let rec drop = function
+ | Diffing.Insert _ :: q -> drop q
+ | rest -> List.rev rest in
+ drop (List.rev patch)
+
+ let prepare_patch ~drop ~ctx patch =
+ let drop_suffix x = if drop then drop_inserted_suffix x else x in
+ patch |> drop_suffix |> With_shorthand.patch ctx
+
+
+ module Inclusion = struct
+
+ let got d =
+ let extract = function
+ | Diffing.Delete mty
+ | Diffing.Keep (mty,_,_)
+ | Diffing.Change (mty,_,_) as x ->
+ Some (param_id mty,(x,mty))
+ | Diffing.Insert _ -> None
+ in
+ pretty_params space extract With_shorthand.qualified_param d
+
+ let insert mty =
+ Format.dprintf
+ "An argument appears to be missing with module type@;<1 2>@[%t@]"
+ (With_shorthand.definition mty)
+
+ let delete mty =
+ Format.dprintf
+ "An extra argument is provided of module type@;<1 2>@[%t@]"
+ (With_shorthand.definition mty)
+
+ let ok x y =
+ Format.dprintf
+ "Module types %t and %t match"
+ (With_shorthand.param x)
+ (With_shorthand.param y)
+
+ let diff g e more =
+ let g = With_shorthand.definition g in
+ let e = With_shorthand.definition e in
+ Format.dprintf
+ "Module types do not match:@ @[%t@]@;<1 -2>does not include@ \
+ @[%t@]%t"
+ g e (more ())
+
+ let incompatible = function
+ | Types.Unit ->
+ Format.dprintf
+ "The functor was expected to be applicative at this position"
+ | Types.Named _ ->
+ Format.dprintf
+ "The functor was expected to be generative at this position"
+
+ let patch env got expected =
+ Includemod.Functor_inclusion_diff.diff env got expected
+ |> prepare_patch ~drop:false ~ctx:Inclusion
+
+ end
+
+ module App = struct
+
+ let patch env ~f ~args =
+ Includemod.Functor_app_diff.diff env ~f ~args
+ |> prepare_patch ~drop:true ~ctx:App
+
+ let got d =
+ let extract = function
+ | Diffing.Delete mty
+ | Diffing.Keep (mty,_,_)
+ | Diffing.Change (mty,_,_) as x ->
+ Some (None,(x,mty))
+ | Diffing.Insert _ -> None
+ in
+ pretty_params space extract With_shorthand.arg d
+
+ let delete mty =
+ Format.dprintf
+ "The following extra argument is provided@;<1 2>@[%t@]"
+ (With_shorthand.definition_of_argument mty)
+
+ let insert = Inclusion.insert
+
+ let ok x y =
+ let pp_orig_name = match With_shorthand.functor_param y with
+ | With_shorthand.Named (_, Original mty) ->
+ Format.dprintf " %t" (dmodtype mty)
+ | _ -> ignore
+ in
+ Format.dprintf
+ "Module %t matches the expected module type%t"
+ (With_shorthand.arg x)
+ pp_orig_name
+
+ let diff g e more =
+ let g = With_shorthand.definition_of_argument g in
+ let e = With_shorthand.definition e in
+ Format.dprintf
+ "Modules do not match:@ @[%t@]@;<1 -2>\
+ is not included in@ @[%t@]%t"
+ g e (more ())
+
+ (** Specialized to avoid introducing shorthand names
+ for single change difference
+ *)
+ let single_diff g e more =
+ let _arg, mty = g.With_shorthand.item in
+ let e = match e.With_shorthand.item with
+ | Types.Unit -> Format.dprintf "()"
+ | Types.Named(_, mty) -> dmodtype mty
+ in
+ Format.dprintf
+ "Modules do not match:@ @[%t@]@;<1 -2>\
+ is not included in@ @[%t@]%t"
+ (dmodtype mty) e (more ())
+
+
+ let incompatible = function
+ | Unit ->
+ Format.dprintf
+ "The functor was expected to be applicative at this position"
+ | Named _ | Anonymous ->
+ Format.dprintf
+ "The functor was expected to be generative at this position"
+
+ end
+
+ let subcase sub ~expansion_token env (pos, diff) =
+ Location.msg "%a%a%a %a@[<hv 2>%t@]%a"
+ Format.pp_print_tab ()
+ Format.pp_open_tbox ()
+ prefix (pos, diff)
+ Format.pp_set_tab ()
+ (Printtyp.wrap_printing_env env ~error:true
+ (fun () -> sub ~expansion_token env diff)
+ )
+ Format.pp_close_tbox ()
+
+ let onlycase sub ~expansion_token env (_, diff) =
+ Location.msg "%a@[<hv 2>%t@]"
+ Format.pp_print_tab ()
+ (Printtyp.wrap_printing_env env ~error:true
+ (fun () -> sub ~expansion_token env diff)
+ )
+
+ let params sub ~expansion_token env l =
+ let rec aux subcases = function
+ | [] -> subcases
+ | (_, Diffing.Keep _) as a :: q ->
+ aux (subcase sub ~expansion_token env a :: subcases) q
+ | a :: q ->
+ List.fold_left (fun acc x ->
+ (subcase sub ~expansion_token:false env x) :: acc
+ )
+ (subcase sub ~expansion_token env a :: subcases)
+ q
+ in
+ match l with
+ | [a] -> [onlycase sub ~expansion_token env a]
+ | l -> aux [] l
+end
+
+
+(** Construct a linear presentation of the error tree *)
+
+open Err
+
+(* Context helper functions *)
+let with_context ?loc ctx printer diff =
+ Location.msg ?loc "%a%a" Context.pp (List.rev ctx)
+ printer diff
+
+let dwith_context ?loc ctx printer =
+ Location.msg ?loc "%a%t" Context.pp (List.rev ctx) printer
+
+let dwith_context_and_elision ?loc ctx printer diff =
+ if is_big (diff.got,diff.expected) then
+ Location.msg ?loc "..."
+ else
+ dwith_context ?loc ctx (printer diff)
+
+(* Merge sub msgs into one printer *)
+let coalesce msgs =
+ match List.rev msgs with
+ | [] -> ignore
+ | before ->
+ let ctx ppf =
+ Format.pp_print_list ~pp_sep:space
+ (fun ppf x -> x.Location.txt ppf)
+ ppf before in
+ ctx
+
+let subcase_list l ppf = match l with
+ | [] -> ()
+ | _ :: _ ->
+ Format.fprintf ppf "@;<1 -2>@[%a@]"
+ (Format.pp_print_list ~pp_sep:space
+ (fun ppf f -> f.Location.txt ppf)
+ )
+ (List.rev l)
+
+(* Printers for leaves *)
+let core id x =
+ match x with
+ | Err.Value_descriptions diff ->
+ let t1 = Printtyp.tree_of_value_description id diff.got in
+ let t2 = Printtyp.tree_of_value_description id diff.expected in
+ Format.dprintf
+ "@[<hv 2>Values do not match:@ %a@;<1 -2>is not included in@ %a@]%a%t"
+ !Oprint.out_sig_item t1
+ !Oprint.out_sig_item t2
+ show_locs (diff.got.val_loc, diff.expected.val_loc)
+ Printtyp.Conflicts.print_explanations
+ | Err.Type_declarations diff ->
+ Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]%a%a%t@]"
+ "Type declarations do not match"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_type_declaration id diff.got Trec_first)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_type_declaration id diff.expected Trec_first)
+ (Includecore.report_type_mismatch
+ "the first" "the second" "declaration") diff.symptom
+ show_locs (diff.got.type_loc, diff.expected.type_loc)
+ Printtyp.Conflicts.print_explanations
+ | Err.Extension_constructors diff ->
+ Format.dprintf "@[<v>@[<hv>%s:@;<1 2>%a@ %s@;<1 2>%a@]@ %a%a%t@]"
+ "Extension declarations do not match"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_extension_constructor id diff.got Text_first)
+ "is not included in"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_extension_constructor id diff.expected Text_first)
+ (Includecore.report_extension_constructor_mismatch
+ "the first" "the second" "declaration") diff.symptom
+ show_locs (diff.got.ext_loc, diff.expected.ext_loc)
+ Printtyp.Conflicts.print_explanations
+ | Err.Class_type_declarations diff ->
+ Format.dprintf
+ "@[<hv 2>Class type declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]@ %a%t"
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_cltype_declaration id diff.got Trec_first)
+ !Oprint.out_sig_item
+ (Printtyp.tree_of_cltype_declaration id diff.expected Trec_first)
+ Includeclass.report_error diff.symptom
+ Printtyp.Conflicts.print_explanations
+ | Err.Class_declarations {got;expected;symptom} ->
+ let t1 = Printtyp.tree_of_class_declaration id got Trec_first in
+ let t2 = Printtyp.tree_of_class_declaration id expected Trec_first in
+ Format.dprintf
+ "@[<hv 2>Class declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]@ %a%t"
+ !Oprint.out_sig_item t1
+ !Oprint.out_sig_item t2
+ Includeclass.report_error symptom
+ Printtyp.Conflicts.print_explanations
+
+let missing_field ppf item =
+ let id, loc, kind = Includemod.item_ident_name item in
+ Format.fprintf ppf "The %s `%a' is required but not provided%a"
+ (Includemod.kind_of_field_desc kind) Printtyp.ident id
+ (show_loc "Expected declaration") loc
+
+let module_types {Err.got=mty1; expected=mty2} =
+ Format.dprintf
+ "@[<hv 2>Modules do not match:@ \
+ %a@;<1 -2>is not included in@ %a@]"
+ !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
+ !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+
+let eq_module_types {Err.got=mty1; expected=mty2} =
+ Format.dprintf
+ "@[<hv 2>Module types do not match:@ \
+ %a@;<1 -2>is not equal to@ %a@]"
+ !Oprint.out_module_type (Printtyp.tree_of_modtype mty1)
+ !Oprint.out_module_type (Printtyp.tree_of_modtype mty2)
+
+let module_type_declarations id {Err.got=d1 ; expected=d2} =
+ Format.dprintf
+ "@[<hv 2>Module type declarations do not match:@ \
+ %a@;<1 -2>does not match@ %a@]"
+ !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d1)
+ !Oprint.out_sig_item (Printtyp.tree_of_modtype_declaration id d2)
+
+let interface_mismatch ppf (diff: _ Err.diff) =
+ Format.fprintf ppf
+ "The implementation %s@ does not match the interface %s:@ "
+ diff.got diff.expected
+
+let core_module_type_symptom (x:Err.core_module_type_symptom) =
+ match x with
+ | Not_an_alias | Not_an_identifier | Abstract_module_type
+ | Incompatible_aliases ->
+ if Printtyp.Conflicts.exists () then
+ Some Printtyp.Conflicts.print_explanations
+ else None
+ | Unbound_module_path path ->
+ Some(Format.dprintf "Unbound module %a" Printtyp.path path)
+
+(* Construct a linearized error message from the error tree *)
+
+let rec module_type ~expansion_token ~eqmode ~env ~before ~ctx diff =
+ match diff.symptom with
+ | Invalid_module_alias _ (* the difference is non-informative here *)
+ | After_alias_expansion _ (* we print only the expanded module types *) ->
+ module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
+ diff.symptom
+ | Functor Params d -> (* We jump directly to the functor param error *)
+ functor_params ~expansion_token ~env ~before ~ctx d
+ | _ ->
+ let inner = if eqmode then eq_module_types else module_types in
+ let next = dwith_context_and_elision ctx inner diff in
+ let before = next :: before in
+ module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx
+ diff.symptom
+
+and module_type_symptom ~eqmode ~expansion_token ~env ~before ~ctx = function
+ | Mt_core core ->
+ begin match core_module_type_symptom core with
+ | None -> before
+ | Some msg -> Location.msg "%t" msg :: before
+ end
+ | Signature s -> signature ~expansion_token ~env ~before ~ctx s
+ | Functor f -> functor_symptom ~expansion_token ~env ~before ~ctx f
+ | After_alias_expansion diff ->
+ module_type ~eqmode ~expansion_token ~env ~before ~ctx diff
+ | Invalid_module_alias path ->
+ let printer =
+ Format.dprintf "Module %a cannot be aliased" Printtyp.path path
+ in
+ dwith_context ctx printer :: before
+
+and functor_params ~expansion_token ~env ~before ~ctx {got;expected;_} =
+ let d = Functor_suberror.Inclusion.patch env got expected in
+ let actual = Functor_suberror.Inclusion.got d in
+ let expected = Functor_suberror.expected d in
+ let main =
+ Format.dprintf
+ "@[<hv 2>Modules do not match:@ \
+ @[functor@ %t@ -> ...@]@;<1 -2>is not included in@ \
+ @[functor@ %t@ -> ...@]@]"
+ actual expected
+ in
+ let msgs = dwith_context ctx main :: before in
+ let functor_suberrors =
+ if expansion_token then
+ Functor_suberror.params functor_arg_diff ~expansion_token env d
+ else []
+ in
+ functor_suberrors @ msgs
+
+and functor_symptom ~expansion_token ~env ~before ~ctx = function
+ | Result res ->
+ module_type ~expansion_token ~eqmode:false ~env ~before ~ctx res
+ | Params d -> functor_params ~expansion_token ~env ~before ~ctx d
+
+and signature ~expansion_token ~env:_ ~before ~ctx sgs =
+ Printtyp.wrap_printing_env ~error:true sgs.env (fun () ->
+ match sgs.missings, sgs.incompatibles with
+ | a :: l , _ ->
+ if expansion_token then
+ with_context ctx missing_field a
+ :: List.map (Location.msg "%a" missing_field) l
+ @ before
+ else
+ before
+ | [], a :: _ -> sigitem ~expansion_token ~env:sgs.env ~before ~ctx a
+ | [], [] -> assert false
+ )
+and sigitem ~expansion_token ~env ~before ~ctx (name,s) = match s with
+ | Core c ->
+ dwith_context ctx (core name c):: before
+ | Module_type diff ->
+ module_type ~expansion_token ~eqmode:false ~env ~before
+ ~ctx:(Context.Module name :: ctx) diff
+ | Module_type_declaration diff ->
+ module_type_decl ~expansion_token ~env ~before ~ctx name diff
+and module_type_decl ~expansion_token ~env ~before ~ctx id diff =
+ let next =
+ dwith_context_and_elision ctx (module_type_declarations id) diff in
+ let before = next :: before in
+ match diff.symptom with
+ | Not_less_than mts ->
+ let before =
+ Location.msg "The first module type is not included in the second"
+ :: before
+ in
+ module_type ~expansion_token ~eqmode:true ~before ~env
+ ~ctx:(Context.Modtype id :: ctx) mts
+ | Not_greater_than mts ->
+ let before =
+ Location.msg "The second module type is not included in the first"
+ :: before in
+ module_type ~expansion_token ~eqmode:true ~before ~env
+ ~ctx:(Context.Modtype id :: ctx) mts
+ | Incomparable mts ->
+ module_type ~expansion_token ~eqmode:true ~env ~before
+ ~ctx:(Context.Modtype id :: ctx) mts.less_than
+ | Illegal_permutation c ->
+ begin match diff.got.Types.mtd_type with
+ | None -> assert false
+ | Some mty ->
+ with_context (Modtype id::ctx)
+ (Illegal_permutation.pp Context.alt_pp env) (mty,c)
+ :: before
+ end
+
+and functor_arg_diff ~expansion_token env = function
+ | Diffing.Insert mty -> Functor_suberror.Inclusion.insert mty
+ | Diffing.Delete mty -> Functor_suberror.Inclusion.delete mty
+ | Diffing.Keep (x, y, _) -> Functor_suberror.Inclusion.ok x y
+ | Diffing.Change (_, _, Err.Incompatible_params (i,_)) ->
+ Functor_suberror.Inclusion.incompatible i
+ | Diffing.Change (g, e, Err.Mismatch mty_diff) ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Functor_suberror.Inclusion.diff g e more
+
+let functor_app_diff ~expansion_token env = function
+ | Diffing.Insert mty -> Functor_suberror.App.insert mty
+ | Diffing.Delete mty -> Functor_suberror.App.delete mty
+ | Diffing.Keep (x, y, _) -> Functor_suberror.App.ok x y
+ | Diffing.Change (_, _, Err.Incompatible_params (i,_)) ->
+ Functor_suberror.App.incompatible i
+ | Diffing.Change (g, e, Err.Mismatch mty_diff) ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Functor_suberror.App.diff g e more
+
+let module_type_subst ~env id diff =
+ match diff.symptom with
+ | Not_less_than mts ->
+ module_type ~expansion_token:true ~eqmode:true ~before:[] ~env
+ ~ctx:[Modtype id] mts
+ | Not_greater_than mts ->
+ module_type ~expansion_token:true ~eqmode:true ~before:[] ~env
+ ~ctx:[Modtype id] mts
+ | Incomparable mts ->
+ module_type ~expansion_token:true ~eqmode:true ~env ~before:[]
+ ~ctx:[Modtype id] mts.less_than
+ | Illegal_permutation c ->
+ let mty = diff.got in
+ let main =
+ with_context [Modtype id]
+ (Illegal_permutation.pp Context.alt_pp env) (mty,c) in
+ [main]
+
+let all env = function
+ | In_Compilation_unit diff ->
+ let first = Location.msg "%a" interface_mismatch diff in
+ signature ~expansion_token:true ~env ~before:[first] ~ctx:[] diff.symptom
+ | In_Type_declaration (id,reason) ->
+ [Location.msg "%t" (core id reason)]
+ | In_Module_type diff ->
+ module_type ~expansion_token:true ~eqmode:false ~before:[] ~env ~ctx:[]
+ diff
+ | In_Module_type_substitution (id,diff) ->
+ module_type_subst ~env id diff
+ | In_Signature diff ->
+ signature ~expansion_token:true ~before:[] ~env ~ctx:[] diff
+ | In_Expansion cmts ->
+ match core_module_type_symptom cmts with
+ | None -> assert false
+ | Some main -> [Location.msg "%t" main]
+
+(* General error reporting *)
+
+let err_msgs (env, err) =
+ Printtyp.Conflicts.reset();
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> coalesce @@ all env err)
+
+let report_error err =
+ let main = err_msgs err in
+ Location.errorf ~loc:Location.(in_file !input_name) "%t" main
+
+let report_apply_error ~loc env (lid_app, mty_f, args) =
+ let may_print_app ppf = match lid_app with
+ | None -> ()
+ | Some lid -> Format.fprintf ppf "%a " Printtyp.longident lid
+ in
+ let d = Functor_suberror.App.patch env ~f:mty_f ~args in
+ match d with
+ (* We specialize the one change and one argument case to remove the
+ presentation of the functor arguments *)
+ | [ _, Diffing.Change (_, _, Err.Incompatible_params (i,_)) ] ->
+ Location.errorf ~loc "%t" (Functor_suberror.App.incompatible i)
+ | [ _, Diffing.Change (g, e, Err.Mismatch mty_diff) ] ->
+ let more () =
+ subcase_list @@
+ module_type_symptom ~eqmode:false ~expansion_token:true ~env ~before:[]
+ ~ctx:[] mty_diff.symptom
+ in
+ Location.errorf ~loc "%t" (Functor_suberror.App.single_diff g e more)
+ | _ ->
+ let actual = Functor_suberror.App.got d in
+ let expected = Functor_suberror.expected d in
+ let sub =
+ List.rev @@
+ Functor_suberror.params functor_app_diff env ~expansion_token:true d
+ in
+ Location.errorf ~loc ~sub
+ "@[<hv>The functor application %tis ill-typed.@ \
+ These arguments:@;<1 2>\
+ @[%t@]@ do not match these parameters:@;<1 2>@[functor@ %t@ -> ...@]@]"
+ may_print_app
+ actual expected
+
+let register () =
+ Location.register_error_of_exn
+ (function
+ | Includemod.Error err -> Some (report_error err)
+ | Includemod.Apply_error {loc; env; lid_app; mty_f; args} ->
+ Some (Printtyp.wrap_printing_env env ~error:true (fun () ->
+ report_apply_error ~loc env (lid_app, mty_f, args))
+ )
+ | _ -> None
+ )
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+val err_msgs: Includemod.explanation -> Format.formatter -> unit
+val register: unit -> unit
[] -> []
| (Sig_value(_, _, _) as sigelt) :: rem ->
sigelt :: strengthen_sig ~aliasable env rem p
- | Sig_type(id, {type_kind=Type_abstract}, _, _) ::
- (Sig_type(id', {type_private=Private}, _, _) :: _ as rem)
- when Ident.name id = Ident.name id' ^ "#row" ->
+ | Sig_type(id, {type_kind=Type_abstract}, _, _) :: rem
+ when Btype.is_row_name (Ident.name id) ->
strengthen_sig ~aliasable env rem p
| Sig_type(id, decl, rs, vis) :: rem ->
let newdecl =
match decl.type_manifest with
Some _ -> decl
| None ->
- try
- let orig_decl = Env.find_type p env in
+ match Env.find_type p env with
+ | exception Not_found -> decl
+ (* Type which was not present in the signature, so we don't have
+ anything to do. *)
+ | orig_decl ->
if decl.type_arity <> orig_decl.type_arity then
decl
- else
+ else begin
let orig_ty =
Ctype.reify_univars env
(Btype.newgenty(Tconstr(p, orig_decl.type_params, ref Mnil)))
(Btype.newgenty(Tconstr(Pident id, decl.type_params, ref Mnil)))
in
let env = Env.add_type ~check:false id decl env in
- Ctype.mcomp env orig_ty new_ty;
- let orig_ty =
- Btype.newgenty(Tconstr(p, decl.type_params, ref Mnil))
- in
- {decl with type_manifest = Some orig_ty}
- with Not_found | Ctype.Unify _ ->
- (* - Not_found: type which was not present in the signature, so we don't
- have anything to do.
- - Unify: the current declaration is not compatible with the one we
- got from the signature. We should just fail now, but then, we could
- also have failed if the arities of the two decls were different,
- which we didn't. *)
- decl
+ match Ctype.mcomp env orig_ty new_ty with
+ | exception Ctype.Incompatible -> decl
+ (* The current declaration is not compatible with the one we got
+ from the signature. We should just fail now, but then, we could
+ also have failed if the arities of the two decls were
+ different, which we didn't. *)
+ | () ->
+ let orig_ty =
+ Btype.newgenty(Tconstr(p, decl.type_params, ref Mnil))
+ in
+ {decl with type_manifest = Some orig_ty}
+ end
let rec enrich_modtype env p mty =
match mty with
| Otyp_abstract | Otyp_open
| Otyp_sum _ | Otyp_manifest (_, _) -> ()
| Otyp_record lbls -> print_record_decl ppf lbls
- | Otyp_module (p, n, tyl) ->
+ | Otyp_module (p, fl) ->
fprintf ppf "@[<1>(module %a" print_ident p;
let first = ref true in
- List.iter2
- (fun s t ->
+ List.iter
+ (fun (s, t) ->
let sep = if !first then (first := false; "with") else "and" in
fprintf ppf " %s type %s = %a" sep s print_out_type t
)
- n tyl;
+ fl;
fprintf ppf ")@]"
| Otyp_attribute (t, attr) ->
fprintf ppf "@[<1>(%a [@@%s])@]" print_out_type t attr.oattr_name
let out_sig_item = ref (fun _ -> failwith "Oprint.out_sig_item")
let out_signature = ref (fun _ -> failwith "Oprint.out_signature")
let out_type_extension = ref (fun _ -> failwith "Oprint.out_type_extension")
+let out_functor_parameters =
+ ref (fun _ -> failwith "Oprint.out_functor_parameters")
(* For anonymous functor arguments, the logic to choose between
the long-form
(* take a module type that may be a functor type,
and return the longest prefix list of arguments
that should be printed in long form. *)
-let collect_functor_arguments mty =
- let rec collect_args acc = function
- | Omty_functor (param, mty_res) ->
- collect_args (param :: acc) mty_res
- | non_functor -> (acc, non_functor)
- in
+
+let rec collect_functor_args acc = function
+ | Omty_functor (param, mty_res) ->
+ collect_functor_args (param :: acc) mty_res
+ | non_functor -> (acc, non_functor)
+let collect_functor_args mty =
+ let l, rest = collect_functor_args [] mty in
+ List.rev l, rest
+
+let split_anon_functor_arguments params =
let rec uncollect_anonymous_suffix acc rest = match acc with
- | Some (None, mty_arg) :: acc ->
- uncollect_anonymous_suffix acc
- (Omty_functor (Some (None, mty_arg), rest))
- | _ :: _ | [] ->
- (acc, rest)
+ | Some (None, mty_arg) :: acc ->
+ uncollect_anonymous_suffix acc
+ (Some (None, mty_arg) :: rest)
+ | _ :: _ | [] ->
+ (acc, rest)
in
- let (acc, non_functor) = collect_args [] mty in
- let (acc, rest) = uncollect_anonymous_suffix acc non_functor in
+ let (acc, rest) = uncollect_anonymous_suffix (List.rev params) [] in
(List.rev acc, rest)
let rec print_out_module_type ppf mty =
print_out_functor ppf mty
-and print_out_functor ppf = function
- | Omty_functor _ as t ->
- let rec print_functor ppf = function
- | Omty_functor (Some (None, mty_arg), mty_res) ->
- fprintf ppf "%a ->@ %a"
- print_simple_out_module_type mty_arg
- print_functor mty_res
- | Omty_functor _ as non_anonymous_functor ->
- let (args, rest) = collect_functor_arguments non_anonymous_functor in
- let print_arg ppf = function
- | None ->
- fprintf ppf "()"
- | Some (param, mty) ->
- fprintf ppf "(%s : %a)"
- (Option.value param ~default:"_")
- print_out_module_type mty
- in
- fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
- (pp_print_list ~pp_sep:pp_print_space print_arg) args
- print_functor rest
- | non_functor ->
- print_simple_out_module_type ppf non_functor
- in
- fprintf ppf "@[<2>%a@]" print_functor t
- | t -> print_simple_out_module_type ppf t
+
+and print_out_functor_parameters ppf l =
+ let print_nonanon_arg ppf = function
+ | None ->
+ fprintf ppf "()"
+ | Some (param, mty) ->
+ fprintf ppf "(%s : %a)"
+ (Option.value param ~default:"_")
+ print_out_module_type mty
+ in
+ let rec print_args ppf = function
+ | [] -> ()
+ | Some (None, mty_arg) :: l ->
+ fprintf ppf "%a ->@ %a"
+ print_simple_out_module_type mty_arg
+ print_args l
+ | _ :: _ as non_anonymous_functor ->
+ let args, anons = split_anon_functor_arguments non_anonymous_functor in
+ fprintf ppf "@[<2>functor@ %a@]@ ->@ %a"
+ (pp_print_list ~pp_sep:pp_print_space print_nonanon_arg) args
+ print_args anons
+ in
+ print_args ppf l
+
+and print_out_functor ppf t =
+ let params, non_functor = collect_functor_args t in
+ fprintf ppf "@[<2>%a%a@]"
+ print_out_functor_parameters params
+ print_simple_out_module_type non_functor
and print_simple_out_module_type ppf =
function
Omty_abstract -> ()
let _ = out_signature := print_out_signature
let _ = out_sig_item := print_out_sig_item
let _ = out_type_extension := print_out_type_extension
+let _ = out_functor_parameters := print_out_functor_parameters
(* Phrases *)
val out_module_type : (formatter -> out_module_type -> unit) ref
val out_sig_item : (formatter -> out_sig_item -> unit) ref
val out_signature : (formatter -> out_sig_item list -> unit) ref
+val out_functor_parameters :
+ (formatter ->
+ (string option * Outcometree.out_module_type) option list -> unit)
+ ref
val out_type_extension : (formatter -> out_type_extension -> unit) ref
val out_phrase : (formatter -> out_phrase -> unit) ref
| Otyp_variant of
bool * out_variant * bool * (string list) option
| Otyp_poly of string list * out_type
- | Otyp_module of out_ident * string list * out_type list
+ | Otyp_module of out_ident * (string * out_type) list
| Otyp_attribute of out_type * out_attribute
and out_variant =
| _,Tpat_or (q1,q2,_) ->
(compat p q1 || compat p q2)
(* Constructors, with special case for extension *)
- | Tpat_construct (_, c1,ps1), Tpat_construct (_, c2,ps2) ->
+ | Tpat_construct (_, c1, ps1, _), Tpat_construct (_, c2, ps2, _) ->
Constr.equal c1 c2 && compats ps1 ps2
(* More standard stuff *)
| Tpat_variant(l1,op1, _), Tpat_variant(l2,op2,_) ->
omegas args, closed))
q.pat_type q.pat_env::
rest
-| {pat_desc = Tpat_construct (lid, c,omegas)} ->
+| {pat_desc = Tpat_construct (lid, c, omegas, _)} ->
let args,rest = read_args omegas r in
make_pat
- (Tpat_construct (lid, c,args))
+ (Tpat_construct (lid, c, args, None))
q.pat_type q.pat_env::
rest
| {pat_desc = Tpat_variant (l, omega, row)} ->
end
end
-module ConstructorTagHashtbl = Hashtbl.Make(
- struct
- type t = Types.constructor_tag
- let hash = Hashtbl.hash
- let equal = Types.equal_tag
- end
-)
-
-(* complement constructor tags *)
-let complete_tags nconsts nconstrs tags =
- let seen_const = Array.make nconsts false
- and seen_constr = Array.make nconstrs false in
- List.iter
- (function
- | Cstr_constant i -> seen_const.(i) <- true
- | Cstr_block i -> seen_constr.(i) <- true
- | _ -> assert false)
- tags ;
- let r = ConstructorTagHashtbl.create (nconsts+nconstrs) in
- for i = 0 to nconsts-1 do
- if not seen_const.(i) then
- ConstructorTagHashtbl.add r (Cstr_constant i) ()
- done ;
- for i = 0 to nconstrs-1 do
- if not seen_constr.(i) then
- ConstructorTagHashtbl.add r (Cstr_block i) ()
- done ;
- r
-
(* build a pattern from a constructor description *)
let pat_of_constr ex_pat cstr =
{ex_pat with pat_desc =
Tpat_construct (mknoloc (Longident.Lident cstr.cstr_name),
- cstr, omegas cstr.cstr_arity)}
+ cstr, omegas cstr.cstr_arity, None)}
let orify x y = make_pat (Tpat_or (x, y, None)) x.pat_type x.pat_env
let ty' = Ctype.expand_head env ty in
match ty'.desc with
| Tconstr (path, _, _) ->
- begin try match (Env.find_type path env).type_kind with
- | Type_variant cl when always || List.length cl <= 1 ||
+ begin match Env.find_type_descrs path env with
+ | exception Not_found -> [omega]
+ | Type_variant (cstrs,_) when always || List.length cstrs <= 1 ||
(* Only explode when all constructors are GADTs *)
- List.for_all (fun cd -> cd.Types.cd_res <> None) cl ->
- let cstrs = fst (Env.find_type_descrs path env) in
+ List.for_all (fun cd -> cd.cstr_generalized) cstrs ->
List.map (pat_of_constr (make_pat Tpat_any ty env)) cstrs
- | Type_record _ ->
- let labels = snd (Env.find_type_descrs path env) in
+ | Type_record (labels, _) ->
let fields =
List.map (fun ld ->
mknoloc (Longident.Lident ld.lbl_name), ld, omega)
labels
in
[make_pat (Tpat_record (fields, Closed)) ty env]
- | _ -> [omega]
- with Not_found -> [omega]
+ | Type_variant _ | Type_abstract | Type_open -> [omega]
end
| Ttuple tl ->
[make_pat (Tpat_tuple (omegas (List.length tl))) ty env]
let rec get_variant_constructors env ty =
match (Ctype.repr ty).desc with
| Tconstr (path,_,_) -> begin
- try match Env.find_type path env with
- | {type_kind=Type_variant _} ->
- fst (Env.find_type_descrs path env)
- | {type_manifest = Some _} ->
+ try match Env.find_type path env, Env.find_type_descrs path env with
+ | _, Type_variant (cstrs,_) -> cstrs
+ | {type_manifest = Some _}, _ ->
get_variant_constructors env
(Ctype.expand_head_once env (clean_copy ty))
| _ -> fatal_error "Parmatch.get_variant_constructors"
end
| _ -> fatal_error "Parmatch.get_variant_constructors"
-(* Sends back a pattern that complements constructor tags all_tag *)
-let complete_constrs constr all_tags =
+module ConstructorSet = Set.Make(struct
+ type t = constructor_description
+ let compare c1 c2 = String.compare c1.cstr_name c2.cstr_name
+end)
+
+(* Sends back a pattern that complements the given constructors used_constrs *)
+let complete_constrs constr used_constrs =
let c = constr.pat_desc in
- let not_tags = complete_tags c.cstr_consts c.cstr_nonconsts all_tags in
let constrs = get_variant_constructors constr.pat_env c.cstr_res in
+ let used_constrs = ConstructorSet.of_list used_constrs in
let others =
List.filter
- (fun cnstr -> ConstructorTagHashtbl.mem not_tags cnstr.cstr_tag)
+ (fun cnstr -> not (ConstructorSet.mem cnstr used_constrs))
constrs in
+ (* Split constructors to put constant ones first *)
let const, nonconst =
List.partition (fun cnstr -> cnstr.cstr_arity = 0) others in
const @ nonconst
let build_other_constrs env p =
let open Patterns.Head in
match p.pat_desc with
- | Construct ({ cstr_tag = Cstr_constant _ | Cstr_block _ } as c) ->
- let constr = { p with pat_desc = c } in
- let get_tag q =
- match q.pat_desc with
- | Construct c -> c.cstr_tag
- | _ -> fatal_error "Parmatch.get_tag" in
- let all_tags = List.map (fun (p,_) -> get_tag p) env in
- pat_of_constrs p (complete_constrs constr all_tags)
+ | Construct ({ cstr_tag = Cstr_extension _ }) -> extra_pat
+ | Construct
+ ({ cstr_tag = Cstr_constant _ | Cstr_block _ | Cstr_unboxed } as c) ->
+ let constr = { p with pat_desc = c } in
+ let get_constr q =
+ match q.pat_desc with
+ | Construct c -> c
+ | _ -> fatal_error "Parmatch.get_constr" in
+ let used_constrs = List.map (fun (p,_) -> get_constr p) env in
+ pat_of_constrs p (complete_constrs constr used_constrs)
| _ -> extra_pat
(* Auxiliary for build_other *)
| Tpat_any | Tpat_var _ | Tpat_constant _ | Tpat_variant (_,None,_) -> true
| Tpat_alias (p,_,_) | Tpat_variant (_,Some p,_) -> has_instance p
| Tpat_or (p1,p2,_) -> has_instance p1 || has_instance p2
- | Tpat_construct (_,_,ps) | Tpat_tuple ps | Tpat_array ps ->
+ | Tpat_construct (_,_,ps,_) | Tpat_tuple ps | Tpat_array ps ->
has_instances ps
| Tpat_record (lps,_) -> has_instances (List.map (fun (_,_,x) -> x) lps)
| Tpat_lazy p
| Tpat_alias(p,_,_), _ -> le_pat p q
| _, Tpat_alias(q,_,_) -> le_pat p q
| Tpat_constant(c1), Tpat_constant(c2) -> const_compare c1 c2 = 0
- | Tpat_construct(_,c1,ps), Tpat_construct(_,c2,qs) ->
+ | Tpat_construct(_,c1,ps,_), Tpat_construct(_,c2,qs,_) ->
Types.equal_tag c1.cstr_tag c2.cstr_tag && le_pats ps qs
| Tpat_variant(l1,Some p1,_), Tpat_variant(l2,Some p2,_) ->
(l1 = l2 && le_pat p1 p2)
| Tpat_lazy p, Tpat_lazy q ->
let r = lub p q in
make_pat (Tpat_lazy r) p.pat_type p.pat_env
-| Tpat_construct (lid, c1,ps1), Tpat_construct (_,c2,ps2)
+| Tpat_construct (lid,c1,ps1,_), Tpat_construct (_,c2,ps2,_)
when Types.equal_tag c1.cstr_tag c2.cstr_tag ->
let rs = lubs ps1 ps2 in
- make_pat (Tpat_construct (lid, c1,rs))
+ make_pat (Tpat_construct (lid, c1, rs, None))
p.pat_type p.pat_env
| Tpat_variant(l1,Some p1,row), Tpat_variant(l2,Some p2,_)
when l1=l2 ->
| Tpat_alias (p,_,_) -> loop p
| Tpat_tuple lst ->
mkpat (Ppat_tuple (List.map loop lst))
- | Tpat_construct (cstr_lid, cstr, lst) ->
+ | Tpat_construct (cstr_lid, cstr, lst, _) ->
let id = fresh cstr.cstr_name in
let lid = { cstr_lid with txt = Longident.Lident id } in
Hashtbl.add constrs id cstr;
let arg =
match List.map loop lst with
| [] -> None
- | [p] -> Some p
- | lst -> Some (mkpat (Ppat_tuple lst))
+ | [p] -> Some ([], p)
+ | lst -> Some ([], mkpat (Ppat_tuple lst))
in
mkpat (Ppat_construct(lid, arg))
| Tpat_variant(label,p_opt,_row_desc) ->
Path.same path Predef.path_option)
let rec collect_paths_from_pat r p = match p.pat_desc with
-| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},ps)
- ->
+| Tpat_construct(_, {cstr_tag=(Cstr_constant _|Cstr_block _|Cstr_unboxed)},
+ ps, _) ->
let path = get_constructor_type_path p.pat_type p.pat_env in
List.fold_left
collect_paths_from_pat
ps
| Tpat_any|Tpat_var _|Tpat_constant _| Tpat_variant (_,None,_) -> r
| Tpat_tuple ps | Tpat_array ps
-| Tpat_construct (_, {cstr_tag=Cstr_extension _}, ps)->
+| Tpat_construct (_, {cstr_tag=Cstr_extension _}, ps, _)->
List.fold_left collect_paths_from_pat r ps
| Tpat_record (lps,_) ->
List.fold_left
| Const_int _ | Const_char _ | Const_float _
| Const_int32 _ | Const_int64 _ | Const_nativeint _ -> true
end
- | Tpat_tuple ps | Tpat_construct (_, _, ps) ->
+ | Tpat_tuple ps | Tpat_construct (_, _, ps, _) ->
List.for_all (fun p -> loop p) ps
| Tpat_alias (p,_,_) | Tpat_variant (_, Some p, _) ->
loop p
val pat_of_constr : pattern -> constructor_description -> pattern
val complete_constrs :
constructor_description pattern_data ->
- constructor_tag list ->
+ constructor_description list ->
constructor_description list
(** [ppat_of_type] builds an untyped pattern from its expected type,
let rec scope = function
Pident id -> Ident.scope id
| Pdot(p, _s) -> scope p
- | Papply(p1, p2) -> max (scope p1) (scope p2)
+ | Papply(p1, p2) -> Int.max (scope p1) (scope p2)
let kfalse _ = false
`Constant cst
| Tpat_tuple ps ->
`Tuple ps
- | Tpat_construct (cstr, cstr_descr, args) ->
+ | Tpat_construct (cstr, cstr_descr, args, _) ->
`Construct (cstr, cstr_descr, args)
| Tpat_variant (cstr, arg, row_desc) ->
`Variant (cstr, arg, row_desc)
| `Constant cst -> Tpat_constant cst
| `Tuple ps -> Tpat_tuple ps
| `Construct (cstr, cst_descr, args) ->
- Tpat_construct (cstr, cst_descr, args)
+ Tpat_construct (cstr, cst_descr, args, None)
| `Variant (cstr, arg, row_desc) ->
Tpat_variant (cstr, arg, row_desc)
| `Record (fields, closed) ->
| Array n -> Tpat_array (omegas n)
| Construct c ->
let lid_loc = mkloc (Longident.Lident c.cstr_name) in
- Tpat_construct (lid_loc, c, omegas c.cstr_arity)
+ Tpat_construct (lid_loc, c, omegas c.cstr_arity, None)
| Variant { tag; has_arg; cstr_row } ->
let arg_opt = if has_arg then Some omega else None in
Tpat_variant (tag, arg_opt, cstr_row)
type can_load_cmis =
| Can_load_cmis
- | Cannot_load_cmis of EnvLazy.log
+ | Cannot_load_cmis of Lazy_backtrack.log
type pers_struct = {
ps_name: string;
penv.can_load_cmis := setting
let without_cmis penv f x =
- let log = EnvLazy.log () in
+ let log = Lazy_backtrack.log () in
let res =
Misc.(protect_refs
[R (penv.can_load_cmis, Cannot_load_cmis log)]
(fun () -> f x))
in
- EnvLazy.backtrack log;
+ Lazy_backtrack.backtrack log;
res
let fold {persistent_structures; _} f x =
type can_load_cmis =
| Can_load_cmis
- | Cannot_load_cmis of Misc.EnvLazy.log
+ | Cannot_load_cmis of Lazy_backtrack.log
type 'a t
type_expansion_scope = lowest_level;
type_attributes = [];
type_immediate = immediate;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.of_predef_id type_ident;
}
in
type_expansion_scope = lowest_level;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.of_predef_id type_ident;
}
in
add_type1 ident_option ~variance:Variance.covariant
~separability:Separability.Ind
~kind:(fun tvar ->
- Type_variant([cstr ident_none []; cstr ident_some [tvar]])
+ Type_variant([cstr ident_none []; cstr ident_some [tvar]],
+ Variant_regular)
) (
add_type1 ident_list ~variance:Variance.covariant
~separability:Separability.Ind
~kind:(fun tvar ->
- Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]])
+ Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]],
+ Variant_regular)
) (
add_type1 ident_array ~variance:Variance.full ~separability:Separability.Ind (
add_type ident_exn ~kind:Type_open (
add_type ident_unit ~immediate:Always
- ~kind:(Type_variant([cstr ident_void []])) (
+ ~kind:(Type_variant([cstr ident_void []], Variant_regular)) (
add_type ident_bool ~immediate:Always
- ~kind:(Type_variant([cstr ident_false []; cstr ident_true []])) (
+ ~kind:(Type_variant([cstr ident_false []; cstr ident_true []],
+ Variant_regular)) (
add_type ident_float (
add_type ident_string (
add_type ident_char ~immediate:Always (
let byte_name p =
p.prim_name
+let equal_boxed_integer bi1 bi2 =
+ match bi1, bi2 with
+ | Pnativeint, Pnativeint
+ | Pint32, Pint32
+ | Pint64, Pint64 ->
+ true
+ | (Pnativeint | Pint32 | Pint64), _ ->
+ false
+
+let equal_native_repr nr1 nr2 =
+ match nr1, nr2 with
+ | Same_as_ocaml_repr, Same_as_ocaml_repr -> true
+ | Same_as_ocaml_repr,
+ (Unboxed_float | Unboxed_integer _ | Untagged_int) -> false
+ | Unboxed_float, Unboxed_float -> true
+ | Unboxed_float,
+ (Same_as_ocaml_repr | Unboxed_integer _ | Untagged_int) -> false
+ | Unboxed_integer bi1, Unboxed_integer bi2 -> equal_boxed_integer bi1 bi2
+ | Unboxed_integer _,
+ (Same_as_ocaml_repr | Unboxed_float | Untagged_int) -> false
+ | Untagged_int, Untagged_int -> true
+ | Untagged_int,
+ (Same_as_ocaml_repr | Unboxed_float | Unboxed_integer _) -> false
+
let native_name_is_external p =
let nat_name = native_name p in
nat_name <> "" && nat_name.[0] <> '%'
val native_name: description -> string
val byte_name: description -> string
+val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
+val equal_native_repr : native_repr -> native_repr -> bool
+
(** [native_name_is_externa] returns [true] iff the [native_name] for the
given primitive identifies that the primitive is not implemented in the
compiler itself. *)
| Tpat_constant c -> fprintf ppf "%s" (pretty_const c)
| Tpat_tuple vs ->
fprintf ppf "@[(%a)@]" (pretty_vals ",") vs
- | Tpat_construct (_, cstr, []) ->
+ | Tpat_construct (_, cstr, [], _) ->
fprintf ppf "%s" cstr.cstr_name
- | Tpat_construct (_, cstr, [w]) ->
+ | Tpat_construct (_, cstr, [w], None) ->
fprintf ppf "@[<2>%s@ %a@]" cstr.cstr_name pretty_arg w
- | Tpat_construct (_, cstr, vs) ->
+ | Tpat_construct (_, cstr, vs, vto) ->
let name = cstr.cstr_name in
- begin match (name, vs) with
- ("::", [v1;v2]) ->
+ begin match (name, vs, vto) with
+ ("::", [v1;v2], None) ->
fprintf ppf "@[%a::@,%a@]" pretty_car v1 pretty_cdr v2
- | _ ->
+ | (_, _, None) ->
fprintf ppf "@[<2>%s@ @[(%a)@]@]" name (pretty_vals ",") vs
+ | (_, _, Some ([], _t)) ->
+ fprintf ppf "@[<2>%s@ @[(%a : _)@]@]" name (pretty_vals ",") vs
+ | (_, _, Some (vl, _t)) ->
+ let vars = List.map (fun x -> Ident.name x.txt) vl in
+ fprintf ppf "@[<2>%s@ (type %s)@ @[(%a : _)@]@]"
+ name (String.concat " " vars) (pretty_vals ",") vs
end
| Tpat_variant (l, None, _) ->
fprintf ppf "`%s" l
fprintf ppf "@[(%a)@]" pretty_or v
and pretty_car ppf v = match v.pat_desc with
-| Tpat_construct (_,cstr, [_ ; _])
+| Tpat_construct (_,cstr, [_ ; _], None)
when is_cons cstr ->
fprintf ppf "(%a)" pretty_val v
| _ -> pretty_val ppf v
and pretty_cdr ppf v = match v.pat_desc with
-| Tpat_construct (_,cstr, [v1 ; v2])
+| Tpat_construct (_,cstr, [v1 ; v2], None)
when is_cons cstr ->
fprintf ppf "%a::@,%a" pretty_car v1 pretty_cdr v2
| _ -> pretty_val ppf v
and pretty_arg ppf v = match v.pat_desc with
-| Tpat_construct (_,_,_::_)
+| Tpat_construct (_,_,_::_,None)
| Tpat_variant (_, Some _, _) -> fprintf ppf "(%a)" pretty_val v
| _ -> pretty_val ppf v
let set out_name x = out_name.printed_name <- x
end
+(** Some identifiers may require hiding when printing *)
+type bound_ident = { hide:bool; ident:Ident.t }
+
(* printing environment for path shortening and naming *)
let printing_env = ref Env.empty
in
begin match l with
| [] -> ()
- | l -> Format.fprintf ppf "@ %a" print_located_explanations l
+ | l -> Format.fprintf ppf "@,%a" print_located_explanations l
end;
(* if there are name collisions in a toplevel session,
display at least one generic hint by namespace *)
let exists () = M.cardinal !explanations >0
end
-
module Naming_context = struct
module M = String.Map
let hid_start = 0
let add_hid_id id map =
- let new_id = 1 + Ident.Map.fold (fun _ -> max) map hid_start in
+ let new_id = 1 + Ident.Map.fold (fun _ -> Int.max) map hid_start in
new_id, Ident.Map.add id new_id map
let find_hid id map =
(* Names used in recursive definitions are not considered when determining
if a name is already attributed in the current environment.
- This is a weaker version of hidden_rec_items used by short-path. *)
+ This is a complementary version of hidden_rec_items used by short-path. *)
let protected = ref S.empty
-let add_protected id = protected := S.add (Ident.name id) !protected
-let reset_protected () = protected := S.empty
-let with_hidden id f =
- protect_refs [ R(protected,S.add (Ident.name id) !protected)] f
+
+(* When dealing with functor arguments, identity becomes fuzzy because the same
+ syntactic argument may be represented by different identifers during the
+ error processing, we are thus disabling disambiguation on the argument name
+*)
+let fuzzy = ref S.empty
+let with_arg id f =
+ protect_refs [ R(fuzzy, S.add (Ident.name id) !fuzzy) ] f
+let fuzzy_id namespace id = namespace = Module && S.mem (Ident.name id) !fuzzy
+
+let with_hidden ids f =
+ let update m id = S.add (Ident.name id.ident) m in
+ protect_refs [ R(protected, List.fold_left update !protected ids)] f
let pervasives_name namespace name =
if not !enabled then Out_name.create name else
(** Associate a name to the identifier [id] within [namespace] *)
let ident_name_simple namespace id =
- if not !enabled then Out_name.create (Ident.name id) else
+ if not !enabled || fuzzy_id namespace id then
+ Out_name.create (Ident.name id)
+ else
let name = Ident.name id in
match M.find name (get namespace) with
| Uniquely_associated_to (id',r) when Ident.same id id' ->
let reset () =
Array.iteri ( fun i _ -> map.(i) <- M.empty ) map
+let with_ctx f =
+ let old = Array.copy map in
+ try_finally f
+ ~always:(fun () -> Array.blit old 0 map 0 (Array.length map))
+
end
let ident_name = Naming_context.ident_name
let reset_naming_context = Naming_context.reset
raw_type t1 raw_type t2
| Tnil -> fprintf ppf "Tnil"
| Tlink t -> fprintf ppf "@[<1>Tlink@,%a@]" raw_type t
- | Tsubst t -> fprintf ppf "@[<1>Tsubst@,%a@]" raw_type t
+ | Tsubst (t, None) -> fprintf ppf "@[<1>Tsubst@,(%a,None)@]" raw_type t
+ | Tsubst (t, Some t') ->
+ fprintf ppf "@[<1>Tsubst@,(%a,@ Some%a)@]" raw_type t raw_type t'
| Tunivar name -> fprintf ppf "Tunivar %a" print_name name
| Tpoly (t, tl) ->
fprintf ppf "@[<hov1>Tpoly(@,%a,@,%a)@]"
match row.row_name with None -> fprintf ppf "None"
| Some(p,tl) ->
fprintf ppf "Some(@,%a,@,%a)" path p raw_type_list tl)
- | Tpackage (p, _, tl) ->
+ | Tpackage (p, fl) ->
fprintf ppf "@[<hov1>Tpackage(@,%a@,%a)@]" path p
- raw_type_list tl
+ raw_type_list (List.map snd fl)
and raw_row_fixed ppf = function
| None -> fprintf ppf "None"
| Some Types.Fixed_private -> fprintf ppf "Some Fixed_private"
| Tconstr(p, tyl, _) ->
let (_p', s) = best_type_path p in
List.iter (mark_loops_rec visited) (apply_subst s tyl)
- | Tpackage (_, _, tyl) ->
- List.iter (mark_loops_rec visited) tyl
+ | Tpackage (_, fl) ->
+ List.iter (fun (_n, ty) -> mark_loops_rec visited ty) fl
| Tvariant row ->
if List.memq px !visited_objects then add_alias px else
begin
| Tfield(_, _, _, ty2) ->
mark_loops_rec visited ty2
| Tnil -> ()
- | Tsubst ty -> mark_loops_rec visited ty
+ | Tsubst _ -> () (* we do not print arguments *)
| Tlink _ -> fatal_error "Printtyp.mark_loops_rec (2)"
| Tpoly (ty, tyl) ->
List.iter (fun t -> add_alias t) tyl;
tree_of_typobject sch fi !nm
| Tnil | Tfield _ ->
tree_of_typobject sch ty None
- | Tsubst ty ->
- tree_of_typexp sch ty
+ | Tsubst _ ->
+ (* This case should only happen when debugging the compiler *)
+ Otyp_stuff "<Tsubst>"
| Tlink _ ->
fatal_error "Printtyp.tree_of_typexp"
| Tpoly (ty, []) ->
end
| Tunivar _ ->
Otyp_var (false, name_of_type new_name ty)
- | Tpackage (p, n, tyl) ->
- let n =
- List.map (fun li -> String.concat "." (Longident.flatten li)) n in
- Otyp_module (tree_of_path Module_type p, n, tree_of_typlist sch tyl)
+ | Tpackage (p, fl) ->
+ let fl =
+ List.map
+ (fun (li, ty) -> (
+ String.concat "." (Longident.flatten li),
+ tree_of_typexp sch ty
+ )) fl in
+ Otyp_module (tree_of_path Module_type p, fl)
in
if List.memq px !delayed then delayed := List.filter ((!=) px) !delayed;
if is_aliased px && aliasable ty then begin
List.fold_left
(fun tyl ty ->
let ty = repr ty in
- if List.memq ty tyl then Btype.newgenty (Tsubst ty) :: tyl
+ if List.memq ty tyl then Btype.newgenty (Ttuple [ty]) :: tyl
else ty :: tyl)
+ (* Two parameters might be identical due to a constraint but we need to
+ print them differently in order to make the output syntactically valid.
+ We use [Ttuple [ty]] because it is printed as [ty]. *)
+ (* Replacing fold_left by fold_right does not work! *)
[] tyl
in List.rev params
let vars = free_variables ty in
List.iter
(function {desc = Tvar (Some "_")} as ty ->
- if List.memq ty vars then ty.desc <- Tvar None
+ if List.memq ty vars then set_type_desc ty (Tvar None)
| _ -> ())
params
| None -> ()
in
begin match decl.type_kind with
| Type_abstract -> ()
- | Type_variant cstrs ->
+ | Type_variant (cstrs, _rep) ->
List.iter
(fun c ->
mark_loops_constructor_arguments c.cd_args;
decl.type_manifest = None || decl.type_private = Private
| Type_record _ ->
decl.type_private = Private
- | Type_variant tll ->
+ | Type_variant (tll, _rep) ->
decl.type_private = Private ||
List.exists (fun cd -> cd.cd_res <> None) tll
| Type_open ->
in
let (name, args) = type_defined decl in
let constraints = tree_of_constraints params in
- let ty, priv =
+ let ty, priv, unboxed =
match decl.type_kind with
| Type_abstract ->
begin match ty_manifest with
- | None -> (Otyp_abstract, Public)
+ | None -> (Otyp_abstract, Public, false)
| Some ty ->
- tree_of_typexp false ty, decl.type_private
+ tree_of_typexp false ty, decl.type_private, false
end
- | Type_variant cstrs ->
+ | Type_variant (cstrs, rep) ->
tree_of_manifest (Otyp_sum (List.map tree_of_constructor cstrs)),
- decl.type_private
- | Type_record(lbls, _rep) ->
+ decl.type_private,
+ (rep = Variant_unboxed)
+ | Type_record(lbls, rep) ->
tree_of_manifest (Otyp_record (List.map tree_of_label lbls)),
- decl.type_private
+ decl.type_private,
+ (match rep with Record_unboxed _ -> true | _ -> false)
| Type_open ->
tree_of_manifest Otyp_open,
- decl.type_private
+ decl.type_private,
+ false
in
{ otype_name = name;
otype_params = args;
otype_type = ty;
otype_private = priv;
otype_immediate = Type_immediacy.of_attributes decl.type_attributes;
- otype_unboxed = decl.type_unboxed.unboxed;
+ otype_unboxed = unboxed;
otype_cstrs = constraints }
and tree_of_constructor_arguments = function
set_printing_env env;
tree
-let filter_rem_sig item rem =
- match item, rem with
- | Sig_class _, ctydecl :: tydecl1 :: tydecl2 :: rem ->
- ([ctydecl; tydecl1; tydecl2], rem)
- | Sig_class_type _, tydecl1 :: tydecl2 :: rem ->
- ([tydecl1; tydecl2], rem)
- | _ ->
- ([], rem)
-
let dummy =
{
type_params = [];
type_loc = Location.none;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.internal_not_actually_unique;
}
-let hide ids env = List.fold_right
- (fun id -> Env.add_type ~check:false (Ident.rename id) dummy)
- ids env
-
-let hide_rec_items = function
- | Sig_type(id, _decl, rs, _) ::rem
- when rs = Trec_first && not !Clflags.real_paths ->
- let rec get_ids = function
- Sig_type (id, _, Trec_next, _) :: rem ->
- id :: get_ids rem
- | _ -> []
- in
- let ids = id :: get_ids rem in
- set_printing_env
- (hide ids !printing_env)
- | _ -> ()
+(** we hide items being defined from short-path to avoid shortening
+ [type t = Path.To.t] into [type t = t].
+*)
-let recursive_sigitem = function
- | Sig_class(id,_,rs,_) -> Some(id,rs,3)
- | Sig_class_type (id,_,rs,_) -> Some(id,rs,2)
- | Sig_type(id, _, rs, _)
- | Sig_module(id, _, _, rs, _) -> Some (id,rs,0)
- | _ -> None
+let ident_sigitem = function
+ | Types.Sig_type(ident,_,_,_) -> {hide=true;ident}
+ | Types.Sig_class(ident,_,_,_)
+ | Types.Sig_class_type (ident,_,_,_)
+ | Types.Sig_module(ident,_, _,_,_)
+ | Types.Sig_value (ident,_,_)
+ | Types.Sig_modtype (ident,_,_)
+ | Types.Sig_typext (ident,_,_,_) -> {hide=false; ident }
+
+let hide ids env =
+ let hide_id id env =
+ (* Global idents cannot be renamed *)
+ if id.hide && not (Ident.global id.ident) then
+ Env.add_type ~check:false (Ident.rename id.ident) dummy env
+ else env
+ in
+ List.fold_right hide_id ids env
+
+let with_hidden_items ids f =
+ let with_hidden_in_printing_env ids f =
+ wrap_env (hide ids) (Naming_context.with_hidden ids) f
+ in
+ if not !Clflags.real_paths then
+ with_hidden_in_printing_env ids f
+ else
+ Naming_context.with_hidden ids f
-let skip k l = snd (Misc.Stdlib.List.split_at k l)
-let protect_rec_items items =
- let rec get_ids recs = function
- | [] -> []
- | item :: rem -> match recursive_sigitem item with
- | Some (id, r, k ) when r = recs -> id :: get_ids Trec_next (skip k rem)
- | _ -> [] in
- List.iter Naming_context.add_protected (get_ids Trec_first items)
-
-let stop_type_group env =
- Naming_context.reset_protected ();
- set_printing_env env
-
-let still_in_type_group env' in_type_group item =
- match in_type_group, recursive_sigitem item with
- | true, Some (_,Trec_next,_) -> true
- | _, Some (_, (Trec_not | Trec_first),_) ->
- stop_type_group env' ; true
- | _ -> stop_type_group env'; false
+let add_sigitem env x =
+ Env.add_signature (Signature_group.flatten x) env
let rec tree_of_modtype ?(ellipsis=false) = function
| Mty_ident p ->
Omty_signature (if ellipsis then [Osig_ellipsis]
else tree_of_signature sg)
| Mty_functor(param, ty_res) ->
- let param, res =
- match param with
- | Unit -> None, tree_of_modtype ~ellipsis ty_res
- | Named (param, ty_arg) ->
- let name, env =
- match param with
- | None -> None, fun env -> env
- | Some id ->
- Some (Ident.name id),
- Env.add_module ~arg:true id Mp_present ty_arg
- in
- Some (name, tree_of_modtype ~ellipsis:false ty_arg),
- wrap_env env (tree_of_modtype ~ellipsis) ty_res
+ let param, env =
+ tree_of_functor_parameter param
in
+ let res = wrap_env env (tree_of_modtype ~ellipsis) ty_res in
Omty_functor (param, res)
| Mty_alias p ->
Omty_alias (tree_of_path Module p)
+and tree_of_functor_parameter = function
+ | Unit ->
+ None, fun k -> k
+ | Named (param, ty_arg) ->
+ let name, env =
+ match param with
+ | None -> None, fun env -> env
+ | Some id ->
+ Some (Ident.name id),
+ Env.add_module ~arg:true id Mp_present ty_arg
+ in
+ Some (name, tree_of_modtype ~ellipsis:false ty_arg), env
+
and tree_of_signature sg =
- wrap_env (fun env -> env) (tree_of_signature_rec !printing_env false) sg
-
-and tree_of_signature_rec env' in_type_group = function
- [] -> stop_type_group env'; []
- | item :: rem as items ->
- let in_type_group = still_in_type_group env' in_type_group item in
- let (sg, rem) = filter_rem_sig item rem in
- hide_rec_items items;
- protect_rec_items items;
- reset_naming_context ();
- let trees = trees_of_sigitem item in
- let env' = Env.add_signature (item :: sg) env' in
- trees @ tree_of_signature_rec env' in_type_group rem
-
-and trees_of_sigitem = function
+ wrap_env (fun env -> env)(fun sg ->
+ let tree_groups = tree_of_signature_rec !printing_env sg in
+ List.concat_map (fun (_env,l) -> List.map snd l) tree_groups
+ ) sg
+
+and tree_of_signature_rec env' sg =
+ let structured = List.of_seq (Signature_group.seq sg) in
+ let collect_trees_of_rec_group group =
+ let env = !printing_env in
+ let env', group_trees =
+ Naming_context.with_ctx
+ (fun () -> trees_of_recursive_sigitem_group env group)
+ in
+ set_printing_env env';
+ (env, group_trees) in
+ set_printing_env env';
+ List.map collect_trees_of_rec_group structured
+
+and trees_of_recursive_sigitem_group env
+ (syntactic_group: Signature_group.rec_group) =
+ let display (x:Signature_group.sig_item) = x.src, tree_of_sigitem x.src in
+ let env = Env.add_signature syntactic_group.pre_ghosts env in
+ match syntactic_group.group with
+ | Not_rec x -> add_sigitem env x, [display x]
+ | Rec_group items ->
+ let ids = List.map (fun x -> ident_sigitem x.Signature_group.src) items in
+ List.fold_left add_sigitem env items,
+ with_hidden_items ids (fun () -> List.map display items)
+
+and tree_of_sigitem = function
| Sig_value(id, decl, _) ->
- [tree_of_value_description id decl]
- | Sig_type(id, _, _, _) when is_row_name (Ident.name id) ->
- []
+ tree_of_value_description id decl
| Sig_type(id, decl, rs, _) ->
- [tree_of_type_declaration id decl rs]
+ tree_of_type_declaration id decl rs
| Sig_typext(id, ext, es, _) ->
- [tree_of_extension_constructor id ext es]
+ tree_of_extension_constructor id ext es
| Sig_module(id, _, md, rs, _) ->
let ellipsis =
List.exists (function
| Parsetree.{attr_name = {txt="..."}; attr_payload = PStr []} -> true
| _ -> false)
md.md_attributes in
- [tree_of_module id md.md_type rs ~ellipsis]
+ tree_of_module id md.md_type rs ~ellipsis
| Sig_modtype(id, decl, _) ->
- [tree_of_modtype_declaration id decl]
+ tree_of_modtype_declaration id decl
| Sig_class(id, decl, rs, _) ->
- [tree_of_class_declaration id decl rs]
+ tree_of_class_declaration id decl rs
| Sig_class_type(id, decl, rs, _) ->
- [tree_of_cltype_declaration id decl rs]
+ tree_of_cltype_declaration id decl rs
and tree_of_modtype_declaration id decl =
let mty =
and tree_of_module id ?ellipsis mty rs =
Osig_module (Ident.name id, tree_of_modtype ?ellipsis mty, tree_of_rec rs)
+let rec functor_parameters ~sep custom_printer = function
+ | [] -> ignore
+ | [id,param] ->
+ Format.dprintf "%t%t"
+ (custom_printer param)
+ (functor_param ~sep ~custom_printer id [])
+ | (id,param) :: q ->
+ Format.dprintf "%t%a%t"
+ (custom_printer param)
+ sep ()
+ (functor_param ~sep ~custom_printer id q)
+and functor_param ~sep ~custom_printer id q =
+ match id with
+ | None -> functor_parameters ~sep custom_printer q
+ | Some id ->
+ Naming_context.with_arg id
+ (fun () -> functor_parameters ~sep custom_printer q)
+
+
+
let modtype ppf mty = !Oprint.out_module_type ppf (tree_of_modtype mty)
let modtype_declaration id ppf decl =
!Oprint.out_sig_item ppf (tree_of_modtype_declaration id decl)
refresh_weak();
reset_naming_context ();
Conflicts.reset ();
- let rec print showval in_type_group env = function
- | [] -> stop_type_group env; []
- | item :: rem as items ->
- let in_type_group = still_in_type_group env in_type_group item in
- let (sg, rem) = filter_rem_sig item rem in
- hide_rec_items items;
- protect_rec_items items;
- reset_naming_context ();
- let trees = trees_of_sigitem item in
- List.map (fun d -> (d, showval env item)) trees @
- print showval in_type_group (Env.add_signature (item :: sg) env) rem in
- print showval false env x
+ let extend_val env (sigitem,outcome) = outcome, showval env sigitem in
+ let post_process (env,l) = List.map (extend_val env) l in
+ List.concat_map post_process @@ tree_of_signature_rec env x
(* Print a signature body (used by -i when compiling a .ml) *)
| Diff(t,t') ->
fprintf ppf "@[<2>%a@ =@ %a@]" !Oprint.out_type t !Oprint.out_type t'
-module Trace = Ctype.Unification_trace
-
-let trees_of_trace = List.map (Trace.map_diff trees_of_type_expansion)
+let trees_of_trace = List.map (Errortrace.map_diff trees_of_type_expansion)
let trees_of_type_path_expansion (tp,tp') =
if Path.same tp tp' then Same(tree_of_path Type tp) else
!Oprint.out_ident p'
let rec trace fst txt ppf = function
- | {Trace.got; expected} :: rem ->
+ | {Errortrace.got; expected} :: rem ->
if not fst then fprintf ppf "@,";
fprintf ppf "@[Type@;<1 2>%a@ %s@;<1 2>%a@] %a"
type_expansion got txt type_expansion expected
(trace false txt) rem
| _ -> ()
-
type printing_status =
| Discard
| Keep
type error.
*)
-let printing_status = function
- | Trace.(Diff { got=t1, t1'; expected=t2, t2'}) ->
- if is_constr_row ~allow_ident:true t1'
- || is_constr_row ~allow_ident:true t2'
- then Discard
- else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
- else Keep
+let diff_printing_status { Errortrace.got=t1, t1'; expected=t2, t2'} =
+ if is_constr_row ~allow_ident:true t1'
+ || is_constr_row ~allow_ident:true t2'
+ then Discard
+ else if same_path t1 t1' && same_path t2 t2' then Optional_refinement
+ else Keep
+
+(* A configuration type that controls which trace we print. This could be
+ exposed, but we instead expose three separate
+ [report_{unification,equality,moregen}_error] functions. This also lets us
+ give the unification case an extra optional argument without adding it to the
+ equality and moregen cases. *)
+type 'variety trace_format =
+ | Unification : Errortrace.unification trace_format
+ | Equality : Errortrace.comparison trace_format
+ | Moregen : Errortrace.comparison trace_format
+
+let incompatibility_phrase (type variety) : variety trace_format -> string =
+ function
+ | Unification -> "is not compatible with type"
+ | Equality -> "is not equal to type"
+ | Moregen -> "is not compatible with type"
+
+let printing_status = function
+ | Errortrace.Diff d -> diff_printing_status d
+ | Errortrace.Escape {kind = Constraint} -> Keep
| _ -> Keep
(** Flatten the trace and remove elements that are always discarded
during printing *)
-let prepare_trace f tr =
+
+(* Takes [printing_status] to change behavior for [Subtype] *)
+let prepare_any_trace printing_status tr =
let clean_trace x l = match printing_status x with
| Keep -> x :: l
| Optional_refinement when l = [] -> [x]
| Optional_refinement | Discard -> l
in
- match Trace.flatten f tr with
+ match tr with
| [] -> []
- | elt :: rem -> (* the first element is always kept *)
- elt :: List.fold_right clean_trace rem []
+ | elt :: rem -> elt :: List.fold_right clean_trace rem []
+
+let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.flatten f tr)
(** Keep elements that are not [Diff _ ] and take the decision
for the last element, require a prepared trace *)
-let rec filter_trace keep_last = function
+let rec filter_trace trace_format keep_last = function
| [] -> []
- | [Trace.Diff d as elt] when printing_status elt = Optional_refinement ->
- if keep_last then [d] else []
- | Trace.Diff d :: rem -> d :: filter_trace keep_last rem
- | _ :: rem -> filter_trace keep_last rem
+ | [Errortrace.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ if keep_last then [d] else []
+ | Errortrace.Diff d :: rem -> d :: filter_trace trace_format keep_last rem
+ | _ :: rem -> filter_trace trace_format keep_last rem
let type_path_list =
Format.pp_print_list ~pp_sep:(fun ppf () -> Format.pp_print_break ppf 2 0)
mark_loops t; (t, t)
| _ -> prepare_expansion (t, t')
+let print_path p = Format.dprintf "%a" !Oprint.out_ident (tree_of_path Type p)
+
let print_tag ppf = fprintf ppf "`%s"
let print_tags =
| _ ->
None
-let print_pos ppf = function
- | Trace.First -> fprintf ppf "first"
- | Trace.Second -> fprintf ppf "second"
-
let explain_fixed_row_case ppf = function
- | Trace.Cannot_be_closed -> Format.fprintf ppf "it cannot be closed"
- | Trace.Cannot_add_tags tags ->
- Format.fprintf ppf "it may not allow the tag(s) %a"
- print_tags tags
+ | Errortrace.Cannot_be_closed ->
+ fprintf ppf "it cannot be closed"
+ | Errortrace.Cannot_add_tags tags ->
+ fprintf ppf "it may not allow the tag(s) %a" print_tags tags
let explain_fixed_row pos expl = match expl with
- | Types.Fixed_private ->
- dprintf "The %a variant type is private" print_pos pos
- | Types.Univar x ->
- dprintf "The %a variant type is bound to the universal type variable %a"
- print_pos pos type_expr x
- | Types.Reified p ->
- let p = tree_of_path Type p in
- dprintf "The %a variant type is bound to %a" print_pos pos
- !Oprint.out_ident p
- | Types.Rigid -> ignore
-
-let explain_variant = function
- | Trace.No_intersection ->
+ | Fixed_private ->
+ dprintf "The %a variant type is private" Errortrace.print_pos pos
+ | Univar x ->
+ dprintf "The %a variant type is bound to the universal type variable %a"
+ Errortrace.print_pos pos type_expr x
+ | Reified p ->
+ dprintf "The %a variant type is bound to %t"
+ Errortrace.print_pos pos (print_path p)
+ | Rigid -> ignore
+
+let explain_variant (type variety) : variety Errortrace.variant -> _ = function
+ (* Common *)
+ | Errortrace.Incompatible_types_for s ->
+ Some(dprintf "@,Types for tag `%s are incompatible" s)
+ (* Unification *)
+ | Errortrace.No_intersection ->
Some(dprintf "@,These two variant types have no intersection")
- | Trace.No_tags(pos,fields) -> Some(
+ | Errortrace.No_tags(pos,fields) -> Some(
dprintf
"@,@[The %a variant type does not allow tag(s)@ @[<hov>%a@]@]"
- print_pos pos
+ Errortrace.print_pos pos
print_tags (List.map fst fields)
)
- | Trace.Incompatible_types_for s ->
- Some(dprintf "@,Types for tag `%s are incompatible" s)
- | Trace.Fixed_row (pos, k, (Univar _ | Reified _ | Fixed_private as e)) ->
+ | Errortrace.Fixed_row (pos,
+ k,
+ (Univar _ | Reified _ | Fixed_private as e)) ->
Some (
dprintf "@,@[%t,@ %a@]" (explain_fixed_row pos e)
explain_fixed_row_case k
)
- | Trace.Fixed_row (_,_, Rigid) ->
+ | Errortrace.Fixed_row (_,_, Rigid) ->
(* this case never happens *)
None
-
-
-let explain_escape intro prev ctx e =
- let pre = match ctx with
- | Some ctx -> dprintf "@[%t@;<1 2>%a@]" intro type_expr ctx
- | None -> match e, prev with
- | Trace.Univ _, Some(Trace.Incompatible_fields {name; diff}) ->
- dprintf "@,@[The method %s has type@ %a,@ \
- but the expected method type was@ %a@]" name
- type_expr diff.Trace.got type_expr diff.Trace.expected
- | _ -> ignore in
- match e with
- | Trace.Univ u -> Some(
+ (* Equality & Moregen *)
+ | Errortrace.Openness pos ->
+ Some(dprintf "@,The %a variant type is open and the %a is not"
+ Errortrace.print_pos pos
+ Errortrace.print_pos (Errortrace.swap_position pos))
+
+let explain_escape pre = function
+ | Errortrace.Univ u -> Some(
dprintf "%t@,The universal variable %a would escape its scope"
pre type_expr u)
- | Trace.Constructor p -> Some(
+ | Errortrace.Constructor p -> Some(
dprintf
"%t@,@[The type constructor@;<1 2>%a@ would escape its scope@]"
pre path p
)
- | Trace.Module_type p -> Some(
+ | Errortrace.Module_type p -> Some(
dprintf
"%t@,@[The module type@;<1 2>%a@ would escape its scope@]"
pre path p
)
- | Trace.Equation (_,t) -> Some(
+ | Errortrace.Equation (_,t) -> Some(
dprintf "%t @,@[<hov>This instance of %a is ambiguous:@ %s@]"
pre type_expr t
"it would escape the scope of its equation"
)
- | Trace.Self ->
+ | Errortrace.Self ->
Some (dprintf "%t@,Self type cannot escape its class" pre)
+ | Errortrace.Constraint ->
+ None
-
-let explain_object = function
- | Trace.Self_cannot_be_closed ->
- Some (dprintf "@,Self type cannot be unified with a closed object type")
- | Trace.Missing_field (pos,f) ->
- Some(dprintf "@,@[The %a object type has no method %s@]" print_pos pos f)
- | Trace.Abstract_row pos -> Some(
+let explain_object (type variety) : variety Errortrace.obj -> _ = function
+ | Errortrace.Missing_field (pos,f) -> Some(
+ dprintf "@,@[The %a object type has no method %s@]"
+ Errortrace.print_pos pos f
+ )
+ | Errortrace.Abstract_row pos -> Some(
dprintf
"@,@[The %a object type has an abstract row, it cannot be closed@]"
- print_pos pos
+ Errortrace.print_pos pos
)
+ | Errortrace.Self_cannot_be_closed ->
+ Some (dprintf "@,Self type cannot be unified with a closed object type")
-
-let explanation intro prev env = function
- | Trace.Diff { Trace.got = _, s; expected = _,t } -> explanation_diff env s t
- | Trace.Escape {kind;context} -> explain_escape intro prev context kind
- | Trace.Incompatible_fields { name; _ } ->
- Some(dprintf "@,Types for method %s are incompatible" name)
- | Trace.Variant v -> explain_variant v
- | Trace.Obj o -> explain_object o
- | Trace.Rec_occur(x,y) ->
- reset_and_mark_loops y;
- begin match x.desc with
- | Tvar _ | Tunivar _ ->
- Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
- marked_type_expr x marked_type_expr y)
- | _ ->
- (* We had a delayed unification of the type variable with
- a non-variable after the occur check. *)
- Some ignore
- (* There is no need to search further for an explanation, but
- we don't want to print a message of the form:
- {[ The type int occurs inside int list -> 'a |}
- *)
- end
+let explanation (type variety) intro prev env
+ : ('a, variety) Errortrace.elt -> _ = function
+ | Errortrace.Diff { Errortrace.got = _,s; expected = _,t } ->
+ explanation_diff env s t
+ | Errortrace.Escape {kind;context} ->
+ let pre =
+ match context, kind, prev with
+ | Some ctx, _, _ ->
+ dprintf "@[%t@;<1 2>%a@]" intro type_expr ctx
+ | None, Univ _, Some(Errortrace.Incompatible_fields {name; diff}) ->
+ dprintf "@,@[The method %s has type@ %a,@ \
+ but the expected method type was@ %a@]"
+ name type_expr diff.got type_expr diff.expected
+ | _ -> ignore
+ in
+ explain_escape pre kind
+ | Errortrace.Incompatible_fields { name; _ } ->
+ Some(dprintf "@,Types for method %s are incompatible" name)
+ | Errortrace.Variant v ->
+ explain_variant v
+ | Errortrace.Obj o ->
+ explain_object o
+ | Errortrace.Rec_occur(x,y) ->
+ reset_and_mark_loops y;
+ begin match x.desc with
+ | Tvar _ | Tunivar _ ->
+ Some(dprintf "@,@[<hov>The type variable %a occurs inside@ %a@]"
+ type_expr x type_expr y)
+ | _ ->
+ (* We had a delayed unification of the type variable with
+ a non-variable after the occur check. *)
+ Some ignore
+ (* There is no need to search further for an explanation, but
+ we don't want to print a message of the form:
+ {[ The type int occurs inside int list -> 'a |}
+ *)
+ end
let mismatch intro env trace =
- Trace.explain trace (fun ~prev h -> explanation intro prev env h)
+ Errortrace.explain trace (fun ~prev h -> explanation intro prev env h)
let explain mis ppf =
match mis with
end
| _ -> ()
-
let prepare_expansion_head empty_tr = function
- | Trace.Diff d ->
- Some(Trace.map_diff (may_prepare_expansion empty_tr) d)
+ | Errortrace.Diff d ->
+ Some (Errortrace.map_diff (may_prepare_expansion empty_tr) d)
| _ -> None
let head_error_printer txt_got txt_but = function
| None -> ignore
| Some d ->
- let d = Trace.map_diff trees_of_type_expansion d in
+ let d = Errortrace.map_diff trees_of_type_expansion d in
dprintf "%t@;<1 2>%a@ %t@;<1 2>%a"
- txt_got type_expansion d.Trace.got
- txt_but type_expansion d.Trace.expected
+ txt_got type_expansion d.Errortrace.got
+ txt_but type_expansion d.Errortrace.expected
let warn_on_missing_defs env ppf = function
| None -> ()
- | Some {Trace.got=te1,_; expected=te2,_ } ->
+ | Some {Errortrace.got=te1,_; expected=te2,_ } ->
warn_on_missing_def env ppf te1;
warn_on_missing_def env ppf te2
-let unification_error env tr txt1 ppf txt2 ty_expect_explanation =
+let error trace_format env tr txt1 ppf txt2 ty_expect_explanation =
reset ();
let tr = prepare_trace (fun t t' -> t, hide_variant_name t') tr in
let mis = mismatch txt1 env tr in
| elt :: tr ->
try
print_labels := not !Clflags.classic;
- let tr = filter_trace (mis = None) tr in
+ let tr = filter_trace trace_format (mis = None) tr in
let head = prepare_expansion_head (tr=[]) elt in
- let tr = List.map (Trace.map_diff prepare_expansion) tr in
+ let tr = List.map (Errortrace.map_diff prepare_expansion) tr in
let head_error = head_error_printer txt1 txt2 head in
let tr = trees_of_trace tr in
fprintf ppf
@]"
head_error
ty_expect_explanation
- (trace false "is not compatible with type") tr
+ (trace false (incompatibility_phrase trace_format)) tr
(explain mis);
if env <> Env.empty
then warn_on_missing_defs env ppf head;
print_labels := true;
raise exn
-let report_unification_error ppf env tr
- ?(type_expected_explanation = fun _ -> ())
- txt1 txt2 =
- wrap_printing_env env (fun () -> unification_error env tr txt1 ppf txt2
- type_expected_explanation)
+let report_error trace_format ppf env tr
+ ?(type_expected_explanation = fun _ -> ())
+ txt1 txt2 =
+ wrap_printing_env env (fun () -> error trace_format env tr txt1 ppf txt2
+ type_expected_explanation)
~error:true
-;;
-
-(** [trace] requires the trace to be prepared *)
-let trace fst keep_last txt ppf tr =
- print_labels := not !Clflags.classic;
- try match tr with
- | elt :: tr' ->
- let elt = match elt with
- | Trace.Diff diff -> [Trace.map_diff trees_of_type_expansion diff]
- | _ -> [] in
+
+let report_unification_error =
+ report_error Unification
+let report_equality_error =
+ report_error Equality ?type_expected_explanation:None
+let report_moregen_error =
+ report_error Moregen ?type_expected_explanation:None
+
+module Subtype = struct
+ (* There's a frustrating amount of code duplication between this module and
+ the outside code, particularly in [prepare_trace] and [filter_trace].
+ Unfortunately, [Subtype] is *just* similar enough to have code duplication,
+ while being *just* different enough (it's only [Diff]) for the abstraction
+ to be nonobvious. Someday, perhaps... *)
+
+ let printing_status = function
+ | Errortrace.Subtype.Diff d -> diff_printing_status d
+
+ let prepare_unification_trace = prepare_trace
+
+ let prepare_trace f tr =
+ prepare_any_trace printing_status (Errortrace.Subtype.flatten f tr)
+
+ let trace filter_trace get_diff fst keep_last txt ppf tr =
+ print_labels := not !Clflags.classic;
+ try match tr with
+ | elt :: tr' ->
+ let diffed_elt = get_diff elt in
let tr =
trees_of_trace
- @@ List.map (Trace.map_diff prepare_expansion)
+ @@ List.map (Errortrace.map_diff prepare_expansion)
@@ filter_trace keep_last tr' in
- if fst then trace fst txt ppf (elt @ tr)
- else trace fst txt ppf tr;
- print_labels := true
- | _ -> ()
- with exn ->
- print_labels := true;
- raise exn
+ let tr =
+ match fst, diffed_elt with
+ | true, Some elt -> elt :: tr
+ | _, _ -> tr
+ in
+ trace fst txt ppf tr;
+ print_labels := true
+ | _ -> ()
+ with exn ->
+ print_labels := true;
+ raise exn
-let report_subtyping_error ppf env tr1 txt1 tr2 =
- wrap_printing_env ~error:true env (fun () ->
- reset ();
- let tr1 = prepare_trace (fun t t' -> prepare_expansion (t, t')) tr1 in
- let tr2 = prepare_trace (fun t t' -> prepare_expansion (t, t')) tr2 in
- let keep_first = match tr2 with
- | Trace.[Obj _ | Variant _ | Escape _ ] | [] -> true
- | _ -> false in
- fprintf ppf "@[<v>%a" (trace true keep_first txt1) tr1;
- if tr2 = [] then fprintf ppf "@]" else
- let mis = mismatch (dprintf "Within this type") env tr2 in
- fprintf ppf "%a%t%t@]"
- (trace false (mis = None) "is not compatible with type") tr2
- (explain mis)
- Conflicts.print_explanations
- )
+ let filter_unification_trace = filter_trace Unification
+ let rec filter_subtype_trace keep_last = function
+ | [] -> []
+ | [Errortrace.Subtype.Diff d as elt]
+ when printing_status elt = Optional_refinement ->
+ if keep_last then [d] else []
+ | Errortrace.Subtype.Diff d :: rem ->
+ d :: filter_subtype_trace keep_last rem
+
+ let unification_get_diff = function
+ | Errortrace.Diff diff ->
+ Some (Errortrace.map_diff trees_of_type_expansion diff)
+ | _ -> None
+
+ let subtype_get_diff = function
+ | Errortrace.Subtype.Diff diff ->
+ Some (Errortrace.map_diff trees_of_type_expansion diff)
+
+ let report_error ppf env tr1 txt1 tr2 =
+ wrap_printing_env ~error:true env (fun () ->
+ reset ();
+ let tr1 =
+ prepare_trace (fun t t' -> prepare_expansion (t, t')) tr1
+ in
+ let tr2 =
+ prepare_unification_trace (fun t t' -> prepare_expansion (t, t')) tr2
+ in
+ let keep_first = match tr2 with
+ | [Obj _ | Variant _ | Escape _ ] | [] -> true
+ | _ -> false in
+ fprintf ppf "@[<v>%a"
+ (trace filter_subtype_trace subtype_get_diff true keep_first txt1) tr1;
+ if tr2 = [] then fprintf ppf "@]" else
+ let mis = mismatch (dprintf "Within this type") env tr2 in
+ fprintf ppf "%a%t%t@]"
+ (trace filter_unification_trace unification_get_diff false
+ (mis = None) "is not compatible with type") tr2
+ (explain mis)
+ Conflicts.print_explanations
+ )
+end
let report_ambiguous_type_error ppf env tp0 tpl txt1 txt2 txt3 =
wrap_printing_env ~error:true env (fun () ->
let tree_of_modtype = tree_of_modtype ~ellipsis:false
let type_expansion ty ppf ty' =
type_expansion ppf (trees_of_type_expansion (ty,ty'))
-let tree_of_type_declaration id td rs =
- Naming_context.with_hidden id ( (* for disambiguation *)
- wrap_env (hide [id]) (* for short-path *)
- (fun () -> tree_of_type_declaration id td rs)
- )
+let tree_of_type_declaration ident td rs =
+ with_hidden_items [{hide=true; ident}]
+ (fun () -> tree_of_type_declaration ident td rs)
val tree_of_modtype: module_type -> out_module_type
val tree_of_modtype_declaration:
Ident.t -> modtype_declaration -> out_sig_item
+
+(** Print a list of functor parameters while adjusting the printing environment
+ for each functor argument.
+
+ Currently, we are disabling disambiguation for functor argument name to
+ avoid the need to track the moving association between identifiers and
+ syntactic names in situation like:
+
+ got: (X: sig module type T end) (Y:X.T) (X:sig module type T end) (Z:X.T)
+ expect: (_: sig end) (Y:X.T) (_:sig end) (Z:X.T)
+*)
+val functor_parameters:
+ sep:(Format.formatter -> unit -> unit) ->
+ ('b -> Format.formatter -> unit) ->
+ (Ident.t option * 'b) list -> Format.formatter -> unit
+
val tree_of_signature: Types.signature -> out_sig_item list
val tree_of_typexp: bool -> type_expr -> out_type
val modtype_declaration: Ident.t -> formatter -> modtype_declaration -> unit
val cltype_declaration: Ident.t -> formatter -> class_type_declaration -> unit
val type_expansion: type_expr -> Format.formatter -> type_expr -> unit
val prepare_expansion: type_expr * type_expr -> type_expr * type_expr
-val trace:
- bool -> bool-> string -> formatter
- -> (type_expr * type_expr) Ctype.Unification_trace.elt list -> unit
-val report_unification_error:
- formatter -> Env.t ->
- Ctype.Unification_trace.t ->
- ?type_expected_explanation:(formatter -> unit) ->
- (formatter -> unit) -> (formatter -> unit) ->
- unit
-val report_subtyping_error:
- formatter -> Env.t -> Ctype.Unification_trace.t -> string
- -> Ctype.Unification_trace.t -> unit
val report_ambiguous_type_error:
formatter -> Env.t -> (Path.t * Path.t) -> (Path.t * Path.t) list ->
(formatter -> unit) -> (formatter -> unit) -> (formatter -> unit) -> unit
+val report_unification_error :
+ formatter -> Env.t ->
+ Errortrace.unification Errortrace.t ->
+ ?type_expected_explanation:(formatter -> unit) ->
+ (formatter -> unit) -> (formatter -> unit) ->
+ unit
+
+val report_equality_error :
+ formatter -> Env.t ->
+ Errortrace.comparison Errortrace.t ->
+ (formatter -> unit) -> (formatter -> unit) ->
+ unit
+
+val report_moregen_error :
+ formatter -> Env.t ->
+ Errortrace.comparison Errortrace.t ->
+ (formatter -> unit) -> (formatter -> unit) ->
+ unit
+
+module Subtype : sig
+ val report_error :
+ formatter ->
+ Env.t ->
+ Errortrace.Subtype.t ->
+ string ->
+ Errortrace.unification Errortrace.t ->
+ unit
+end
+
(* for toploop *)
val print_items: (Env.t -> signature_item -> 'a option) ->
Env.t -> signature_item list -> (out_sig_item * 'a option) list
| Tpat_tuple (l) ->
line i ppf "Tpat_tuple\n";
list i pattern ppf l;
- | Tpat_construct (li, _, po) ->
+ | Tpat_construct (li, _, po, vto) ->
line i ppf "Tpat_construct %a\n" fmt_longident li;
list i pattern ppf po;
+ option i
+ (fun i ppf (vl,ct) ->
+ let names = List.map (fun {txt} -> "\""^Ident.name txt^"\"") vl in
+ line i ppf "[%s]\n" (String.concat "; " names);
+ core_type i ppf ct)
+ ppf vto
| Tpat_variant (l, po, _) ->
line i ppf "Tpat_variant \"%s\"\n" l;
option i pattern ppf po;
line i ppf "Tsig_modtype \"%a\"\n" fmt_ident x.mtd_id;
attributes i ppf x.mtd_attributes;
modtype_declaration i ppf x.mtd_type
+ | Tsig_modtypesubst x ->
+ line i ppf "Tsig_modtypesubst \"%a\"\n" fmt_ident x.mtd_id;
+ attributes i ppf x.mtd_attributes;
+ modtype_declaration i ppf x.mtd_type
| Tsig_open od ->
line i ppf "Tsig_open %a %a\n"
fmt_override_flag od.open_override
type_declaration (i+1) ppf td;
| Twith_module (li,_) -> line i ppf "Twith_module %a\n" fmt_path li;
| Twith_modsubst (li,_) -> line i ppf "Twith_modsubst %a\n" fmt_path li;
+ | Twith_modtype mty ->
+ line i ppf "Twith_modtype\n";
+ module_type (i+1) ppf mty
+ | Twith_modtypesubst mty ->
+ line i ppf "Twith_modtype\n";
+ module_type (i+1) ppf mty
and module_expr i ppf x =
line i ppf "module_expr %a\n" fmt_location x.mod_loc;
let implementation ppf x = list 0 structure_item ppf x.str_items;;
-let implementation_with_coercion ppf (x, _) = implementation ppf x
+let implementation_with_coercion ppf Typedtree.{structure; _} =
+ implementation ppf structure
val implementation : formatter -> structure -> unit;;
val implementation_with_coercion :
- formatter -> (structure * module_coercion) -> unit;;
+ formatter -> Typedtree.implementation -> unit;;
| Tpat_alias (pat, _, _) -> is_destructuring_pattern pat
| Tpat_constant _ -> true
| Tpat_tuple _ -> true
- | Tpat_construct (_, _, _) -> true
+ | Tpat_construct _ -> true
| Tpat_variant _ -> true
| Tpat_record (_, _) -> true
| Tpat_array _ -> true
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Fold on a signature by syntactic group of items *)
+
+(** Classes and class types generate ghosts signature items, we group them
+ together before printing *)
+type sig_item =
+ {
+ src: Types.signature_item;
+ post_ghosts: Types.signature_item list
+ (** ghost classes types are post-declared *);
+ }
+let flatten x = x.src :: x.post_ghosts
+
+type core_rec_group =
+ | Not_rec of sig_item
+ | Rec_group of sig_item list
+
+let rec_items = function
+ | Not_rec x -> [x]
+ | Rec_group x -> x
+
+(** Private row types are manifested as a sequence of definitions
+ preceding a recursive group, we collect them and separate them from the
+ syntatic recursive group. *)
+type rec_group =
+ { pre_ghosts: Types.signature_item list; group:core_rec_group }
+
+let next_group = function
+ | [] -> None
+ | src :: q ->
+ let ghosts, q =
+ match src with
+ | Types.Sig_class _ ->
+ (* a class declaration for [c] is followed by the ghost
+ declarations of class type [c], and types [c] and [#c] *)
+ begin match q with
+ | ct::t::ht::q -> [ct;t;ht], q
+ | _ -> assert false
+ end
+ | Types.Sig_class_type _ ->
+ (* a class type declaration for [ct] is followed by the ghost
+ declarations of types [ct] and [#ct] *)
+ begin match q with
+ | t::ht::q -> [t;ht], q
+ | _ -> assert false
+ end
+ | Types.(Sig_module _ | Sig_value _ | Sig_type _ | Sig_typext _
+ | Sig_modtype _) ->
+ [],q
+ in
+ Some({src; post_ghosts=ghosts}, q)
+
+let recursive_sigitem = function
+ | Types.Sig_type(ident, _, rs, _)
+ | Types.Sig_class(ident,_,rs,_)
+ | Types.Sig_class_type (ident,_,rs,_)
+ | Types.Sig_module(ident, _, _, rs, _) -> Some (ident,rs)
+ | Types.(Sig_value _ | Sig_modtype _ | Sig_typext _ ) -> None
+
+let next x =
+ let cons_group pre group q =
+ let group = Rec_group (List.rev group) in
+ Some({ pre_ghosts=List.rev pre; group },q)
+ in
+ let rec not_in_group pre l = match next_group l with
+ | None ->
+ assert (pre=[]);
+ None
+ | Some(elt, q) ->
+ match recursive_sigitem elt.src with
+ | Some (id, _) when Btype.is_row_name (Ident.name id) ->
+ not_in_group (elt.src::pre) q
+ | None | Some (_, Types.Trec_not) ->
+ let sgroup = { pre_ghosts=List.rev pre; group=Not_rec elt } in
+ Some (sgroup,q)
+ | Some (id, Types.(Trec_first | Trec_next) ) ->
+ in_group ~pre ~ids:[id] ~group:[elt] q
+ and in_group ~pre ~ids ~group rem = match next_group rem with
+ | None -> cons_group pre group []
+ | Some (elt,next) ->
+ match recursive_sigitem elt.src with
+ | Some (id, Types.Trec_next) ->
+ in_group ~pre ~ids:(id::ids) ~group:(elt::group) next
+ | None | Some (_, Types.(Trec_not|Trec_first)) ->
+ cons_group pre group rem
+ in
+ not_in_group [] x
+
+let seq l = Seq.unfold next l
+let iter f l = Seq.iter f (seq l)
+let fold f acc l = Seq.fold_left f acc (seq l)
+
+let update_rec_next rs rem =
+ match rs with
+ | Types.Trec_next -> rem
+ | Types.(Trec_first | Trec_not) ->
+ match rem with
+ | Types.Sig_type (id, decl, Trec_next, priv) :: rem ->
+ Types.Sig_type (id, decl, rs, priv) :: rem
+ | Types.Sig_module (id, pres, mty, Trec_next, priv) :: rem ->
+ Types.Sig_module (id, pres, mty, rs, priv) :: rem
+ | _ -> rem
+
+type in_place_patch = {
+ ghosts: Types.signature;
+ replace_by: Types.signature_item option;
+}
+
+
+let replace_in_place f sg =
+ let rec next_group f before signature =
+ match next signature with
+ | None -> None
+ | Some(item,sg) ->
+ core_group f ~before ~ghosts:item.pre_ghosts ~before_group:[]
+ (rec_items item.group) ~sg
+ and core_group f ~before ~ghosts ~before_group current ~sg =
+ let commit ghosts = before_group @ List.rev_append ghosts before in
+ match current with
+ | [] -> next_group f (commit ghosts) sg
+ | a :: q ->
+ match f ~rec_group:q ~ghosts a.src with
+ | Some (info, {ghosts; replace_by}) ->
+ let after = List.concat_map flatten q @ sg in
+ let after = match recursive_sigitem a.src, replace_by with
+ | None, _ | _, Some _ -> after
+ | Some (_,rs), None -> update_rec_next rs after
+ in
+ let before = match replace_by with
+ | None -> commit ghosts
+ | Some x -> x :: commit ghosts
+ in
+ let sg = List.rev_append before after in
+ Some(info, sg)
+ | None ->
+ let before_group =
+ List.rev_append a.post_ghosts (a.src :: before_group)
+ in
+ core_group f ~before ~ghosts ~before_group q ~sg
+ in
+ next_group f [] sg
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Florian Angeletti, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2021 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** Iterate on signature by syntactic group of items
+
+ Classes, class types and private row types adds ghost components to
+ the signature where they are defined.
+
+ When editing or printing a signature it is therefore important to
+ identify those ghost components.
+
+ This module provides type grouping together ghost components
+ with the corresponding core item (or recursive group) and
+ the corresponding iterators.
+*)
+
+(** Classes and class types generate ghosts signature items, we group them
+ together before printing *)
+type sig_item =
+ {
+ src: Types.signature_item (** the syntactic item *)
+;
+ post_ghosts: Types.signature_item list
+ (** ghost classes types are post-declared *);
+ }
+
+(** [flatten sig_item] is [x.src :: x.post_ghosts] *)
+val flatten: sig_item -> Types.signature
+
+(** A group of mutually recursive definition *)
+type core_rec_group =
+ | Not_rec of sig_item
+ | Rec_group of sig_item list
+
+(** [rec_items group] is the list of sig_items in the group *)
+val rec_items: core_rec_group -> sig_item list
+
+(** Private #row types are manifested as a sequence of definitions
+ preceding a recursive group, we collect them and separate them from the
+ syntatic recursive group. *)
+type rec_group =
+ { pre_ghosts: Types.signature_item list; group:core_rec_group }
+
+(** The sequence [seq signature] iterates over [signature] {!rec_group} by
+ {!rec_group}.
+ The second element of the tuple in the {!full_seq} case is the not-yet
+ traversed part of the signature.
+*)
+val next: Types.signature -> (rec_group * Types.signature) option
+val seq: Types.signature -> rec_group Seq.t
+
+val iter: (rec_group -> unit) -> Types.signature -> unit
+val fold: ('acc -> rec_group -> 'acc) -> 'acc -> Types.signature -> 'acc
+
+(** Describe how to amend one element of a signature *)
+type in_place_patch = {
+ ghosts: Types.signature; (** updated list of ghost items *)
+ replace_by: Types.signature_item option;
+ (** replacement for the selected item *)
+}
+
+(**
+ [!replace_in_place patch sg] replaces the first element of the signature
+ for which [patch ~rec_group ~ghosts component] returns [Some (value,patch)].
+ The [rec_group] argument is the remaining part of the mutually
+ recursive group of [component].
+ The [ghosts] list is the current prefix of ghost components associated to
+ [component]
+*)
+val replace_in_place:
+ ( rec_group:sig_item list -> ghosts:Types.signature -> Types.signature_item
+ -> ('a * in_place_patch) option )
+ -> Types.signature -> ('a * Types.signature) option
type t =
{ types: type_replacement Path.Map.t;
modules: Path.t Path.Map.t;
- modtypes: module_type Ident.Map.t;
+ modtypes: module_type Path.Map.t;
for_saving: bool;
+ loc: Location.t option;
}
let identity =
{ types = Path.Map.empty;
modules = Path.Map.empty;
- modtypes = Ident.Map.empty;
+ modtypes = Path.Map.empty;
for_saving = false;
+ loc = None;
}
let add_type_path id p s = { s with types = Path.Map.add id (Path p) s.types }
let add_module_path id p s = { s with modules = Path.Map.add id p s.modules }
let add_module id p s = add_module_path (Pident id) p s
-let add_modtype id ty s = { s with modtypes = Ident.Map.add id ty s.modtypes }
+let add_modtype_path p ty s = { s with modtypes = Path.Map.add p ty s.modtypes }
+let add_modtype id ty s = add_modtype_path (Pident id) ty s
let for_saving s = { s with for_saving = true }
+let change_locs s loc = { s with loc = Some loc }
+
let loc s x =
- if s.for_saving && not !Clflags.keep_locs then Location.none else x
+ match s.loc with
+ | Some l -> l
+ | None ->
+ if s.for_saving && not !Clflags.keep_locs then Location.none else x
let remove_loc =
let open Ast_mapper in
| Papply(p1, p2) ->
Papply(module_path s p1, module_path s p2)
-let modtype_path s = function
- Pident id as p ->
- begin try
- match Ident.Map.find id s.modtypes with
- | Mty_ident p -> p
- | _ -> fatal_error "Subst.modtype_path"
- with Not_found -> p end
- | Pdot(p, n) ->
- Pdot(module_path s p, n)
- | Papply _ ->
- fatal_error "Subst.modtype_path"
+let modtype_path s path =
+ match Path.Map.find path s.modtypes with
+ | Mty_ident p -> p
+ | Mty_alias _ | Mty_signature _ | Mty_functor _ ->
+ fatal_error "Subst.modtype_path"
+ | exception Not_found ->
+ match path with
+ | Pdot(p, n) ->
+ Pdot(module_path s p, n)
+ | Papply _ ->
+ fatal_error "Subst.modtype_path"
+ | Pident _ -> path
let type_path s path =
match Path.Map.find path s.types with
let newpersty desc =
decr new_id;
- { desc; level = generic_level; scope = Btype.lowest_level; id = !new_id }
+ Private_type_expr.create
+ desc ~level:generic_level ~scope:Btype.lowest_level ~id:!new_id
(* ensure that all occurrences of 'Tvar None' are physically shared *)
let tvar_none = Tvar None
else newty2 ty.level desc
in
For_copy.save_desc copy_scope ty desc;
- ty.desc <- Tsubst ty';
+ Private_type_expr.set_desc ty (Tsubst (ty', None));
+ (* TODO: move this line to btype.ml
+ there is a similar problem also in ctype.ml *)
ty'
else ty
- | Tsubst ty ->
+ | Tsubst (ty, _) ->
ty
| Tfield (m, k, _t1, _t2) when not s.for_saving && m = dummy_method
&& field_kind_repr k <> Fabsent && (repr ty).level < generic_level ->
not (is_Tconstr ty) && is_constr_row ~allow_ident:false tm in
(* Make a stub *)
let ty' = if s.for_saving then newpersty (Tvar None) else newgenvar () in
- ty'.scope <- ty.scope;
- ty.desc <- Tsubst ty';
- ty'.desc <-
+ Private_type_expr.set_scope ty' ty.scope;
+ Private_type_expr.set_desc ty (Tsubst (ty', None));
+ Private_type_expr.set_desc ty'
begin if has_fixed_row then
match tm.desc with (* PR#7348 *)
Tconstr (Pdot(m,i), tl, _abbrev) ->
| Type_function { params; body } ->
Tlink (!ctype_apply_env_empty params body args)
end
- | Tpackage(p, n, tl) ->
- Tpackage(modtype_path s p, n, List.map (typexp copy_scope s) tl)
+ | Tpackage(p, fl) ->
+ Tpackage(modtype_path s p,
+ List.map (fun (n, ty) -> (n, typexp copy_scope s ty)) fl)
| Tobject (t1, name) ->
let t1' = typexp copy_scope s t1 in
let name' =
(* We must substitute in a subtle way *)
(* Tsubst takes a tuple containing the row var and the variant *)
begin match more.desc with
- Tsubst {desc = Ttuple [_;ty2]} ->
+ Tsubst (_, Some ty2) ->
(* This variant type has been already copied *)
- ty.desc <- Tsubst ty2; (* avoid Tlink in the new type *)
+ Private_type_expr.set_desc ty (Tsubst (ty2, None));
+ (* avoid Tlink in the new type *)
Tlink ty2
| _ ->
let dup =
(* Various cases for the row variable *)
let more' =
match more.desc with
- Tsubst ty -> ty
+ Tsubst (ty, None) -> ty
| Tconstr _ | Tnil -> typexp copy_scope s more
| Tunivar _ | Tvar _ ->
For_copy.save_desc copy_scope more more.desc;
| _ -> assert false
in
(* Register new type first for recursion *)
- more.desc <- Tsubst(newgenty(Ttuple[more';ty']));
+ Private_type_expr.set_desc more
+ (Tsubst (more', Some ty'));
+ (* TODO: check if more' can be eliminated *)
(* Return a new copy *)
let row =
copy_row (typexp copy_scope s) true row (not dup) more' in
type_kind =
begin match decl.type_kind with
Type_abstract -> Type_abstract
- | Type_variant cstrs ->
- Type_variant (List.map (constructor_declaration copy_scope s) cstrs)
+ | Type_variant (cstrs, rep) ->
+ Type_variant (List.map (constructor_declaration copy_scope s) cstrs,
+ rep)
| Type_record(lbls, rep) ->
Type_record (List.map (label_declaration copy_scope s) lbls, rep)
| Type_open -> Type_open
type_loc = loc s decl.type_loc;
type_attributes = attrs s decl.type_attributes;
type_immediate = decl.type_immediate;
- type_unboxed = decl.type_unboxed;
+ type_unboxed_default = decl.type_unboxed_default;
type_uid = decl.type_uid;
}
let rec modtype scoping s = function
Mty_ident p as mty ->
- begin match p with
- Pident id ->
- begin try Ident.Map.find id s.modtypes with Not_found -> mty end
- | Pdot(p, n) ->
- Mty_ident(Pdot(module_path s p, n))
- | Papply _ ->
- fatal_error "Subst.modtype"
+ begin match Path.Map.find p s.modtypes with
+ | mty -> mty
+ | exception Not_found ->
+ begin match p with
+ | Pident _ -> mty
+ | Pdot(p, n) ->
+ Mty_ident(Pdot(module_path s p, n))
+ | Papply _ ->
+ fatal_error "Subst.modtype"
+ end
end
| Mty_signature sg ->
Mty_signature(signature scoping s sg)
(* For every binding k |-> d of m1, add k |-> f d to m2
and return resulting merged map. *)
-let merge_tbls f m1 m2 =
- Ident.Map.fold (fun k d accu -> Ident.Map.add k (f d) accu) m1 m2
-
let merge_path_maps f m1 m2 =
Path.Map.fold (fun k d accu -> Path.Map.add k (f d) accu) m1 m2
+let keep_latest_loc l1 l2 =
+ match l2 with
+ | None -> l1
+ | Some _ -> l2
+
let type_replacement s = function
| Path p -> Path (type_path s p)
| Type_function { params; body } ->
let compose s1 s2 =
{ types = merge_path_maps (type_replacement s2) s1.types s2.types;
modules = merge_path_maps (module_path s2) s1.modules s2.modules;
- modtypes = merge_tbls (modtype Keep s2) s1.modtypes s2.modtypes;
+ modtypes = merge_path_maps (modtype Keep s2) s1.modtypes s2.modtypes;
for_saving = s1.for_saving || s2.for_saving;
+ loc = keep_latest_loc s1.loc s2.loc;
}
val add_module: Ident.t -> Path.t -> t -> t
val add_module_path: Path.t -> Path.t -> t -> t
val add_modtype: Ident.t -> module_type -> t -> t
+val add_modtype_path: Path.t -> module_type -> t -> t
+
val for_saving: t -> t
val reset_for_saving: unit -> unit
+val change_locs: t -> Location.t -> t
val module_path: t -> Path.t -> Path.t
val type_path: t -> Path.t -> Path.t
| Tpat_var _ -> ()
| Tpat_constant _ -> ()
| Tpat_tuple l -> List.iter (sub.pat sub) l
- | Tpat_construct (_, _, l) -> List.iter (sub.pat sub) l
+ | Tpat_construct (_, _, l, vto) ->
+ List.iter (sub.pat sub) l;
+ Option.iter (fun (_ids, ct) -> sub.typ sub ct) vto
| Tpat_variant (_, po, _) -> Option.iter (sub.pat sub) po
| Tpat_record (l, _) -> List.iter (fun (_, _, i) -> sub.pat sub i) l
| Tpat_array l -> List.iter (sub.pat sub) l
| Tsig_modsubst x -> sub.module_substitution sub x
| Tsig_recmodule list -> List.iter (sub.module_declaration sub) list
| Tsig_modtype x -> sub.module_type_declaration sub x
+ | Tsig_modtypesubst x -> sub.module_type_declaration sub x
| Tsig_include incl -> include_infos (sub.module_type sub) incl
| Tsig_class list -> List.iter (sub.class_description sub) list
| Tsig_class_type list -> List.iter (sub.class_type_declaration sub) list
| Twith_typesubst decl -> sub.type_declaration sub decl
| Twith_module _ -> ()
| Twith_modsubst _ -> ()
+ | Twith_modtype _ -> ()
+ | Twith_modtypesubst _ -> ()
+
let open_description sub {open_env; _} = sub.env sub open_env
| Tpat_var _
| Tpat_constant _ -> x.pat_desc
| Tpat_tuple l -> Tpat_tuple (List.map (sub.pat sub) l)
- | Tpat_construct (loc, cd, l) ->
- Tpat_construct (loc, cd, List.map (sub.pat sub) l)
+ | Tpat_construct (loc, cd, l, vto) ->
+ let vto = Option.map (fun (vl,cty) -> vl, sub.typ sub cty) vto in
+ Tpat_construct (loc, cd, List.map (sub.pat sub) l, vto)
| Tpat_variant (l, po, rd) ->
Tpat_variant (l, Option.map (sub.pat sub) po, rd)
| Tpat_record (l, closed) ->
Tsig_recmodule (List.map (sub.module_declaration sub) list)
| Tsig_modtype x ->
Tsig_modtype (sub.module_type_declaration sub x)
- | Tsig_include incl ->
+ | Tsig_modtypesubst x ->
+ Tsig_modtypesubst (sub.module_type_declaration sub x)
+ | Tsig_include incl ->
Tsig_include (include_infos (sub.module_type sub) incl)
| Tsig_class list ->
Tsig_class (List.map (sub.class_description sub) list)
| Twith_type decl -> Twith_type (sub.type_declaration sub decl)
| Twith_typesubst decl -> Twith_typesubst (sub.type_declaration sub decl)
| Twith_module _
- | Twith_modsubst _ as d -> d
+ | Twith_modsubst _
+ | Twith_modtype _
+ | Twith_modtypesubst _ as d -> d
let open_description sub od =
{od with open_env = sub.env sub od.open_env}
arity: int;
pub_meths: string list;
coe: Warnings.loc list;
- expr: 'a;
req: 'a Typedtree.class_infos;
}
type class_env = { val_env : Env.t; met_env : Env.t; par_env : Env.t }
type error =
- Unconsistent_constraint of Ctype.Unification_trace.t
- | Field_type_mismatch of string * string * Ctype.Unification_trace.t
+ | Unconsistent_constraint of Errortrace.unification Errortrace.t
+ | Field_type_mismatch of string * string * Errortrace.unification Errortrace.t
| Structure_expected of class_type
| Cannot_apply of class_type
| Apply_wrong_label of arg_label
| Unbound_class_2 of Longident.t
| Unbound_class_type_2 of Longident.t
| Abbrev_type_clash of type_expr * type_expr * type_expr
- | Constructor_type_mismatch of string * Ctype.Unification_trace.t
+ | Constructor_type_mismatch of string * Errortrace.unification Errortrace.t
| Virtual_class of bool * bool * string list * string list
| Parameter_arity_mismatch of Longident.t * int * int
- | Parameter_mismatch of Ctype.Unification_trace.t
+ | Parameter_mismatch of Errortrace.unification Errortrace.t
| Bad_parameters of Ident.t * type_expr * type_expr
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
| Non_generalizable_class of Ident.t * Types.class_declaration
| Cannot_coerce_self of type_expr
| Non_collapsable_conjunction of
- Ident.t * Types.class_declaration * Ctype.Unification_trace.t
- | Final_self_clash of Ctype.Unification_trace.t
+ Ident.t * Types.class_declaration * Errortrace.unification Errortrace.t
+ | Final_self_clash of Errortrace.unification Errortrace.t
| Mutability_mismatch of string * mutable_flag
| No_overriding of string * string
| Duplicate of string * string
begin try
Ctype.unify env self_type cl_sig.csig_self
with Ctype.Unify trace ->
- let open Ctype.Unification_trace in
match trace with
| Diff _ :: Incompatible_fields {name = n; _ } :: rem ->
raise(Error(loc, env, Field_type_mismatch ("method", n, rem)))
Exp.case
(Pat.construct ~loc
(mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
- (Some (Pat.var ~loc (mknoloc "*sth*"))))
+ (Some ([], Pat.var ~loc (mknoloc "*sth*"))))
(Exp.ident ~loc (mknoloc (Longident.Lident "*sth*")));
Exp.case
type_loc = loc;
type_attributes = []; (* or keep attrs from the class decl? *)
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = uid;
}
env
type_loc = cl.pci_loc;
type_attributes = []; (* or keep attrs from cl? *)
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = dummy_class.cty_uid;
}
in
type_loc = cl.pci_loc;
type_attributes = []; (* or keep attrs from cl? *)
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = dummy_class.cty_uid;
}
in
raise(Error(cl.pci_loc, env, Unbound_type_var(printer, reason)))
end;
{ id; clty; ty_id; cltydef; obj_id; obj_abbr; cl_id; cl_abbr; arity;
- pub_meths; coe; expr;
+ pub_meths; coe;
id_loc = cl.pci_name;
req = { ci_loc = cl.pci_loc;
ci_virt = cl.pci_virt;
| Repeated_parameter ->
fprintf ppf "A type parameter occurs several times"
| Unconsistent_constraint trace ->
- fprintf ppf "The class constraints are not consistent.@.";
+ fprintf ppf "@[<v>The class constraints are not consistent.@ ";
Printtyp.report_unification_error ppf env trace
(fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "is not compatible with type")
+ (fun ppf -> fprintf ppf "is not compatible with type");
+ fprintf ppf "@]"
| Field_type_mismatch (k, m, trace) ->
Printtyp.report_unification_error ppf env trace
(function ppf ->
*)
type error =
- Unconsistent_constraint of Ctype.Unification_trace.t
- | Field_type_mismatch of string * string * Ctype.Unification_trace.t
+ | Unconsistent_constraint of Errortrace.unification Errortrace.t
+ | Field_type_mismatch of string * string * Errortrace.unification Errortrace.t
| Structure_expected of class_type
| Cannot_apply of class_type
| Apply_wrong_label of arg_label
| Unbound_class_2 of Longident.t
| Unbound_class_type_2 of Longident.t
| Abbrev_type_clash of type_expr * type_expr * type_expr
- | Constructor_type_mismatch of string * Ctype.Unification_trace.t
+ | Constructor_type_mismatch of string * Errortrace.unification Errortrace.t
| Virtual_class of bool * bool * string list * string list
| Parameter_arity_mismatch of Longident.t * int * int
- | Parameter_mismatch of Ctype.Unification_trace.t
+ | Parameter_mismatch of Errortrace.unification Errortrace.t
| Bad_parameters of Ident.t * type_expr * type_expr
| Class_match_failure of Ctype.class_match_failure list
| Unbound_val of string
| Non_generalizable_class of Ident.t * Types.class_declaration
| Cannot_coerce_self of type_expr
| Non_collapsable_conjunction of
- Ident.t * Types.class_declaration * Ctype.Unification_trace.t
- | Final_self_clash of Ctype.Unification_trace.t
+ Ident.t * Types.class_declaration * Errortrace.unification Errortrace.t
+ | Final_self_clash of Errortrace.unification Errortrace.t
| Mutability_mismatch of string * mutable_flag
| No_overriding of string * string
| Duplicate of string * string
explanation: type_forcing_context option;
}
+type to_unpack = {
+ tu_name: string Location.loc;
+ tu_loc: Location.t;
+ tu_uid: Uid.t
+}
+
module Datatype_kind = struct
type t = Record | Variant
type error =
| Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * Ctype.Unification_trace.t
+ | Label_mismatch of Longident.t * Errortrace.unification Errortrace.t
| Pattern_type_clash :
- Ctype.Unification_trace.t * _ pattern_desc option -> error
- | Or_pattern_type_clash of Ident.t * Ctype.Unification_trace.t
+ Errortrace.unification Errortrace.t * _ pattern_desc option -> error
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification Errortrace.t
| Multiply_bound_variable of string
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
- Ctype.Unification_trace.t * type_forcing_context option
+ Errortrace.unification Errortrace.t * type_forcing_context option
* expression_desc option
| Apply_non_function of type_expr
| Apply_wrong_label of arg_label * type_expr * bool
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
- | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
+ | Not_subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of
- type_expr * type_expr * Ctype.Unification_trace.t * bool
+ type_expr * type_expr * Errortrace.unification Errortrace.t * bool
| Too_many_arguments of bool * type_expr * type_forcing_context option
| Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
| Scoping_let_module of string * type_expr
| Not_a_variant_type of Longident.t
| Incoherent_label_order
- | Less_general of string * Ctype.Unification_trace.t
+ | Less_general of string * Errortrace.unification Errortrace.t
| Modules_not_allowed
| Cannot_infer_signature
| Not_a_packed_module of type_expr
| Illegal_letrec_pat
| Illegal_letrec_expr
| Illegal_class_expr
- | Letop_type_clash of string * Ctype.Unification_trace.t
- | Andop_type_clash of string * Ctype.Unification_trace.t
- | Bindings_type_clash of Ctype.Unification_trace.t
+ | Letop_type_clash of string * Errortrace.unification Errortrace.t
+ | Andop_type_clash of string * Errortrace.unification Errortrace.t
+ | Bindings_type_clash of Errortrace.unification Errortrace.t
+ | Unbound_existential of Ident.t list * type_expr
+ | Missing_type_constraint
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
;;
+(* Context for inline record arguments; see [type_ident] *)
+
type recarg =
| Allowed
| Required
let extract_concrete_variant env ty =
match extract_concrete_typedecl env ty with
- (p0, p, {type_kind=Type_variant cstrs}) -> (p0, p, cstrs)
+ (p0, p, {type_kind=Type_variant (cstrs, _)}) -> (p0, p, cstrs)
| (p0, p, {type_kind=Type_open}) -> (p0, p, [])
| _ -> raise Not_found
with Error (loc, env, Pattern_type_clash(trace, None)) ->
raise(Error(loc, env, Pattern_type_clash(trace, Some pat.pat_desc)))
+(* unification of a type with a Tconstr with freshly created arguments *)
+let unify_head_only ~refine loc env ty constr =
+ let path =
+ match (repr constr.cstr_res).desc with
+ | Tconstr(p, _, _) -> p
+ | _ -> assert false in
+ let decl = Env.find_type path !env in
+ let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
+ unify_pat_types ~refine loc env ty' ty
+
(* Creating new conjunctive types is not allowed when typing patterns *)
(* make all Reither present in open variants *)
let finalize_variant pat tag opat r =
match extra with
| Tpat_type _ | Tpat_open _ | Tpat_unpack -> as_ty
| Tpat_constraint cty ->
+ (* [generic_instance] can only be used if the variables of the original
+ type ([cty.ctyp_type] here) are not at [generic_level], which they are
+ here.
+ If we used [generic_instance] we would lose the sharing between
+ [instance ty] and [ty]. *)
begin_def ();
let ty = instance cty.ctyp_type in
end_def ();
| Tpat_tuple pl ->
let tyl = List.map (build_as_type env) pl in
newty (Ttuple tyl)
- | Tpat_construct(_, cstr, pl) ->
- let keep = cstr.cstr_private = Private || cstr.cstr_existentials <> [] in
+ | Tpat_construct(_, cstr, pl, vto) ->
+ let keep =
+ cstr.cstr_private = Private || cstr.cstr_existentials <> [] ||
+ vto <> None (* be lazy and keep the type for node constraints *) in
if keep then p.pat_type else
let tyl = List.map (build_as_type env) pl in
- let ty_args, ty_res = instance_constructor cstr in
+ let ty_args, ty_res, _ = instance_constructor cstr in
List.iter2 (fun (p,ty) -> unify_pat env {p with pat_type = ty})
(List.combine pl tyl) ty_args;
ty_res
| Tpat_any | Tpat_var _ | Tpat_constant _
| Tpat_array _ | Tpat_lazy _ -> p.pat_type
+(* Constraint solving during typing of patterns *)
+
+let solve_Ppat_poly_constraint ~refine env loc sty expected_ty =
+ let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
+ unify_pat_types ~refine loc env ty (instance expected_ty);
+ pattern_force := force :: !pattern_force;
+ match ty.desc with
+ | Tpoly (body, tyl) ->
+ begin_def ();
+ init_def generic_level;
+ let _, ty' = instance_poly ~keep_names:true false tyl body in
+ end_def ();
+ (cty, ty, ty')
+ | _ -> assert false
+
+let solve_Ppat_alias env pat =
+ begin_def ();
+ let ty_var = build_as_type env pat in
+ end_def ();
+ generalize ty_var;
+ ty_var
+
+let solve_Ppat_tuple (type a) ~refine loc env (args : a list) expected_ty =
+ let vars = List.map (fun _ -> newgenvar ()) args in
+ let ty = newgenty (Ttuple vars) in
+ let expected_ty = generic_instance expected_ty in
+ unify_pat_types ~refine loc env ty expected_ty;
+ vars
+
+let solve_constructor_annotation env name_list sty ty_args ty_ex =
+ let expansion_scope = get_gadt_equations_level () in
+ let ids =
+ List.map
+ (fun name ->
+ let decl = new_local_type ~loc:name.loc () in
+ let (id, new_env) =
+ Env.enter_type ~scope:expansion_scope name.txt decl !env in
+ env := new_env;
+ {name with txt = id})
+ name_list
+ in
+ begin_def ();
+ let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
+ end_def ();
+ generalize_structure ty;
+ pattern_force := force :: !pattern_force;
+ let ty_args =
+ let ty1 = instance ty and ty2 = instance ty in
+ match ty_args with
+ [] -> assert false
+ | [ty_arg] ->
+ unify_pat_types cty.ctyp_loc env ty1 ty_arg;
+ [ty2]
+ | _ ->
+ unify_pat_types cty.ctyp_loc env ty1 (newty (Ttuple ty_args));
+ match repr (expand_head !env ty2) with
+ {desc = Ttuple tyl} -> tyl
+ | _ -> assert false
+ in
+ if ids <> [] then ignore begin
+ let ids = List.map (fun x -> x.txt) ids in
+ let rem =
+ List.fold_left
+ (fun rem tv ->
+ match repr tv with
+ {desc = Tconstr(Path.Pident id, [], _)}
+ when List.mem id rem ->
+ list_remove id rem
+ | _ ->
+ raise (Error (cty.ctyp_loc, !env,
+ Unbound_existential (ids, ty))))
+ ids ty_ex
+ in
+ if rem <> [] then
+ raise (Error (cty.ctyp_loc, !env,
+ Unbound_existential (ids, ty)))
+ end;
+ ty_args, Some (ids, cty)
+
+let solve_Ppat_construct ~refine env loc constr no_existentials
+ existential_styp expected_ty =
+ (* if constructor is gadt, we must verify that the expected type has the
+ correct head *)
+ if constr.cstr_generalized then
+ unify_head_only ~refine loc env (instance expected_ty) constr;
+ begin_def ();
+ let expected_ty = instance expected_ty in
+ (* PR#7214: do not use gadt unification for toplevel lets *)
+ let unify_res ty_res =
+ let refine =
+ match refine, no_existentials with
+ | None, None when constr.cstr_generalized -> Some false
+ | _ -> refine
+ in
+ unify_pat_types_return_equated_pairs ~refine loc env ty_res expected_ty
+ in
+ let expansion_scope = get_gadt_equations_level () in
+ let ty_args, ty_res, equated_types, existential_ctyp =
+ match existential_styp with
+ None ->
+ let ty_args, ty_res, _ =
+ instance_constructor ~in_pattern:(env, expansion_scope) constr in
+ ty_args, ty_res, unify_res ty_res, None
+ | Some (name_list, sty) ->
+ let in_pattern =
+ if name_list = [] then Some (env, expansion_scope) else None in
+ let ty_args, ty_res, ty_ex =
+ instance_constructor ?in_pattern constr in
+ let equated_types = unify_res ty_res in
+ let ty_args, existential_ctyp =
+ solve_constructor_annotation env name_list sty ty_args ty_ex in
+ ty_args, ty_res, equated_types, existential_ctyp
+ in
+ end_def ();
+ generalize_structure expected_ty;
+ generalize_structure ty_res;
+ List.iter generalize_structure ty_args;
+ if !Clflags.principal then begin
+ let exception Warn_only_once in
+ try
+ TypePairs.iter
+ (fun (t1, t2) () ->
+ generalize_structure t1;
+ generalize_structure t2;
+ if not (fully_generic t1 && fully_generic t2) then
+ let msg =
+ Format.asprintf
+ "typing this pattern requires considering@ %a@ and@ %a@ as \
+ equal.@,\
+ But the knowledge of these types"
+ Printtyp.type_expr t1
+ Printtyp.type_expr t2
+ in
+ Location.prerr_warning loc (Warnings.Not_principal msg);
+ raise Warn_only_once)
+ equated_types
+ with Warn_only_once -> ()
+ end;
+ (ty_args, existential_ctyp)
+
+let solve_Ppat_record_field ~refine loc env label label_lid record_ty =
+ begin_def ();
+ let (_, ty_arg, ty_res) = instance_label false label in
+ begin try
+ unify_pat_types ~refine loc env ty_res (instance record_ty)
+ with Error(_loc, _env, Pattern_type_clash(trace, _)) ->
+ raise(Error(label_lid.loc, !env,
+ Label_mismatch(label_lid.txt, trace)))
+ end;
+ end_def ();
+ generalize_structure ty_res;
+ generalize_structure ty_arg;
+ ty_arg
+
+let solve_Ppat_array ~refine loc env expected_ty =
+ let ty_elt = newgenvar() in
+ let expected_ty = generic_instance expected_ty in
+ unify_pat_types ~refine
+ loc env (Predef.type_array ty_elt) expected_ty;
+ ty_elt
+
+let solve_Ppat_lazy ~refine loc env expected_ty =
+ let nv = newgenvar () in
+ unify_pat_types ~refine loc env (Predef.type_lazy_t nv)
+ (generic_instance expected_ty);
+ nv
+
+let solve_Ppat_constraint ~refine loc env sty expected_ty =
+ begin_def();
+ let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
+ end_def();
+ pattern_force := force :: !pattern_force;
+ generalize_structure ty;
+ let ty, expected_ty' = instance ty, ty in
+ unify_pat_types ~refine loc env ty (instance expected_ty);
+ (cty, ty, expected_ty')
+
+let solve_Ppat_variant ~refine loc env tag constant expected_ty =
+ let arg_type = if constant then [] else [newgenvar()] in
+ let row = { row_fields =
+ [tag, Reither(constant, arg_type, true, ref None)];
+ row_bound = ();
+ row_closed = false;
+ row_more = newgenvar ();
+ row_fixed = None;
+ row_name = None } in
+ let expected_ty = generic_instance expected_ty in
+ (* PR#7404: allow some_private_tag blindly, as it would not unify with
+ the abstract row variable *)
+ if tag <> Parmatch.some_private_tag then
+ unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty;
+ (arg_type, row, instance expected_ty)
+
+(* Building the or-pattern corresponding to a polymorphic variant type *)
let build_or_pat env loc lid =
let path, decl = Env.lookup_type ~loc:lid.loc lid.txt env in
let tyl = List.map (fun _ -> newvar()) decl.type_params in
{pat_desc=Tpat_or(pat0,pat,Some row0); pat_extra=[];
pat_loc=gloc; pat_env=env; pat_type=ty; pat_attributes=[]})
pat pats in
- (path, rp { r with pat_loc = loc },ty)
+ (path, rp { r with pat_loc = loc })
let split_cases env cases =
let add_case lst case = function
module Label = NameChoice (struct
type t = label_description
- type usage = unit
+ type usage = Env.label_usage
let kind = Datatype_kind.Record
let get_name lbl = lbl.lbl_name
let get_type lbl = lbl.lbl_res
- let lookup_all_from_type loc () path env =
- Env.lookup_all_labels_from_type ~loc path env
+ let lookup_all_from_type loc usage path env =
+ Env.lookup_all_labels_from_type ~loc usage path env
let in_env lbl =
match lbl.lbl_repres with
| Record_regular | Record_float | Record_unboxed false -> true
Ok labels
(* Only issue warnings once per record constructor/pattern *)
-let disambiguate_lid_a_list loc closed env expected_type lid_a_list =
+let disambiguate_lid_a_list loc closed env usage expected_type lid_a_list =
let ids = List.map (fun (lid, _) -> Longident.last lid.txt) lid_a_list in
let w_pr = ref false and w_amb = ref []
and w_scope = ref [] and w_scope_ty = ref "" in
| _ -> Location.prerr_warning loc msg
in
let process_label lid =
- let scope = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
+ let scope = Env.lookup_all_labels ~loc:lid.loc usage lid.txt env in
let filter : Label.nonempty_candidate_filter =
disambiguate_label_by_ids closed ids in
- Label.disambiguate ~warn ~filter () lid env expected_type scope in
+ Label.disambiguate ~warn ~filter usage lid env expected_type scope in
let lbl_a_list =
List.map (fun (lid,a) -> lid, process_label lid, a) lid_a_list in
if !w_pr then
xs (fun ys -> k (List.rev ys)) []
let type_label_a_list
- ?labels loc closed env type_lbl_a expected_type lid_a_list k =
+ ?labels loc closed env usage type_lbl_a expected_type lid_a_list k =
let lbl_a_list =
match lid_a_list, labels with
({txt=Longident.Lident s}, _)::_, Some labels when Hashtbl.mem labels s ->
| _ -> lid_a)
lid_a_list
in
- disambiguate_lid_a_list loc closed env expected_type lid_a_list
+ disambiguate_lid_a_list loc closed env usage expected_type lid_a_list
in
(* Invariant: records are sorted in the typed tree *)
let lbl_a_list =
let in_env _ = true
end)
-(* unification of a type with a tconstr with
- freshly created arguments *)
-let unify_head_only ~refine loc env ty constr =
- let (_, ty_res) = instance_constructor constr in
- let ty_res = repr ty_res in
- match ty_res.desc with
- | Tconstr(p,args,m) ->
- ty_res.desc <- Tconstr(p,List.map (fun _ -> newvar ()) args,m);
- enforce_constraints !env ty_res;
- unify_pat_types ~refine loc env ty_res ty
- | _ -> assert false
-
(* Typing of patterns *)
(* "half typed" cases are produced in [type_cases] when we've just typechecked
false
| Ppat_exception p
| Ppat_variant (_, Some p)
- | Ppat_construct (_, Some p)
+ | Ppat_construct (_, Some (_, p))
| Ppat_constraint (p, _)
| Ppat_alias (p, _)
| Ppat_lazy p
let check_scope_escape loc env level ty =
try Ctype.check_scope_escape env level ty
- with Unify trace ->
- raise(Error(loc, env, Pattern_type_clash(trace, None)))
+ with Escape trace ->
+ raise(Error(loc, env, Pattern_type_clash([Escape trace], None)))
type pattern_checking_mode =
| Normal
In counter-example mode, [Empty_branch] is raised when the counter-example
does not match any value. *)
let rec type_pat
- : type k r . k pattern_category -> no_existentials:_ -> mode:_ ->
- env:_ -> _ -> _ -> (k general_pattern -> r) -> r
+ : type k r . k pattern_category ->
+ no_existentials: existential_restriction option ->
+ mode: pattern_checking_mode -> env: Env.t ref -> Parsetree.pattern ->
+ type_expr -> (k general_pattern -> r) -> r
= fun category ~no_existentials ~mode
~env sp expected_ty k ->
Builtin_attributes.warning_scope sp.ppat_attributes
let loc = sp.ppat_loc in
let refine =
match mode with Normal -> None | Counter_example _ -> Some true in
- let unif (x : pattern) : pattern =
+ let solve_expected (x : pattern) : pattern =
unify_pat ~refine env x (instance expected_ty);
x
in
({ptyp_desc=Ptyp_poly _} as sty)) ->
(* explicitly polymorphic type *)
assert construction_not_used_in_counterexamples;
- let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
- unify_pat_types ~refine lloc env ty (instance expected_ty);
- pattern_force := force :: !pattern_force;
- begin match ty.desc with
- | Tpoly (body, tyl) ->
- begin_def ();
- init_def generic_level;
- let _, ty' = instance_poly ~keep_names:true false tyl body in
- end_def ();
- let id = enter_variable lloc name ty' attrs in
- rvp k {
- pat_desc = Tpat_var (id, name);
- pat_loc = lloc;
- pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
- pat_type = ty;
- pat_attributes = [];
- pat_env = !env
- }
- | _ -> assert false
- end
+ let cty, ty, ty' =
+ solve_Ppat_poly_constraint ~refine env lloc sty expected_ty in
+ let id = enter_variable lloc name ty' attrs in
+ rvp k { pat_desc = Tpat_var (id, name);
+ pat_loc = lloc;
+ pat_extra = [Tpat_constraint cty, loc, sp.ppat_attributes];
+ pat_type = ty;
+ pat_attributes = [];
+ pat_env = !env }
| Ppat_alias(sq, name) ->
assert construction_not_used_in_counterexamples;
type_pat Value sq expected_ty (fun q ->
- begin_def ();
- let ty_var = build_as_type env q in
- end_def ();
- generalize ty_var;
+ let ty_var = solve_Ppat_alias env q in
let id =
enter_variable ~is_as_variable:true loc name ty_var sp.ppat_attributes
in
pat_env = !env })
| Ppat_constant cst ->
let cst = constant_or_raise !env loc cst in
- rvp k @@ unif {
+ rvp k @@ solve_expected {
pat_desc = Tpat_constant cst;
pat_loc = loc; pat_extra=[];
pat_type = type_constant cst;
raise (Error (loc, !env, Invalid_interval))
| Ppat_tuple spl ->
assert (List.length spl >= 2);
- let spl_ann = List.map (fun p -> (p,newgenvar ())) spl in
- let ty = newgenty (Ttuple(List.map snd spl_ann)) in
- let expected_ty = generic_instance expected_ty in
- unify_pat_types ~refine loc env ty expected_ty;
+ let expected_tys = solve_Ppat_tuple ~refine loc env spl expected_ty in
+ let spl_ann = List.combine spl expected_tys in
map_fold_cont (fun (p,t) -> type_pat Value p t) spl_ann (fun pl ->
rvp k {
pat_desc = Tpat_tuple pl;
| Some r, (_ :: _ as exs) ->
let exs = List.map (Ctype.existential_name constr) exs in
let name = constr.cstr_name in
- raise (Error (loc, !env, Unexpected_existential (r,name, exs)))
+ raise (Error (loc, !env, Unexpected_existential (r, name, exs)))
end;
- (* if constructor is gadt, we must verify that the expected type has the
- correct head *)
- if constr.cstr_generalized then
- unify_head_only ~refine loc env (instance expected_ty) constr;
- let sargs =
+ let sarg', existential_styp =
match sarg with
+ None -> None, None
+ | Some (vl, {ppat_desc = Ppat_constraint (sp, sty)})
+ when vl <> [] || constr.cstr_arity > 1 ->
+ Some sp, Some (vl, sty)
+ | Some ([], sp) ->
+ Some sp, None
+ | Some (_, sp) ->
+ raise (Error (sp.ppat_loc, !env, Missing_type_constraint))
+ in
+ let sargs =
+ match sarg' with
None -> []
| Some {ppat_desc = Ppat_tuple spl} when
constr.cstr_arity > 1 ||
Builtin_attributes.explicit_arity sp.ppat_attributes
-> spl
- | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity <> 1 ->
- if constr.cstr_arity = 0 then
- Location.prerr_warning sp.ppat_loc
- Warnings.Wildcard_arg_to_constant_constr;
+ | Some({ppat_desc = Ppat_any} as sp) when
+ constr.cstr_arity = 0 && existential_styp = None
+ ->
+ Location.prerr_warning sp.ppat_loc
+ Warnings.Wildcard_arg_to_constant_constr;
+ []
+ | Some({ppat_desc = Ppat_any} as sp) when constr.cstr_arity > 1 ->
replicate_list sp constr.cstr_arity
| Some sp -> [sp] in
if Builtin_attributes.warn_on_literal_pattern constr.cstr_attributes then
if List.length sargs <> constr.cstr_arity then
raise(Error(loc, !env, Constructor_arity_mismatch(lid.txt,
constr.cstr_arity, List.length sargs)));
- begin_def ();
- let (ty_args, ty_res) =
- instance_constructor ~in_pattern:(env, get_gadt_equations_level ())
- constr
- in
- let expected_ty = instance expected_ty in
- (* PR#7214: do not use gadt unification for toplevel lets *)
- let refine =
- if refine = None && constr.cstr_generalized && no_existentials = None
- then Some false
- else refine
- in
- let equated_types =
- unify_pat_types_return_equated_pairs ~refine loc env ty_res expected_ty
+
+ let (ty_args, existential_ctyp) =
+ solve_Ppat_construct ~refine env loc constr no_existentials
+ existential_styp expected_ty
in
- end_def ();
- generalize_structure expected_ty;
- generalize_structure ty_res;
- List.iter generalize_structure ty_args;
- if !Clflags.principal then (
- let exception Warn_only_once in
- try
- TypePairs.iter (fun (t1, t2) () ->
- generalize_structure t1;
- generalize_structure t2;
- if not (fully_generic t1 && fully_generic t2) then
- let msg =
- Format.asprintf
- "typing this pattern requires considering@ %a@ and@ %a@ as \
- equal.@,\
- But the knowledge of these types"
- Printtyp.type_expr t1
- Printtyp.type_expr t2
- in
- Location.prerr_warning loc (Warnings.Not_principal msg);
- raise Warn_only_once
- ) equated_types
- with Warn_only_once -> ()
- );
let rec check_non_escaping p =
match p.ppat_desc with
| _ ->
()
in
- if constr.cstr_inlined <> None then List.iter check_non_escaping sargs;
+ if constr.cstr_inlined <> None then begin
+ List.iter check_non_escaping sargs;
+ Option.iter (fun (_, sarg) -> check_non_escaping sarg) sarg
+ end;
map_fold_cont
(fun (p,t) -> type_pat Value p t)
(List.combine sargs ty_args)
(fun args ->
rvp k {
- pat_desc=Tpat_construct(lid, constr, args);
+ pat_desc=Tpat_construct(lid, constr, args, existential_ctyp);
pat_loc = loc; pat_extra=[];
pat_type = instance expected_ty;
pat_attributes = sp.ppat_attributes;
pat_env = !env })
- | Ppat_variant(l, sarg) ->
- let arg_type = match sarg with None -> [] | Some _ -> [newgenvar()] in
- let row = { row_fields =
- [l, Reither(sarg = None, arg_type, true, ref None)];
- row_bound = ();
- row_closed = false;
- row_more = newgenvar ();
- row_fixed = None;
- row_name = None } in
- let expected_ty = generic_instance expected_ty in
- (* PR#7404: allow some_private_tag blindly, as it would not unify with
- the abstract row variable *)
- if l = Parmatch.some_private_tag
- then assert (match mode with Normal -> false | Counter_example _ -> true)
- else unify_pat_types ~refine loc env (newgenty(Tvariant row)) expected_ty;
+ | Ppat_variant(tag, sarg) ->
+ if tag = Parmatch.some_private_tag then
+ assert (match mode with Normal -> false | Counter_example _ -> true);
+ let constant = (sarg = None) in
+ let arg_type, row, pat_type =
+ solve_Ppat_variant ~refine loc env tag constant expected_ty in
let k arg =
rvp k {
- pat_desc = Tpat_variant(l, arg, ref {row with row_more = newvar()});
- pat_loc = loc; pat_extra=[];
- pat_type = instance expected_ty;
+ pat_desc = Tpat_variant(tag, arg, ref {row with row_more = newvar()});
+ pat_loc = loc; pat_extra = [];
+ pat_type = pat_type;
pat_attributes = sp.ppat_attributes;
pat_env = !env }
in begin
with Not_found -> None, newvar ()
in
let type_label_pat (label_lid, label, sarg) k =
- begin_def ();
- let (_, ty_arg, ty_res) = instance_label false label in
- begin try
- unify_pat_types ~refine loc env ty_res (instance record_ty)
- with Error(_loc, _env, Pattern_type_clash(trace, _)) ->
- raise(Error(label_lid.loc, !env,
- Label_mismatch(label_lid.txt, trace)))
- end;
- end_def ();
- generalize_structure ty_res;
- generalize_structure ty_arg;
+ let ty_arg =
+ solve_Ppat_record_field ~refine loc env label label_lid record_ty in
type_pat Value sarg ty_arg (fun arg ->
k (label_lid, label, arg))
in
pat_env = !env;
}
in
- let k' pat = rvp k (unif pat) in
+ let k' pat = rvp k @@ solve_expected pat in
begin match mode with
| Normal ->
k' (wrap_disambiguate "This record pattern is expected to have"
(mk_expected expected_ty)
- (type_label_a_list loc false !env type_label_pat expected_type
- lid_sp_list)
+ (type_label_a_list loc false !env Env.Projection
+ type_label_pat expected_type lid_sp_list)
make_record_pat)
| Counter_example {labels; _} ->
- type_label_a_list ~labels loc false !env type_label_pat expected_type
- lid_sp_list (fun lbl_pat_list -> k' (make_record_pat lbl_pat_list))
+ type_label_a_list ~labels loc false !env Env.Projection
+ type_label_pat expected_type lid_sp_list
+ (fun lbl_pat_list -> k' (make_record_pat lbl_pat_list))
end
| Ppat_array spl ->
- let ty_elt = newgenvar() in
- let expected_ty = generic_instance expected_ty in
- unify_pat_types ~refine
- loc env (Predef.type_array ty_elt) expected_ty;
+ let ty_elt = solve_Ppat_array ~refine loc env expected_ty in
map_fold_cont (fun p -> type_pat Value p ty_elt) spl (fun pl ->
rvp k {
pat_desc = Tpat_array pl;
pat_attributes = sp.ppat_attributes;
pat_env = !env })
| Ppat_or(sp1, sp2) ->
- let may_split, must_split =
- match get_splitting_mode mode with
- | None -> false, false
- | Some Backtrack_or -> true, true
- | Some (Refine_or _) -> true, false in
- let state = save_state env in
- let split_or sp =
- assert may_split;
- let typ pat = type_pat category pat expected_ty k in
- find_valid_alternative (fun pat -> set_state state env; typ pat) sp in
- if must_split then split_or sp else begin
- let initial_pattern_variables = !pattern_variables in
- let initial_module_variables = !module_variables in
- let equation_level = !gadt_equations_level in
- let outter_lev = get_current_level () in
- (* introduce a new scope *)
- begin_def ();
- let lev = get_current_level () in
- gadt_equations_level := Some lev;
- let env1 = ref !env in
- let inside_or = enter_nonsplit_or mode in
- let type_pat_result env sp : (_, abort_reason) result =
- match
- type_pat category ~mode:inside_or sp expected_ty ~env (fun x -> x)
- with
- | res -> Ok res
- | exception Need_backtrack -> Error Adds_constraints
- | exception Empty_branch -> Error Empty
- in
- let p1 = type_pat_result env1 sp1 in
- let p1_variables = !pattern_variables in
- let p1_module_variables = !module_variables in
- pattern_variables := initial_pattern_variables;
- module_variables := initial_module_variables;
- let env2 = ref !env in
- let p2 = type_pat_result env2 sp2 in
- end_def ();
- gadt_equations_level := equation_level;
- let p2_variables = !pattern_variables in
- (* Make sure no variable with an ambiguous type gets added to the
- environment. *)
- List.iter (fun { pv_type; pv_loc; _ } ->
- check_scope_escape pv_loc !env1 outter_lev pv_type
- ) p1_variables;
- List.iter (fun { pv_type; pv_loc; _ } ->
- check_scope_escape pv_loc !env2 outter_lev pv_type
- ) p2_variables;
- begin match p1, p2 with
- | Error Empty, Error Empty ->
- raise Empty_branch
- | Error Adds_constraints, Error _
- | Error _, Error Adds_constraints ->
- let inside_nonsplit_or =
- match get_splitting_mode mode with
- | None | Some Backtrack_or -> false
- | Some (Refine_or {inside_nonsplit_or}) -> inside_nonsplit_or in
- if inside_nonsplit_or
- then raise Need_backtrack
- else split_or sp
- | Ok p, Error _
- | Error _, Ok p ->
- rp k p
- | Ok p1, Ok p2 ->
- let alpha_env =
- enter_orpat_variables loc !env p1_variables p2_variables in
- let p2 = alpha_pat alpha_env p2 in
- pattern_variables := p1_variables;
- module_variables := p1_module_variables;
- let make_pat desc =
- { pat_desc = desc;
- pat_loc = loc; pat_extra=[];
- pat_type = instance expected_ty;
- pat_attributes = sp.ppat_attributes;
- pat_env = !env } in
- rp k (make_pat (Tpat_or(p1, p2, None)))
- end
+ begin match mode with
+ | Normal ->
+ let initial_pattern_variables = !pattern_variables in
+ let initial_module_variables = !module_variables in
+ let equation_level = !gadt_equations_level in
+ let outter_lev = get_current_level () in
+ (* introduce a new scope *)
+ begin_def ();
+ let lev = get_current_level () in
+ gadt_equations_level := Some lev;
+ let type_pat_rec env sp =
+ type_pat category sp expected_ty ~env (fun x -> x) in
+ let env1 = ref !env in
+ let p1 = type_pat_rec env1 sp1 in
+ let p1_variables = !pattern_variables in
+ let p1_module_variables = !module_variables in
+ pattern_variables := initial_pattern_variables;
+ module_variables := initial_module_variables;
+ let env2 = ref !env in
+ let p2 = type_pat_rec env2 sp2 in
+ end_def ();
+ gadt_equations_level := equation_level;
+ let p2_variables = !pattern_variables in
+ (* Make sure no variable with an ambiguous type gets added to the
+ environment. *)
+ List.iter (fun { pv_type; pv_loc; _ } ->
+ check_scope_escape pv_loc !env1 outter_lev pv_type
+ ) p1_variables;
+ List.iter (fun { pv_type; pv_loc; _ } ->
+ check_scope_escape pv_loc !env2 outter_lev pv_type
+ ) p2_variables;
+ let alpha_env =
+ enter_orpat_variables loc !env p1_variables p2_variables in
+ let p2 = alpha_pat alpha_env p2 in
+ pattern_variables := p1_variables;
+ module_variables := p1_module_variables;
+ rp k { pat_desc = Tpat_or (p1, p2, None);
+ pat_loc = loc; pat_extra = [];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !env }
+ | Counter_example {splitting_mode; _} ->
+ (* We are in counter-example mode, but try to avoid backtracking *)
+ let must_split =
+ match splitting_mode with
+ | Backtrack_or -> true
+ | Refine_or _ -> false in
+ let state = save_state env in
+ let split_or sp =
+ let typ pat = type_pat category pat expected_ty k in
+ find_valid_alternative (fun pat -> set_state state env; typ pat) sp
+ in
+ if must_split then split_or sp else
+ let type_pat_result env sp : (_, abort_reason) result =
+ let mode = enter_nonsplit_or mode in
+ match type_pat category ~mode sp expected_ty ~env (fun x -> x) with
+ | res -> Ok res
+ | exception Need_backtrack -> Error Adds_constraints
+ | exception Empty_branch -> Error Empty
+ in
+ let p1 = type_pat_result (ref !env) sp1 in
+ let p2 = type_pat_result (ref !env) sp2 in
+ match p1, p2 with
+ | Error Empty, Error Empty ->
+ raise Empty_branch
+ | Error Adds_constraints, Error _
+ | Error _, Error Adds_constraints ->
+ let inside_nonsplit_or =
+ match splitting_mode with
+ | Backtrack_or -> false
+ | Refine_or {inside_nonsplit_or} -> inside_nonsplit_or in
+ if inside_nonsplit_or
+ then raise Need_backtrack
+ else split_or sp
+ | Ok p, Error _
+ | Error _, Ok p ->
+ rp k p
+ | Ok p1, Ok p2 ->
+ rp k { pat_desc = Tpat_or (p1, p2, None);
+ pat_loc = loc; pat_extra = [];
+ pat_type = instance expected_ty;
+ pat_attributes = sp.ppat_attributes;
+ pat_env = !env }
end
| Ppat_lazy sp1 ->
- let nv = newgenvar () in
- unify_pat_types ~refine loc env (Predef.type_lazy_t nv)
- (generic_instance expected_ty);
+ let nv = solve_Ppat_lazy ~refine loc env expected_ty in
(* do not explode under lazy: PR#7421 *)
type_pat Value ~mode:(no_explosion mode) sp1 nv (fun p1 ->
rvp k {
pat_attributes = sp.ppat_attributes;
pat_env = !env })
| Ppat_constraint(sp, sty) ->
+ assert construction_not_used_in_counterexamples;
(* Pretend separate = true *)
- begin_def();
- let cty, ty, force = Typetexp.transl_simple_type_delayed !env sty in
- end_def();
- generalize_structure ty;
- let ty, expected_ty' = instance ty, ty in
- unify_pat_types ~refine loc env ty (instance expected_ty);
+ let cty, ty, expected_ty' =
+ solve_Ppat_constraint ~refine loc env sty expected_ty in
type_pat category sp expected_ty' (fun p ->
(*Format.printf "%a@.%a@."
Printtyp.raw_type_expr ty
Printtyp.raw_type_expr p.pat_type;*)
- pattern_force := force :: !pattern_force;
let extra = (Tpat_constraint cty, loc, sp.ppat_attributes) in
let p : k general_pattern =
match category, (p : k general_pattern) with
{ p with pat_type = ty; pat_extra = extra::p.pat_extra }
in k p)
| Ppat_type lid ->
- let (path, p,ty) = build_or_pat !env loc lid in
- unify_pat_types ~refine loc env ty (instance expected_ty);
- k @@ pure category @@ { p with pat_extra =
- (Tpat_type (path, lid), loc, sp.ppat_attributes)
+ assert construction_not_used_in_counterexamples;
+ let (path, p) = build_or_pat !env loc lid in
+ k @@ pure category @@ solve_expected
+ { p with pat_extra = (Tpat_type (path, lid), loc, sp.ppat_attributes)
:: p.pat_extra }
| Ppat_open (lid,p) ->
+ assert construction_not_used_in_counterexamples;
let path, new_env =
!type_open Asttypes.Fresh !env sp.ppat_loc lid in
- let new_env = ref new_env in
- type_pat category ~env:new_env p expected_ty ( fun p ->
- env := Env.copy_local !env ~from:!new_env;
- k { p with pat_extra =( Tpat_open (path,lid,!new_env),
- loc, sp.ppat_attributes) :: p.pat_extra }
+ env := new_env;
+ type_pat category ~env p expected_ty ( fun p ->
+ let new_env = !env in
+ begin match Env.remove_last_open path new_env with
+ | None -> assert false
+ | Some closed_env -> env := closed_env
+ end;
+ k { p with pat_extra = (Tpat_open (path,lid,new_env),
+ loc, sp.ppat_attributes) :: p.pat_extra }
)
| Ppat_exception p ->
type_pat Value p Predef.type_exn (fun p_exn ->
let pvs = get_ref pattern_variables in
let unpacks =
List.map (fun (name, loc) ->
- name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+ {tu_name = name; tu_loc = loc;
+ tu_uid = Uid.mk ~current_unit:(Env.get_unit_name ())}
) (get_ref module_variables)
in
let new_env = add_pattern_variables !new_env pvs in
if not complete then
let ty_expected = instance ty_expected in
raise (Error (exp.exp_loc, env,
- Less_general(kind, [Unification_trace.diff ty ty_expected])))
+ Less_general(kind, [Errortrace.diff ty ty_expected])))
let generalize_and_check_univars env kind exp ty_expected vars =
generalize exp.exp_type;
let generalizable level ty =
let rec check ty =
let ty = repr ty in
- if ty.level < lowest_level then () else
- if ty.level <= level then raise Exit else
- (mark_type_node ty; iter_type_expr check ty)
+ if not_marked_node ty then
+ if ty.level <= level then raise Exit else
+ (flip_mark_node ty; iter_type_expr check ty)
in
try check ty; unmark_type ty; true
with Exit -> unmark_type ty; false
(* Hack to allow coercion of self. Will clean-up later. *)
let self_coercion = ref ([] : (Path.t * Location.t list ref) list)
-(* Helpers for packaged modules. *)
-let create_package_type loc env (p, l) =
- let s = !Typetexp.transl_modtype_longident loc env p in
- let fields = List.map (fun (name, ct) ->
- name, Typetexp.transl_simple_type env false ct) l in
- let ty = newty (Tpackage (s,
- List.map fst l,
- List.map (fun (_, cty) -> cty.ctyp_type) fields))
- in
- (s, fields, ty)
-
(* Helpers for type_cases *)
let contains_variant_either ty =
let rec loop ty =
let ty = repr ty in
- if ty.level >= lowest_level then begin
- mark_type_node ty;
- match ty.desc with
+ if try_mark_node ty then
+ begin match ty.desc with
Tvariant row ->
let row = row_repr row in
if not (is_fixed row) then
iter_row loop row
| _ ->
iter_type_expr loop ty
- end
+ end
in
try loop ty; unmark_type ty; false
with Exit -> unmark_type ty; true
let shallow_iter_ppat f p =
match p.ppat_desc with
| Ppat_any | Ppat_var _ | Ppat_constant _ | Ppat_interval _
+ | Ppat_construct (_, None)
| Ppat_extension _
| Ppat_type _ | Ppat_unpack _ -> ()
| Ppat_array pats -> List.iter f pats
| Ppat_or (p1,p2) -> f p1; f p2
- | Ppat_variant (_, arg) | Ppat_construct (_, arg) -> Option.iter f arg
+ | Ppat_variant (_, arg) -> Option.iter f arg
| Ppat_tuple lst -> List.iter f lst
+ | Ppat_construct (_, Some (_, p))
| Ppat_exception p | Ppat_alias (p,_)
| Ppat_open (_,p)
| Ppat_constraint (p,_) | Ppat_lazy p -> f p
let contains_gadt p =
exists_general_pattern { f = fun (type k) (p : k general_pattern) ->
match p.pat_desc with
- | Tpat_construct (_, cd, _) when cd.cstr_generalized -> true
+ | Tpat_construct (_, cd, _, _) when cd.cstr_generalized -> true
| _ -> false } p
(* There are various things that we need to do in presence of GADT constructors
let may_contain_gadts p =
exists_ppat
(function
- | {ppat_desc = Ppat_construct (_, _)} -> true
+ | {ppat_desc = Ppat_construct _} -> true
| _ -> false)
p
with Error(loc, env, Expr_type_clash(trace, tfc, None)) ->
raise (Error(loc, env, Expr_type_clash(trace, tfc, Some exp.exp_desc)))
+(* If [is_inferred e] is true, [e] will be typechecked without using
+ the "expected type" provided by the context. *)
+
+let rec is_inferred sexp =
+ match sexp.pexp_desc with
+ | Pexp_ident _ | Pexp_apply _ | Pexp_field _ | Pexp_constraint _
+ | Pexp_coerce _ | Pexp_send _ | Pexp_new _ -> true
+ | Pexp_sequence (_, e) | Pexp_open (_, e) -> is_inferred e
+ | Pexp_ifthenelse (_, e1, Some e2) -> is_inferred e1 && is_inferred e2
+ | _ -> false
+
+(* check if the type of %apply or %revapply matches the type expected by
+ the specialized typing rule for those primitives.
+*)
+type apply_prim =
+ | Apply
+ | Revapply
+let check_apply_prim_type prim typ =
+ match (repr typ).desc with
+ | Tarrow (Nolabel,a,b,_) ->
+ begin match (repr b).desc with
+ | Tarrow(Nolabel,c,d,_) ->
+ let f, x, res =
+ match prim with
+ | Apply -> a, c, d
+ | Revapply -> c, a, d
+ in
+ let f, x, res = repr f, repr x, repr res in
+ begin match f.desc with
+ | Tarrow(Nolabel,fl,fr,_) ->
+ let fl, fr = repr fl, repr fr in
+ is_Tvar fl && is_Tvar fr && is_Tvar x && is_Tvar res
+ && fl == x && fr == res
+ | _ -> false
+ end
+ | _ -> false
+ end
+ | _ -> false
+
+(* Merge explanation to type clash error *)
+
+let with_explanation explanation f =
+ match explanation with
+ | None -> f ()
+ | Some explanation ->
+ try f ()
+ with Error (loc', env', Expr_type_clash(trace', None, exp'))
+ when not loc'.Location.loc_ghost ->
+ let err = Expr_type_clash(trace', Some explanation, exp') in
+ raise (Error (loc', env', err))
+
let rec type_exp ?recarg env sexp =
(* We now delegate everything to type_expect *)
type_expect ?recarg env sexp (mk_expected (newvar ()))
(Cmt_format.Partial_expression exp :: previous_saved_types);
exp
-and with_explanation explanation f =
- match explanation with
- | None -> f ()
- | Some explanation ->
- try f ()
- with Error (loc', env', Expr_type_clash(trace', None, exp'))
- when not loc'.Location.loc_ghost ->
- let err = Expr_type_clash(trace', Some explanation, exp') in
- raise (Error (loc', env', err))
-
and type_expect_
?in_function ?(recarg=Rejected)
env sexp ty_expected_explained =
Exp.case
(Pat.construct ~loc:default_loc
(mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))))
- (Some (Pat.var ~loc:default_loc (mknoloc "*sth*"))))
+ (Some ([], Pat.var ~loc:default_loc (mknoloc "*sth*"))))
(Exp.ident ~loc:default_loc (mknoloc (Longident.Lident "*sth*")));
Exp.case
loc sexp.pexp_attributes env ty_expected_explained Nolabel caselist
| Pexp_apply(sfunct, sargs) ->
assert (sargs <> []);
- begin_def (); (* one more level for non-returning functions *)
- if !Clflags.principal then begin_def ();
- let funct = type_exp env sfunct in
- if !Clflags.principal then begin
- end_def ();
- generalize_structure funct.exp_type
- end;
let rec lower_args seen ty_fun =
let ty = expand_head env ty_fun in
if List.memq ty seen then () else
- match ty.desc with
- Tarrow (_l, ty_arg, ty_fun, _com) ->
- (try unify_var env (newvar()) ty_arg with Unify _ -> assert false);
- lower_args (ty::seen) ty_fun
- | _ -> ()
+ match ty.desc with
+ Tarrow (_l, ty_arg, ty_fun, _com) ->
+ (try unify_var env (newvar()) ty_arg
+ with Unify _ -> assert false);
+ lower_args (ty::seen) ty_fun
+ | _ -> ()
+ in
+ let type_sfunct sfunct =
+ begin_def (); (* one more level for non-returning functions *)
+ if !Clflags.principal then begin_def ();
+ let funct = type_exp env sfunct in
+ if !Clflags.principal then begin
+ end_def ();
+ generalize_structure funct.exp_type
+ end;
+ let ty = instance funct.exp_type in
+ end_def ();
+ wrap_trace_gadt_instances env (lower_args []) ty;
+ funct
+ in
+ let funct, sargs =
+ let funct = type_sfunct sfunct in
+ match funct.exp_desc, sargs with
+ | Texp_ident (_, _,
+ {val_kind = Val_prim {prim_name="%revapply"}; val_type}),
+ [Nolabel, sarg; Nolabel, actual_sfunct]
+ when is_inferred actual_sfunct
+ && check_apply_prim_type Revapply val_type ->
+ type_sfunct actual_sfunct, [Nolabel, sarg]
+ | Texp_ident (_, _,
+ {val_kind = Val_prim {prim_name="%apply"}; val_type}),
+ [Nolabel, actual_sfunct; Nolabel, sarg]
+ when check_apply_prim_type Apply val_type ->
+ type_sfunct actual_sfunct, [Nolabel, sarg]
+ | _ ->
+ funct, sargs
in
- let ty = instance funct.exp_type in
- end_def ();
- wrap_trace_gadt_instances env (lower_args []) ty;
begin_def ();
let (args, ty_res) = type_application env funct sargs in
end_def ();
begin try match
sarg, expand_head env ty_expected, expand_head env ty_expected0 with
| Some sarg, {desc = Tvariant row}, {desc = Tvariant row0} ->
- let row = row_repr row in
+ let row = row_repr row and row0 = row_repr row0 in
begin match row_field_repr (List.assoc l row.row_fields),
row_field_repr (List.assoc l row0.row_fields) with
Rpresent (Some ty), Rpresent (Some ty0) ->
let lbl_exp_list =
wrap_disambiguate "This record expression is expected to have"
(mk_expected ty_record)
- (type_label_a_list loc closed env
+ (type_label_a_list loc closed env Env.Construct
(fun e k -> k (type_label_exp true env loc ty_record e))
expected_type lid_sexp_list)
(fun x -> x)
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_field(srecord, lid) ->
- let (record, label, _) = type_label_access env srecord lid in
+ let (record, label, _) =
+ type_label_access env srecord Env.Projection lid
+ in
let (_, ty_arg, ty_res) = instance_label false label in
unify_exp env record ty_res;
rue {
exp_env = env }
| Pexp_setfield(srecord, lid, snewval) ->
let (record, label, expected_type) =
- type_label_access env srecord lid in
+ type_label_access env srecord Env.Mutation lid in
let ty_record =
if expected_type = None then newvar () else record.exp_type in
let (label_loc, label, newval) =
let ty, b = enlarge_type env ty' in
force ();
begin try Ctype.unify env arg.exp_type ty with Unify trace ->
+ let expanded = full_expand ~may_forget_scope:true env ty' in
raise(Error(sarg.pexp_loc, env,
- Coercion_failure(ty', full_expand env ty', trace, b)))
+ Coercion_failure(ty', expanded, trace, b)))
end
end;
(arg, ty', None, cty')
(* remember original level *)
begin_def ();
(* Create a fake abstract type declaration for name. *)
- let decl = {
- type_params = [];
- type_arity = 0;
- type_kind = Type_abstract;
- type_private = Public;
- type_manifest = None;
- type_variance = [];
- type_separability = [];
- type_is_newtype = true;
- type_expansion_scope = Btype.lowest_level;
- type_loc = loc;
- type_attributes = [];
- type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
- type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
- }
- in
+ let decl = new_local_type ~loc () in
let scope = create_scope () in
let (id, new_env) = Env.enter_type ~scope name decl env in
exp_extra =
(Texp_newtype name, loc, sexp.pexp_attributes) :: body.exp_extra }
| Pexp_pack m ->
- let (p, nl) =
+ let (p, fl) =
match Ctype.expand_head env (instance ty_expected) with
- {desc = Tpackage (p, nl, _tl)} ->
+ {desc = Tpackage (p, fl)} ->
if !Clflags.principal &&
(Ctype.expand_head env ty_expected).level < Btype.generic_level
then
Location.prerr_warning loc
(Warnings.Not_principal "this module packing");
- (p, nl)
+ (p, fl)
| {desc = Tvar _} ->
raise (Error (loc, env, Cannot_infer_signature))
| _ ->
raise (Error (loc, env, Not_a_packed_module ty_expected))
in
- let (modl, tl') = !type_package env m p nl in
+ let (modl, fl') = !type_package env m p fl in
rue {
exp_desc = Texp_pack modl;
exp_loc = loc; exp_extra = [];
- exp_type = newty (Tpackage (p, nl, tl'));
+ exp_type = newty (Tpackage (p, fl'));
exp_attributes = sexp.pexp_attributes;
exp_env = env }
| Pexp_open (od, e) ->
in
path, desc
-and type_function ?in_function loc attrs env ty_expected_explained l caselist =
+and type_function ?(in_function : (Location.t * type_expr) option)
+ loc attrs env ty_expected_explained arg_label caselist =
let { ty = ty_expected; explanation } = ty_expected_explained in
let (loc_fun, ty_fun) =
match in_function with Some p -> p
let separate = !Clflags.principal || Env.has_local_constraints env in
if separate then begin_def ();
let (ty_arg, ty_res) =
- try filter_arrow env (instance ty_expected) l
+ try filter_arrow env (instance ty_expected) arg_label
with Unify _ ->
match expand_head env ty_expected with
{desc = Tarrow _} as ty ->
- raise(Error(loc, env, Abstract_wrong_label(l, ty, explanation)))
+ raise(Error(loc, env,
+ Abstract_wrong_label(arg_label, ty, explanation)))
| _ ->
raise(Error(loc_fun, env,
Too_many_arguments (in_function <> None,
explanation)))
in
let ty_arg =
- if is_optional l then
+ if is_optional arg_label then
let tv = newvar() in
begin
try unify env ty_arg (type_option tv)
let ls, tvar = list_labels env ty in
List.for_all ((<>) Nolabel) ls && not tvar
in
- if is_optional l && not_nolabel_function ty_res then
+ if is_optional arg_label && not_nolabel_function ty_res then
Location.prerr_warning (List.hd cases).c_lhs.pat_loc
Warnings.Unerasable_optional_argument;
let param = name_cases "param" cases in
re {
- exp_desc = Texp_function { arg_label = l; param; cases; partial; };
+ exp_desc = Texp_function { arg_label; param; cases; partial; };
exp_loc = loc; exp_extra = [];
- exp_type = instance (newgenty (Tarrow(l, ty_arg, ty_res, Cok)));
+ exp_type = instance (newgenty (Tarrow(arg_label, ty_arg, ty_res, Cok)));
exp_attributes = attrs;
exp_env = env }
-and type_label_access env srecord lid =
+and type_label_access env srecord usage lid =
if !Clflags.principal then begin_def ();
let record = type_exp ~recarg:Allowed env srecord in
if !Clflags.principal then begin
Some(p0, p, (repr ty_exp).level = generic_level || not !Clflags.principal)
with Not_found -> None
in
- let labels = Env.lookup_all_labels ~loc:lid.loc lid.txt env in
+ let labels = Env.lookup_all_labels ~loc:lid.loc usage lid.txt env in
let label =
wrap_disambiguate "This expression has" (mk_expected ty_exp)
- (Label.disambiguate () lid env expected_type) labels in
+ (Label.disambiguate usage lid env expected_type) labels in
(record, label, expected_type)
(* Typing format strings for printing or reading.
let ls, tvar = list_labels env ty in
not tvar && List.for_all ((=) Nolabel) ls
in
- let rec is_inferred sexp =
- match sexp.pexp_desc with
- Pexp_ident _ | Pexp_apply _ | Pexp_field _ | Pexp_constraint _
- | Pexp_coerce _ | Pexp_send _ | Pexp_new _ -> true
- | Pexp_sequence (_, e) | Pexp_open (_, e) -> is_inferred e
- | Pexp_ifthenelse (_, e1, Some e2) -> is_inferred e1 && is_inferred e2
- | _ -> false
+ let may_coerce =
+ if not (is_inferred sarg) then None else
+ let work () =
+ match expand_head env ty_expected' with
+ {desc = Tarrow(Nolabel,_,ty_res0,_); level} ->
+ Some (no_labels ty_res0, level)
+ | _ -> None
+ in
+ (* Need to be careful not to expand local constraints here *)
+ if Env.has_local_constraints env then
+ let snap = Btype.snapshot () in
+ try_finally ~always:(fun () -> Btype.backtrack snap) work
+ else work ()
in
- match expand_head env ty_expected' with
- {desc = Tarrow(Nolabel,ty_arg,ty_res,_); level = lv}
- when is_inferred sarg ->
+ match may_coerce with
+ Some (safe_expect, lv) ->
(* apply optional arguments when expected type is "" *)
(* we must be very careful about not breaking the semantics *)
if !Clflags.principal then begin_def ();
| Tvar _ -> List.rev args, ty_fun, false
| _ -> [], texp.exp_type, false
in
- let args, ty_fun', simple_res = make_args [] texp.exp_type in
- let warn = !Clflags.principal &&
- (lv <> generic_level || (repr ty_fun').level <> generic_level)
- and texp = {texp with exp_type = instance texp.exp_type}
- and ty_fun = instance ty_fun' in
- if not (simple_res || no_labels ty_res) then begin
+ let args, ty_fun', simple_res = make_args [] texp.exp_type
+ and texp = {texp with exp_type = instance texp.exp_type} in
+ if not (simple_res || safe_expect) then begin
unify_exp env texp ty_expected;
texp
end else begin
+ let warn = !Clflags.principal &&
+ (lv <> generic_level || (repr ty_fun').level <> generic_level)
+ and ty_fun = instance ty_fun' in
+ let ty_arg, ty_res =
+ match expand_head env ty_expected' with
+ {desc = Tarrow(Nolabel,ty_arg,ty_res,_)} -> ty_arg, ty_res
+ | _ -> assert false
+ in
unify_exp env {texp with exp_type = ty_fun} ty_expected;
if args = [] then texp else
(* eta-expand to avoid side effects *)
}],
func let_var) }
end
- | _ ->
+ | None ->
let texp = type_expect ?recarg env sarg
(mk_expected ?explanation ty_expected') in
unify_exp env texp ty_expected;
(lid.txt, constr.cstr_arity, List.length sargs)));
let separate = !Clflags.principal || Env.has_local_constraints env in
if separate then (begin_def (); begin_def ());
- let (ty_args, ty_res) = instance_constructor constr in
+ let (ty_args, ty_res, _) = instance_constructor constr in
let texp =
re {
exp_desc = Texp_construct(lid, constr, []);
exp
end
-and type_unpacks ?in_function env unpacks sbody expected_ty =
+and type_unpacks ?(in_function : (Location.t * type_expr) option)
+ env (unpacks : to_unpack list) sbody expected_ty =
let ty = newvar() in
(* remember original level *)
let extended_env, tunpacks =
- List.fold_left (fun (env, unpacks) (name, loc, uid) ->
+ List.fold_left (fun (env, tunpacks) unpack ->
begin_def ();
let context = Typetexp.narrow () in
let modl =
!type_module env
Ast_helper.(
- Mod.unpack ~loc
- (Exp.ident ~loc:name.loc (mkloc (Longident.Lident name.txt)
- name.loc)))
+ Mod.unpack ~loc:unpack.tu_loc
+ (Exp.ident ~loc:unpack.tu_name.loc
+ (mkloc (Longident.Lident unpack.tu_name.txt)
+ unpack.tu_name.loc)))
in
Mtype.lower_nongen ty.level modl.mod_type;
let pres =
in
let scope = create_scope () in
let md =
- { md_type = modl.mod_type; md_attributes = []; md_loc = name.loc;
- md_uid = uid; }
+ { md_type = modl.mod_type; md_attributes = [];
+ md_loc = unpack.tu_name.loc;
+ md_uid = unpack.tu_uid; }
in
let (id, env) =
- Env.enter_module_declaration ~scope name.txt pres md env
+ Env.enter_module_declaration ~scope unpack.tu_name.txt pres md env
in
Typetexp.widen context;
- env, (id, name, pres, modl) :: unpacks
+ env, (id, unpack.tu_name, pres, modl) :: tunpacks
) (env, []) unpacks
in
(* ideally, we should catch Expr_type_clash errors
in
let unpacks =
List.map (fun (name, loc) ->
- name, loc, Uid.mk ~current_unit:(Env.get_unit_name ())
+ {tu_name = name; tu_loc = loc;
+ tu_uid = Uid.mk ~current_unit:(Env.get_unit_name ())}
) unpacks
in
let ty_res' =
(* Returns the first diff of the trace *)
let type_clash_of_trace trace =
- Ctype.Unification_trace.(explain trace (fun ~prev:_ -> function
+ Errortrace.(explain trace (fun ~prev:_ -> function
| Diff diff -> Some diff
| _ -> None
))
| _, _ -> []
let report_literal_type_constraint const = function
- | Some Unification_trace.
- { expected = { t = { desc = Tconstr (typ, [], _) } } } ->
+ | Some Errortrace.{ expected = { t = { desc = Tconstr (typ, [], _) } } } ->
report_literal_type_constraint typ const
| Some _ | None -> []
| Pattern_type_clash (trace, pat) ->
let diff = type_clash_of_trace trace in
let sub = report_pattern_type_clash_hints pat diff in
- Location.error_of_printer ~loc ~sub (fun ppf () ->
- Printtyp.report_unification_error ppf env trace
- (function ppf ->
- fprintf ppf "This pattern matches values of type")
- (function ppf ->
- fprintf ppf "but a pattern was expected which matches values of \
- type");
- ) ()
+ report_unification_error ~loc ~sub env trace
+ (function ppf ->
+ fprintf ppf "This pattern matches values of type")
+ (function ppf ->
+ fprintf ppf "but a pattern was expected which matches values of \
+ type");
| Or_pattern_type_clash (id, trace) ->
report_unification_error ~loc env trace
(function ppf ->
| Expr_type_clash (trace, explanation, exp) ->
let diff = type_clash_of_trace trace in
let sub = report_expr_type_clash_hints exp diff in
- Location.error_of_printer ~loc ~sub (fun ppf () ->
- Printtyp.report_unification_error ppf env trace
- ~type_expected_explanation:
- (report_type_expected_explanation_opt explanation)
- (function ppf ->
- fprintf ppf "This expression has type")
- (function ppf ->
- fprintf ppf "but an expression was expected of type");
- ) ()
+ report_unification_error ~loc ~sub env trace
+ ~type_expected_explanation:
+ (report_type_expected_explanation_opt explanation)
+ (function ppf ->
+ fprintf ppf "This expression has type")
+ (function ppf ->
+ fprintf ppf "but an expression was expected of type");
| Apply_non_function typ ->
begin match (repr typ).desc with
Tarrow _ ->
end else begin
fprintf ppf
"@[@[<2>%s type@ %a%t@]@ \
- The %s %s does not belong to type %a@]"
+ There is no %s %s within type %a@]"
eorp Printtyp.type_expr ty
(report_type_expected_explanation_opt explanation)
(Datatype_kind.label_name kind)
Location.errorf ~loc "The instance variable %s is not mutable" v
| Not_subtype(tr1, tr2) ->
Location.error_of_printer ~loc (fun ppf () ->
- Printtyp.report_subtyping_error ppf env tr1 "is not a subtype of" tr2
+ Printtyp.Subtype.report_error ppf env tr1 "is not a subtype of" tr2
) ()
| Outside_class ->
Location.errorf ~loc
fprintf ppf "These bindings have type")
(function ppf ->
fprintf ppf "but bindings were expected of type")
+ | Unbound_existential (ids, ty) ->
+ Location.errorf ~loc
+ "@[<2>%s:@ @[type %s.@ %a@]@]"
+ "This type does not bind all existentials in the constructor"
+ (String.concat " " (List.map Ident.name ids))
+ Printtyp.type_expr ty
+ | Missing_type_constraint ->
+ Location.errorf ~loc
+ "@[%s@ %s@]"
+ "Existential types introduced in a constructor pattern"
+ "must be bound by a type constraint on the argument."
let report_error ~loc env err =
Printtyp.wrap_printing_env ~error:true env
type error =
| Constructor_arity_mismatch of Longident.t * int * int
- | Label_mismatch of Longident.t * Ctype.Unification_trace.t
+ | Label_mismatch of Longident.t * Errortrace.unification Errortrace.t
| Pattern_type_clash :
- Ctype.Unification_trace.t * _ Typedtree.pattern_desc option -> error
- | Or_pattern_type_clash of Ident.t * Ctype.Unification_trace.t
+ Errortrace.unification Errortrace.t * _ Typedtree.pattern_desc option
+ -> error
+ | Or_pattern_type_clash of Ident.t * Errortrace.unification Errortrace.t
| Multiply_bound_variable of string
| Orpat_vars of Ident.t * Ident.t list
| Expr_type_clash of
- Ctype.Unification_trace.t * type_forcing_context option
+ Errortrace.unification Errortrace.t * type_forcing_context option
* Typedtree.expression_desc option
| Apply_non_function of type_expr
| Apply_wrong_label of arg_label * type_expr * bool
| Private_constructor of constructor_description * type_expr
| Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
- | Not_subtype of Ctype.Unification_trace.t * Ctype.Unification_trace.t
+ | Not_subtype of Errortrace.Subtype.t * Errortrace.unification Errortrace.t
| Outside_class
| Value_multiply_overridden of string
| Coercion_failure of
- type_expr * type_expr * Ctype.Unification_trace.t * bool
+ type_expr * type_expr * Errortrace.unification Errortrace.t * bool
| Too_many_arguments of bool * type_expr * type_forcing_context option
| Abstract_wrong_label of arg_label * type_expr * type_forcing_context option
| Scoping_let_module of string * type_expr
| Not_a_variant_type of Longident.t
| Incoherent_label_order
- | Less_general of string * Ctype.Unification_trace.t
+ | Less_general of string * Errortrace.unification Errortrace.t
| Modules_not_allowed
| Cannot_infer_signature
| Not_a_packed_module of type_expr
| Illegal_letrec_pat
| Illegal_letrec_expr
| Illegal_class_expr
- | Letop_type_clash of string * Ctype.Unification_trace.t
- | Andop_type_clash of string * Ctype.Unification_trace.t
- | Bindings_type_clash of Ctype.Unification_trace.t
+ | Letop_type_clash of string * Errortrace.unification Errortrace.t
+ | Andop_type_clash of string * Errortrace.unification Errortrace.t
+ | Bindings_type_clash of Errortrace.unification Errortrace.t
+ | Unbound_existential of Ident.t list * type_expr
+ | Missing_type_constraint
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
(Env.t -> Location.t -> Parsetree.class_structure ->
Typedtree.class_structure * Types.class_signature * string list) ref
val type_package:
- (Env.t -> Parsetree.module_expr -> Path.t -> Longident.t list ->
- Typedtree.module_expr * type_expr list) ref
-
-val create_package_type : Location.t -> Env.t ->
- Longident.t * (Longident.t * Parsetree.core_type) list ->
- Path.t * (Longident.t * Typedtree.core_type) list * Types.type_expr
+ (Env.t -> Parsetree.module_expr -> Path.t -> (Longident.t * type_expr) list ->
+ Typedtree.module_expr * (Longident.t * type_expr) list) ref
val constant: Parsetree.constant -> (Asttypes.constant, error) result
| Recursive_abbrev of string
| Cycle_in_def of string * type_expr
| Definition_mismatch of type_expr * Includecore.type_mismatch option
- | Constraint_failed of type_expr * type_expr
- | Inconsistent_constraint of Env.t * Ctype.Unification_trace.t
- | Type_clash of Env.t * Ctype.Unification_trace.t
+ | Constraint_failed of Env.t * Errortrace.unification Errortrace.t
+ | Inconsistent_constraint of Env.t * Errortrace.unification Errortrace.t
+ | Type_clash of Env.t * Errortrace.unification Errortrace.t
| Non_regular of {
definition: Path.t;
used_as: type_expr;
| Cannot_extend_private_type of Path.t
| Not_extensible_type of Path.t
| Extension_mismatch of Path.t * Includecore.type_mismatch
- | Rebind_wrong_type of Longident.t * Env.t * Ctype.Unification_trace.t
+ | Rebind_wrong_type of
+ Longident.t * Env.t * Errortrace.unification Errortrace.t
| Rebind_mismatch of Longident.t * Path.t * Path.t
| Rebind_private of Longident.t
| Variance of Typedecl_variance.error
| Unavailable_type_constructor of Path.t
- | Bad_fixed_type of string
| Unbound_type_var_ext of type_expr * extension_constructor
| Val_in_structure
| Multiple_native_repr_attributes
| Bad_unboxed_attribute of string
| Boxed_and_unboxed
| Nonrec_gadt
+ | Invalid_private_row_declaration of type_expr
open Typedtree
exception Error of Location.t * error
-(* Note: do not factor the branches in the following pattern-matching:
- the records must be constants for the compiler to do sharing on them.
-*)
let get_unboxed_from_attributes sdecl =
let unboxed = Builtin_attributes.has_unboxed sdecl.ptype_attributes in
let boxed = Builtin_attributes.has_boxed sdecl.ptype_attributes in
- match boxed, unboxed, !Clflags.unboxed_types with
- | true, true, _ -> raise (Error(sdecl.ptype_loc, Boxed_and_unboxed))
- | true, false, _ -> unboxed_false_default_false
- | false, true, _ -> unboxed_true_default_false
- | false, false, false -> unboxed_false_default_true
- | false, false, true -> unboxed_true_default_true
+ match boxed, unboxed with
+ | true, true -> raise (Error(sdecl.ptype_loc, Boxed_and_unboxed))
+ | true, false -> Some false
+ | false, true -> Some true
+ | false, false -> None
(* Enter all declared types in the environment as abstract types *)
type_loc = sdecl.ptype_loc;
type_attributes = sdecl.ptype_attributes;
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = uid;
}
in
sd.ptype_private = Private &&
has_row_var sty
-(* Set the row variable in a fixed type *)
-let set_fixed_row env loc p decl =
+(* Set the row variable to a fixed type in a private row type declaration.
+ (e.g. [ type t = private [< `A | `B ] ] or [type u = private < .. > ])
+ Require [is_fixed_type decl] as a precondition
+*)
+let set_private_row env loc p decl =
let tm =
match decl.type_manifest with
None -> assert false
match tm.desc with
Tvariant row ->
let row = Btype.row_repr row in
- tm.desc <- Tvariant {row with row_fixed = Some Fixed_private};
- if Btype.static_row row then Btype.newgenty Tnil
+ Btype.set_type_desc tm
+ (Tvariant {row with row_fixed = Some Fixed_private});
+ if Btype.static_row row then
+ (* the syntax hinted at the existence of a row variable,
+ but there is in fact no row variable to make private, e.g.
+ [ type t = private [< `A > `A] ] *)
+ raise (Error(loc, Invalid_private_row_declaration tm))
else row.row_more
| Tobject (ty, _) ->
- snd (Ctype.flatten_fields ty)
- | _ ->
- raise (Error (loc, Bad_fixed_type "is not an object or variant"))
+ let r = snd (Ctype.flatten_fields ty) in
+ if not (Btype.is_Tvar r) then
+ (* a syntactically open object was closed by a constraint *)
+ raise (Error(loc, Invalid_private_row_declaration tm));
+ r
+ | _ -> assert false
in
- if not (Btype.is_Tvar rv) then
- raise (Error (loc, Bad_fixed_type "has no row variable"));
- rv.desc <- Tconstr (p, decl.type_params, ref Mnil)
+ Btype.set_type_desc rv (Tconstr (p, decl.type_params, ref Mnil))
(* Translate one type declaration *)
begin match (Ctype.repr ret_type).desc with
| Tconstr (p', _, _) when Path.same type_path p' -> ()
| _ ->
- raise (Error (sret_type.ptyp_loc, Constraint_failed
- (ret_type, Ctype.newconstr type_path type_params)))
+ raise (Error (sret_type.ptyp_loc,
+ Constraint_failed
+ (env, [Errortrace.diff
+ ret_type
+ (Ctype.newconstr type_path type_params)])))
end;
widen z;
targs, Some tret_type, args, Some ret_type
transl_simple_type env false sty', loc)
sdecl.ptype_cstrs
in
- let raw_status = get_unboxed_from_attributes sdecl in
- if raw_status.unboxed && not raw_status.default then begin
+ let unboxed_attr = get_unboxed_from_attributes sdecl in
+ begin match unboxed_attr with
+ | (None | Some false) -> ()
+ | Some true ->
let bad msg = raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute msg)) in
match sdecl.ptype_kind with
| Ptype_abstract -> bad "it is abstract"
end
end
end;
- let unboxed_status =
+ let unbox, unboxed_default =
match sdecl.ptype_kind with
| Ptype_variant [{pcd_args = Pcstr_tuple [_]; _}]
| Ptype_variant [{pcd_args = Pcstr_record [{pld_mutable=Immutable; _}]; _}]
- | Ptype_record [{pld_mutable=Immutable; _}] -> raw_status
- | _ -> unboxed_false_default_false (* Not unboxable, mark as boxed *)
+ | Ptype_record [{pld_mutable=Immutable; _}] ->
+ Option.value unboxed_attr ~default:!Clflags.unboxed_types,
+ Option.is_none unboxed_attr
+ | _ -> false, false (* Not unboxable, mark as boxed *)
in
- let unbox = unboxed_status.unboxed in
let (tkind, kind) =
match sdecl.ptype_kind with
| Ptype_abstract -> Ttype_abstract, Type_abstract
Builtin_attributes.warning_scope scstr.pcd_attributes
(fun () -> make_cstr scstr)
in
+ let rep = if unbox then Variant_unboxed else Variant_regular in
let tcstrs, cstrs = List.split (List.map make_cstr scstrs) in
- Ttype_variant tcstrs, Type_variant cstrs
+ Ttype_variant tcstrs, Type_variant (cstrs, rep)
| Ptype_record lbls ->
let lbls, lbls' = transl_labels env true lbls in
let rep =
type_loc = sdecl.ptype_loc;
type_attributes = sdecl.ptype_attributes;
type_immediate = Unknown;
- type_unboxed = unboxed_status;
+ type_unboxed_default = unboxed_default;
type_uid = uid;
} in
(Longident.Lident(Ident.name id ^ "#row")) env
with Not_found -> assert false
in
- set_fixed_row env sdecl.ptype_loc p decl
- end;
- (* Check for cyclic abbreviations *)
- begin match decl.type_manifest with None -> ()
- | Some ty ->
- if Ctype.cyclic_abbrev env id ty then
- raise(Error(sdecl.ptype_loc, Recursive_abbrev sdecl.ptype_name.txt));
+ set_private_row env sdecl.ptype_loc p decl
end;
{
typ_id = id;
visited := TypeSet.add ty !visited;
match ty.desc with
| Tconstr (path, args, _) ->
- let args' = List.map (fun _ -> Ctype.newvar ()) args in
- let ty' = Ctype.newconstr path args' in
- begin try Ctype.enforce_constraints env ty'
- with Ctype.Unify _ -> assert false
- | Not_found -> raise (Error(loc, Unavailable_type_constructor path))
+ let decl =
+ try Env.find_type path env
+ with Not_found ->
+ raise (Error(loc, Unavailable_type_constructor path)) in
+ let ty' = Ctype.newconstr path (Ctype.instance_list decl.type_params) in
+ begin
+ try Ctype.matches env ty ty'
+ with Ctype.Matches_failure (env, trace) ->
+ raise (Error(loc, Constraint_failed (env, trace)))
end;
- if not (Ctype.matches env ty ty') then
- raise (Error(loc, Constraint_failed (ty, ty')));
List.iter (check_constraints_rec env loc visited) args
| Tpoly (ty, tl) ->
let _, ty = Ctype.instance_poly false tl ty in
sdecl.ptype_params decl.type_params;
begin match decl.type_kind with
| Type_abstract -> ()
- | Type_variant l ->
+ | Type_variant (l, _rep) ->
let find_pl = function
Ptype_variant pl -> pl
| Ptype_record _ | Ptype_abstract | Ptype_open -> assert false
let err =
if List.length args <> List.length decl.type_params
then Some Includecore.Arity
- else if not (Ctype.equal env false args decl.type_params)
- then Some Includecore.Constraint
- else
- Includecore.type_declarations ~loc ~equality:true env
- ~mark:true
- (Path.last path)
- decl'
- dpath
- (Subst.type_declaration
- (Subst.add_type_path dpath path Subst.identity) decl)
+ else begin
+ match Ctype.equal env false args decl.type_params with
+ | exception Ctype.Equality trace ->
+ Some (Includecore.Constraint (env, trace))
+ | () ->
+ Includecore.type_declarations ~loc ~equality:true env
+ ~mark:true
+ (Path.last path)
+ decl'
+ dpath
+ (Subst.type_declaration
+ (Subst.add_type_path dpath path Subst.identity) decl)
+ end
in
if err <> None then
raise(Error(loc, Definition_mismatch (ty, err)))
in
let snap = Btype.snapshot () in
try Ctype.wrap_trace_gadt_instances env (check ty TypeSet.empty) ty
- with Ctype.Unify _ ->
+ with Ctype.Escape _ ->
(* Will be detected by check_recursion *)
Btype.backtrack snap
match ty.desc with
| Tconstr(path', args', _) ->
if Path.same path path' then begin
- if not (Ctype.equal orig_env false args args') then
+ if not (Ctype.is_equal orig_env false args args') then
raise (Error(loc,
Non_regular {
definition=path;
Ctype.instance_parameterized_type params0 body0 in
begin
try List.iter2 (Ctype.unify orig_env) params args'
- with Ctype.Unify _ ->
- raise (Error(loc, Constraint_failed
- (ty, Ctype.newconstr path' params0)));
+ with Ctype.Unify trace ->
+ raise (Error(loc, Constraint_failed (orig_env, trace)));
end;
check_regular path' args
(path' :: prev_exp) ((ty,body) :: prev_expansions)
in
args, ret_type, Text_decl(targs, tret_type)
| Pext_rebind lid ->
- let usage = if priv = Public then Env.Positive else Env.Privatize in
+ let usage : Env.constructor_usage =
+ if priv = Public then Env.Exported else Env.Exported_private
+ in
let cdescr = Env.lookup_constructor ~loc:lid.loc usage lid.txt env in
- let (args, cstr_res) = Ctype.instance_constructor cdescr in
+ let (args, cstr_res, _ex) = Ctype.instance_constructor cdescr in
let res, ret_type =
if cdescr.cstr_generalized then
let params = Ctype.instance_list type_params in
Ctype.free_variables (Btype.newgenty (Ttuple args))
in
List.iter
- (function {desc = Tvar (Some "_")} as ty ->
- if List.memq ty vars then ty.desc <- Tvar None
- | _ -> ())
+ (function {desc = Tvar (Some "_")} as ty
+ when List.memq ty vars ->
+ Btype.set_type_desc ty (Tvar None)
+ | _ -> ())
typext_params
end;
(* Ensure that constructor's type matches the type being extended *)
(Tconstr(type_path, type_params, ref Mnil)))
:: type_params
in
- if not (Ctype.equal env true cstr_types ext_types) then
+ if not (Ctype.is_equal env true cstr_types ext_types) then
raise (Error(lid.loc,
Rebind_mismatch(lid.txt, cstr_type_path, type_path)));
(* Disallow rebinding private constructors to non-private *)
try match ty.desc with
| Tconstr (p, _, _) ->
let tydecl = Env.find_type p env in
- if tydecl.type_unboxed.default then
+ if tydecl.type_unboxed_default then
Path.Set.add p acc
else acc
| _ -> acc
In particular, note that [sig_env] is an extension of
[outer_env].
*)
-let transl_with_constraint id row_path ~sig_env ~sig_decl ~outer_env sdecl =
+let transl_with_constraint id ?fixed_row_path ~sig_env ~sig_decl ~outer_env
+ sdecl =
Env.mark_type_used sig_decl.type_uid;
reset_type_variables();
Ctype.begin_def();
if arity_ok && sig_decl.type_kind <> Type_abstract
&& sdecl.ptype_private = Private then
Location.deprecated loc "spurious use of private";
- let type_kind, type_unboxed =
+ let type_kind, type_unboxed_default =
if arity_ok && man <> None then
- sig_decl.type_kind, sig_decl.type_unboxed
+ sig_decl.type_kind, sig_decl.type_unboxed_default
else
- Type_abstract, unboxed_false_default_false
+ Type_abstract, false
in
let new_sig_decl =
{ type_params = params;
type_loc = loc;
type_attributes = sdecl.ptype_attributes;
type_immediate = Unknown;
- type_unboxed;
+ type_unboxed_default;
type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
}
in
- begin match row_path with None -> ()
- | Some p -> set_fixed_row env loc p new_sig_decl
- end;
+ Option.iter (fun p -> set_private_row env sdecl.ptype_loc p new_sig_decl)
+ fixed_row_path;
begin match Ctype.closed_type_decl new_sig_decl with None -> ()
| Some ty -> raise(Error(loc, Unbound_type_var(ty, new_sig_decl)))
end;
type_kind = new_sig_decl.type_kind;
type_private = new_sig_decl.type_private;
type_manifest = new_sig_decl.type_manifest;
- type_unboxed = new_sig_decl.type_unboxed;
+ type_unboxed_default = new_sig_decl.type_unboxed_default;
type_is_newtype = new_sig_decl.type_is_newtype;
type_expansion_scope = new_sig_decl.type_expansion_scope;
type_loc = new_sig_decl.type_loc;
type_loc = Location.none;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.internal_not_actually_unique;
} in
Ctype.end_def();
Btype.newgenty (Tobject(tv, ref None)) in
Printtyp.reset_and_mark_loops_list [typ ti; ty0];
fprintf ppf
- ".@.@[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
+ ".@ @[<hov2>In %s@ %a@;<1 -2>the variable %a is unbound@]"
kwd pr ti Printtyp.marked_type_expr tv
with Not_found -> ()
Printtyp.type_expr ty
(Includecore.report_type_mismatch "the original" "this" "definition")
err
- | Constraint_failed (ty, ty') ->
- Printtyp.reset_and_mark_loops ty;
- Printtyp.mark_loops ty';
- Printtyp.Naming_context.reset ();
- fprintf ppf "@[%s@ @[<hv>Type@ %a@ should be an instance of@ %a@]@]"
- "Constraints are not satisfied in this type."
- !Oprint.out_type (Printtyp.tree_of_typexp false ty)
- !Oprint.out_type (Printtyp.tree_of_typexp false ty')
+ | Constraint_failed (env, trace) ->
+ fprintf ppf "@[<v>Constraints are not satisfied in this type.@ ";
+ Printtyp.report_unification_error ppf env trace
+ (fun ppf -> fprintf ppf "Type")
+ (fun ppf -> fprintf ppf "should be an instance of");
+ fprintf ppf "@]"
| Non_regular { definition; used_as; defined_as; expansions } ->
let pp_expansion ppf (ty,body) =
Format.fprintf ppf "%a = %a"
pp_expansions expansions
end
| Inconsistent_constraint (env, trace) ->
- fprintf ppf "The type constraints are not consistent.@.";
+ fprintf ppf "@[<v>The type constraints are not consistent.@ ";
Printtyp.report_unification_error ppf env trace
(fun ppf -> fprintf ppf "Type")
- (fun ppf -> fprintf ppf "is not compatible with type")
+ (fun ppf -> fprintf ppf "is not compatible with type");
+ fprintf ppf "@]"
| Type_clash (env, trace) ->
Printtyp.report_unification_error ppf env trace
(function ppf ->
requires a second stub function@ \
for native-code compilation@]"
| Unbound_type_var (ty, decl) ->
- fprintf ppf "A type variable is unbound in this type declaration";
+ fprintf ppf "@[A type variable is unbound in this type declaration";
let ty = Ctype.repr ty in
begin match decl.type_kind, decl.type_manifest with
- | Type_variant tl, _ ->
+ | Type_variant (tl, _rep), _ ->
explain_unbound_gen ppf ty tl (fun c ->
let tl = tys_of_constr_args c.Types.cd_args in
Btype.newgenty (Ttuple tl)
| Type_abstract, Some ty' ->
explain_unbound_single ppf ty ty'
| _ -> ()
- end
+ end;
+ fprintf ppf "@]"
| Unbound_type_var_ext (ty, ext) ->
- fprintf ppf "A type variable is unbound in this extension constructor";
+ fprintf ppf "@[A type variable is unbound in this extension constructor";
let args = tys_of_constr_args ext.ext_args in
- explain_unbound ppf ty args (fun c -> c) "type" (fun _ -> "")
+ explain_unbound ppf ty args (fun c -> c) "type" (fun _ -> "");
+ fprintf ppf "@]"
| Cannot_extend_private_type path ->
fprintf ppf "@[%s@ %a@]"
"Cannot extend private type definition"
(variance v2) (variance v1))
| Unavailable_type_constructor p ->
fprintf ppf "The definition of type %a@ is unavailable" Printtyp.path p
- | Bad_fixed_type r ->
- fprintf ppf "This fixed type %s" r
| Variance Typedecl_variance.Varying_anonymous ->
fprintf ppf "@[%s@ %s@ %s@]"
"In this GADT definition," "the variance of some parameter"
| Nonrec_gadt ->
fprintf ppf
"@[GADT case syntax cannot be used in a 'nonrec' block.@]"
+ | Invalid_private_row_declaration ty ->
+ Format.fprintf ppf
+ "@[<hv>This private row type declaration is invalid.@ \
+ The type expression on the right-hand side reduces to@;<1 2>%a@ \
+ which does not have a free row type variable.@]@,\
+ @[<hv>@[Hint: If you intended to define a private type abbreviation,@ \
+ write explicitly@]@;<1 2>private %a@]"
+ Printtyp.type_expr ty Printtyp.type_expr ty
let () =
Location.register_error_of_exn
Env.t -> Location.t ->
Parsetree.value_description -> Typedtree.value_description * Env.t
+(* If the [fixed_row_path] optional argument is provided,
+ the [Parsetree.type_declaration] argument should satisfy [is_fixed_type] *)
val transl_with_constraint:
- Ident.t -> Path.t option ->
+ Ident.t -> ?fixed_row_path:Path.t ->
sig_env:Env.t -> sig_decl:Types.type_declaration ->
outer_env:Env.t -> Parsetree.type_declaration ->
Typedtree.type_declaration
| Recursive_abbrev of string
| Cycle_in_def of string * type_expr
| Definition_mismatch of type_expr * Includecore.type_mismatch option
- | Constraint_failed of type_expr * type_expr
- | Inconsistent_constraint of Env.t * Ctype.Unification_trace.t
- | Type_clash of Env.t * Ctype.Unification_trace.t
+ | Constraint_failed of Env.t * Errortrace.unification Errortrace.t
+ | Inconsistent_constraint of Env.t * Errortrace.unification Errortrace.t
+ | Type_clash of Env.t * Errortrace.unification Errortrace.t
| Non_regular of {
definition: Path.t;
used_as: type_expr;
| Cannot_extend_private_type of Path.t
| Not_extensible_type of Path.t
| Extension_mismatch of Path.t * Includecore.type_mismatch
- | Rebind_wrong_type of Longident.t * Env.t * Ctype.Unification_trace.t
+ | Rebind_wrong_type of
+ Longident.t * Env.t * Errortrace.unification Errortrace.t
| Rebind_mismatch of Longident.t * Path.t * Path.t
| Rebind_private of Longident.t
| Variance of Typedecl_variance.error
| Unavailable_type_constructor of Path.t
- | Bad_fixed_type of string
| Unbound_type_var_ext of type_expr * extension_constructor
| Val_in_structure
| Multiple_native_repr_attributes
| Bad_unboxed_attribute of string
| Boxed_and_unboxed
| Nonrec_gadt
+ | Invalid_private_row_declaration of type_expr
exception Error of Location.t * error
let compute_decl env tdecl =
match (tdecl.type_kind, tdecl.type_manifest) with
- | (Type_variant [{cd_args = Cstr_tuple [arg]; _}], _)
- | (Type_variant [{cd_args = Cstr_record [{ld_type = arg; _}]; _}], _)
- | (Type_record ([{ld_type = arg; _}], _), _)
- when tdecl.type_unboxed.unboxed ->
+ | (Type_variant ([{cd_args = Cstr_tuple [arg]
+ | Cstr_record [{ld_type = arg; _}]; _}],
+ Variant_unboxed)
+ | Type_record ([{ld_type = arg; _}], Record_unboxed _)), _ ->
begin match Typedecl_unboxed.get_unboxed_type_representation env arg with
| Typedecl_unboxed.Unavailable -> Type_immediacy.Unknown
| Typedecl_unboxed.This argrepr -> Ctype.immediacy env argrepr
| Type_immediacy.Always -> Type_immediacy.Always_on_64bits
| Type_immediacy.Always_on_64bits | Type_immediacy.Unknown as x -> x
end
- | (Type_variant (_ :: _ as cstrs), _) ->
+ | (Type_variant (_ :: _ as cstrs, _), _) ->
if not (List.exists (fun c -> c.Types.cd_args <> Types.Cstr_tuple []) cstrs)
then
Type_immediacy.Always
a single argument, [argument_to_unbox] represents the
information we need to check the argument for separability. *)
type argument_to_unbox = {
- kind: parameter_kind; (* for error messages *)
- mutability: Asttypes.mutable_flag;
argument_type: type_expr;
result_type_parameter_instances: type_expr list;
(** result_type_parameter_instances represents the domain of the
For example, [type 'a t = 'b constraint 'a = 'b * int] has
[['b * int]] as [result_type_parameter_instances], and so does
[type _ t = T : 'b -> ('b * int) t]. *)
- location : Location.t;
}
-and parameter_kind =
- | Record_field
- | Constructor_parameter
- | Constructor_field (** inlined records *)
-
-(** ['a multiplicity] counts the number of ['a] in
- a structure in which expect to see only one ['a]. *)
-type 'a multiplicity =
- | Zero
- | One of 'a
- | Several
-
-type arity = argument_to_unbox multiplicity (**how many parameters?*)
-
-type branching = arity multiplicity (**how many constructors?*)
(** Summarize the right-hand-side of a type declaration,
for separability-checking purposes. See {!structure} below. *)
| Synonym of type_expr
| Abstract
| Open
- | Algebraic of branching
-
-let demultiply_list
- : type a b. a list -> (a -> b) -> b multiplicity
- = fun li f -> match li with
- | [] -> Zero
- | [v] -> One (f v)
- | _::_::_ -> Several
+ | Algebraic
+ | Unboxed of argument_to_unbox
let structure : type_definition -> type_structure = fun def ->
match def.type_kind with
| None -> Abstract
| Some type_expr -> Synonym type_expr
end
- | Type_record (labels, _) ->
- Algebraic (One (
- demultiply_list labels @@ fun ld -> {
- location = ld.ld_loc;
- kind = Record_field;
- mutability = ld.ld_mutable;
- argument_type = ld.ld_type;
- result_type_parameter_instances = def.type_params;
- }
- ))
- | Type_variant constructors ->
- Algebraic (demultiply_list constructors @@ fun cd ->
- let result_type_parameter_instances =
- match cd.cd_res with
- (* cd_res is the optional return type (in a GADT);
- if None, just use the type parameters *)
- | None -> def.type_params
- | Some ret_type ->
- begin match Ctype.repr ret_type with
- | {desc=Tconstr (_, tyl, _)} ->
- List.map Ctype.repr tyl
- | _ -> assert false
- end
- in
- begin match cd.cd_args with
- | Cstr_tuple tys ->
- demultiply_list tys @@ fun argument_type -> {
- location = cd.cd_loc;
- kind = Constructor_parameter;
- mutability = Asttypes.Immutable;
- argument_type;
- result_type_parameter_instances;
- }
- | Cstr_record labels ->
- demultiply_list labels @@ fun ld ->
- let argument_type = ld.ld_type in
- {
- location = ld.ld_loc;
- kind = Constructor_field;
- mutability = ld.ld_mutable;
- argument_type;
- result_type_parameter_instances;
- }
- end)
+ | ( Type_record ([{ld_type = ty; _}], Record_unboxed _)
+ | Type_variant ([{cd_args = Cstr_tuple [ty]; _}], Variant_unboxed)
+ | Type_variant ([{cd_args = Cstr_record [{ld_type = ty; _}]; _}],
+ Variant_unboxed)) ->
+ let params =
+ match def.type_kind with
+ | Type_variant ([{cd_res = Some ret_type}], _) ->
+ begin match Ctype.repr ret_type with
+ | {desc=Tconstr (_, tyl, _)} ->
+ List.map Ctype.repr tyl
+ | _ -> assert false
+ end
+ | _ -> def.type_params
+ in
+ Unboxed { argument_type = ty; result_type_parameter_instances = params }
+
+ | Type_record _ | Type_variant _ -> Algebraic
type error =
| Non_separable_evar of string option
on which immediate_subtypes is called from [check_type] *)
| Tarrow(_,ty1,ty2,_) ->
[ty1; ty2]
- | Ttuple(tys)
- | Tpackage(_,_,tys) ->
- tys
+ | Ttuple(tys) -> tys
+ | Tpackage(_, fl) -> (snd (List.split fl))
| Tobject(row,class_ty) ->
let class_subtys =
match !class_ty with
| (Tvariant(_) , Sep )
| (Tobject(_,_) , Sep )
| ((Tnil | Tfield _) , Sep )
- | (Tpackage(_,_,_) , Sep ) -> empty
+ | (Tpackage(_,_) , Sep ) -> empty
(* "Deeply separable" case for these same constructors. *)
| (Tarrow _ , Deepsep)
| (Ttuple _ , Deepsep)
| (Tvariant(_) , Deepsep)
| (Tobject(_,_) , Deepsep)
| ((Tnil | Tfield _) , Deepsep)
- | (Tpackage(_,_,_) , Deepsep) ->
+ | (Tpackage(_,_) , Deepsep) ->
let tys = immediate_subtypes ty in
let on_subtype context ty =
context ++ check_type (Hyps.guard hyps) ty Deepsep in
let check_def
: Env.t -> type_definition -> Sep.signature
= fun env def ->
- let boxed = not def.type_unboxed.unboxed in
match structure def with
| Abstract ->
- assert boxed;
msig_of_external_type def
| Synonym type_expr ->
check_type env type_expr Sep
|> msig_of_context ~decl_loc:def.type_loc ~parameters:def.type_params
- | Open | Algebraic (Zero | Several | One (Zero | Several)) ->
- assert boxed;
+ | Open | Algebraic ->
best_msig def
- | Algebraic (One (One constructor)) ->
- if boxed then best_msig def
- else
+ | Unboxed constructor ->
check_type env constructor.argument_type Sep
|> msig_of_context ~decl_loc:def.type_loc
~parameters:constructor.result_type_parameter_instances
This Predef.type_int
| {type_immediate = Always_on_64bits; _} ->
Only_on_64_bits Predef.type_int
- | {type_unboxed = {unboxed = false}} -> This ty
| {type_params; type_kind =
- Type_record ([{ld_type = ty2; _}], _)
- | Type_variant [{cd_args = Cstr_tuple [ty2]; _}]
- | Type_variant [{cd_args = Cstr_record [{ld_type = ty2; _}]; _}]}
-
+ Type_record ([{ld_type = ty2; _}], Record_unboxed _)
+ | Type_variant ([{cd_args = Cstr_tuple [ty2]; _}], Variant_unboxed)
+ | Type_variant ([{cd_args = Cstr_record [{ld_type = ty2; _}]; _}],
+ Variant_unboxed)}
->
let ty2 = match ty2.desc with Tpoly (t, _) -> t | _ -> ty2 in
get_unboxed_type_representation env
(Ctype.apply env type_params ty2 args) (fuel - 1)
- | {type_kind=Type_abstract} -> Unavailable
- (* This case can occur when checking a recursive unboxed type
- declaration. *)
- | _ -> assert false (* only the above can be unboxed *)
+ | _ -> This ty
end
| _ -> This ty
| Tfield (_, _, ty1, ty2) ->
compute_same ty1;
compute_same ty2
- | Tsubst ty ->
- compute_same ty
+ | Tsubst _ ->
+ assert false
| Tvariant row ->
let row = Btype.row_repr row in
List.iter
| Tpoly (ty, _) ->
compute_same ty
| Tvar _ | Tnil | Tlink _ | Tunivar _ -> ()
- | Tpackage (_, _, tyl) ->
+ | Tpackage (_, fl) ->
let v =
Variance.(if mem Pos vari || mem Neg vari then full else unknown)
in
- List.iter (compute_variance_rec v) tyl
+ List.iter (fun (_, ty) -> compute_variance_rec v ty) fl
in
compute_variance_rec vari ty
let v2 =
TypeMap.fold
(fun t vt v ->
- if Ctype.equal env false [ty] [t] then union vt v else v)
+ if Ctype.is_equal env false [ty] [t] then union vt v else v)
!tvl2 null in
Btype.backtrack snap;
let (c1,n1) = get_upper v1 and (c2,n2,_,i2) = get_lower v2 in
match decl.type_kind with
Type_abstract | Type_open ->
compute_variance_type env ~check rloc decl mn
- | Type_variant tll ->
+ | Type_variant (tll,_rep) ->
if List.for_all (fun c -> c.Types.cd_res = None) tll then
compute_variance_type env ~check rloc decl
(mn @ List.flatten (List.map (fun c -> for_constr c.Types.cd_args)
| Tpat_constant : constant -> value pattern_desc
| Tpat_tuple : value general_pattern list -> value pattern_desc
| Tpat_construct :
- Longident.t loc * constructor_description * value general_pattern list ->
+ Longident.t loc * constructor_description * value general_pattern list
+ * (Ident.t loc list * core_type) option ->
value pattern_desc
| Tpat_variant :
label * value general_pattern option * row_desc ref ->
| Tsig_modsubst of module_substitution
| Tsig_recmodule of module_declaration list
| Tsig_modtype of module_type_declaration
+ | Tsig_modtypesubst of module_type_declaration
| Tsig_open of open_description
| Tsig_include of include_description
| Tsig_class of class_description list
and with_constraint =
Twith_type of type_declaration
| Twith_module of Path.t * Longident.t loc
+ | Twith_modtype of module_type
| Twith_typesubst of type_declaration
| Twith_modsubst of Path.t * Longident.t loc
+ | Twith_modtypesubst of module_type
+
and core_type =
(* mutable because of [Typeclass.declare_method] *)
ci_attributes: attribute list;
}
+type implementation = {
+ structure: structure;
+ coercion: module_coercion;
+ signature: Types.signature
+}
+
+
(* Auxiliary functions over the a.s.t. *)
let as_computation_pattern (p : pattern) : computation general_pattern =
= fun f -> function
| Tpat_alias(p, _, _) -> f.f p
| Tpat_tuple patl -> List.iter f.f patl
- | Tpat_construct(_, _, patl) -> List.iter f.f patl
+ | Tpat_construct(_, _, patl, _) -> List.iter f.f patl
| Tpat_variant(_, pat, _) -> Option.iter f.f pat
| Tpat_record (lbl_pat_list, _) ->
List.iter (fun (_, _, pat) -> f.f pat) lbl_pat_list
Tpat_tuple (List.map f.f pats)
| Tpat_record (lpats, closed) ->
Tpat_record (List.map (fun (lid, l,p) -> lid, l, f.f p) lpats, closed)
- | Tpat_construct (lid, c,pats) ->
- Tpat_construct (lid, c, List.map f.f pats)
+ | Tpat_construct (lid, c, pats, ty) ->
+ Tpat_construct (lid, c, List.map f.f pats, ty)
| Tpat_array pats ->
Tpat_array (List.map f.f pats)
| Tpat_lazy p1 -> Tpat_lazy (f.f p1)
*)
| Tpat_construct :
Longident.t loc * Types.constructor_description *
- value general_pattern list ->
+ value general_pattern list * (Ident.t loc list * core_type) option ->
value pattern_desc
- (** C []
- C P [P]
- C (P1, ..., Pn) [P1; ...; Pn]
+ (** C ([], None)
+ C P ([P], None)
+ C (P1, ..., Pn) ([P1; ...; Pn], None)
+ C (P : t) ([P], Some ([], t))
+ C (P1, ..., Pn : t) ([P1; ...; Pn], Some ([], t))
+ C (type a) (P : t) ([P], Some ([a], t))
+ C (type a) (P1, ..., Pn : t) ([P1; ...; Pn], Some ([a], t))
*)
| Tpat_variant :
label * value general_pattern option * Types.row_desc ref ->
| Tsig_modsubst of module_substitution
| Tsig_recmodule of module_declaration list
| Tsig_modtype of module_type_declaration
+ | Tsig_modtypesubst of module_type_declaration
| Tsig_open of open_description
| Tsig_include of include_description
| Tsig_class of class_description list
and with_constraint =
Twith_type of type_declaration
| Twith_module of Path.t * Longident.t loc
+ | Twith_modtype of module_type
| Twith_typesubst of type_declaration
| Twith_modsubst of Path.t * Longident.t loc
+ | Twith_modtypesubst of module_type
and core_type =
{ mutable ctyp_desc : core_type_desc;
ci_attributes: attributes;
}
+type implementation = {
+ structure: structure;
+ coercion: module_coercion;
+ signature: Types.signature
+}
+(** A typechecked implementation including its module structure, its exported
+ signature, and a coercion of the module against that signature.
+
+ If an .mli file is present, the signature will come from that file and be
+ the exported signature of the module.
+
+ If there isn't one, the signature will be inferred from the module
+ structure.
+*)
+
(* Auxiliary functions over the a.s.t. *)
(** [as_computation_pattern p] is a computation pattern with description
open Types
open Format
+let () = Includemod_errorprinter.register ()
+
module String = Misc.Stdlib.String
module Sig_component_kind = struct
type error =
Cannot_apply of module_type
- | Not_included of Includemod.error list
+ | Not_included of Includemod.explanation
| Cannot_eliminate_dependency of module_type
| Signature_expected
| Structure_expected of module_type
| With_no_component of Longident.t
- | With_mismatch of Longident.t * Includemod.error list
+ | With_mismatch of Longident.t * Includemod.explanation
| With_makes_applicative_functor_ill_typed of
- Longident.t * Path.t * Includemod.error list
+ Longident.t * Path.t * Includemod.explanation
| With_changes_module_alias of Longident.t * Ident.t * Path.t
| With_cannot_remove_constrained_type
| Repeated_name of Sig_component_kind.t * string
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
+ | Unpackable_local_modtype_subst of Path.t
+ | With_cannot_remove_packed_modtype of Path.t * module_type
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
(* Merge one "with" constraint in a signature *)
-let rec add_rec_types env = function
- Sig_type(id, decl, Trec_next, _) :: rem ->
- add_rec_types (Env.add_type ~check:true id decl env) rem
- | _ -> env
-
-let check_type_decl env loc id row_id newdecl decl rs rem =
+let check_type_decl env loc id row_id newdecl decl rec_group =
let env = Env.add_type ~check:true id newdecl env in
let env =
match row_id with
| None -> env
| Some id -> Env.add_type ~check:false id newdecl env
in
- let env = if rs = Trec_not then env else add_rec_types env rem in
+ let env =
+ let add_sigitem env x =
+ Env.add_signature Signature_group.(x.src :: x.post_ghosts) env
+ in
+ List.fold_left add_sigitem env rec_group in
Includemod.type_declarations ~mark:Mark_both ~loc env id newdecl decl;
Typedecl.check_coherence env loc (Path.Pident id) newdecl
-let update_rec_next rs rem =
- match rs with
- Trec_next -> rem
- | Trec_first | Trec_not ->
- match rem with
- Sig_type (id, decl, Trec_next, priv) :: rem ->
- Sig_type (id, decl, rs, priv) :: rem
- | Sig_module (id, pres, mty, Trec_next, priv) :: rem ->
- Sig_module (id, pres, mty, rs, priv) :: rem
- | _ -> rem
-
let make_variance p n i =
let open Variance in
set May_pos p (set May_neg n (set May_weak n (set Inj i null)))
- aliases: module A = M still makes sense but it doesn't mean the same thing
anymore, so it's forbidden until it's clear what we should do with it.
This function would be called with M.N.t and N.t to check for these uses. *)
-let check_usage_of_path_of_substituted_item paths env signature ~loc ~lid =
- let iterator =
- let env, super = iterator_with_env env in
+let check_usage_of_path_of_substituted_item paths ~loc ~lid env super =
{ super with
Btype.it_signature_item = (fun self -> function
| Sig_module (id, _, { md_type = Mty_alias aliased_path; _ }, _, _)
paths
then
let env = Lazy.force !env in
- try retype_applicative_functor_type ~loc env funct arg
- with Includemod.Error explanation ->
- raise(Error(loc, env,
- With_makes_applicative_functor_ill_typed
+ match retype_applicative_functor_type ~loc env funct arg with
+ | None -> ()
+ | Some explanation ->
+ raise(Error(loc, env,
+ With_makes_applicative_functor_ill_typed
(lid.txt, referenced_path, explanation)))
)
);
}
+
+(* When doing a module type destructive substitution [with module type T = RHS]
+ where RHS is not a module type path, we need to check that the module type
+ T was not used as a path for a packed module
+*)
+let check_usage_of_module_types ~error ~paths ~loc env super =
+ let it_do_type_expr it ty = match ty.desc with
+ | Tpackage (p, _) ->
+ begin match List.find_opt (Path.same p) paths with
+ | Some p -> raise (Error(loc,Lazy.force !env,error p))
+ | _ -> super.Btype.it_do_type_expr it ty
+ end
+ | _ -> super.Btype.it_do_type_expr it ty in
+ { super with Btype.it_do_type_expr }
+
+let do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg =
+ let env, iterator = iterator_with_env env in
+ let last, rest = match List.rev paths with
+ | [] -> assert false
+ | last :: rest -> last, rest
+ in
+ (* The last item is the one that's removed. We don't need to check how
+ it's used since it's replaced by a more specific type/module. *)
+ assert (match last with Pident _ -> true | _ -> false);
+ let iterator = match rest with
+ | [] -> iterator
+ | _ :: _ ->
+ check_usage_of_path_of_substituted_item rest ~loc ~lid env iterator
in
- iterator.Btype.it_signature iterator signature;
- Btype.unmark_iterators.Btype.it_signature Btype.unmark_iterators signature
+ let iterator = match unpackable_modtype with
+ | None -> iterator
+ | Some mty ->
+ let error p = With_cannot_remove_packed_modtype(p,mty) in
+ check_usage_of_module_types ~error ~paths ~loc env iterator
+ in
+ iterator.Btype.it_signature iterator sg;
+ Btype.(unmark_iterators.it_signature unmark_iterators) sg
+
+let check_usage_after_substitution env ~loc ~lid paths unpackable_modtype sg =
+ match paths, unpackable_modtype with
+ | [_], None -> ()
+ | _ -> do_check_after_substitution env ~loc ~lid paths unpackable_modtype sg
(* After substitution one also needs to re-check the well-foundedness
of type declarations in recursive modules *)
loop
;;
-let merge_constraint initial_env remove_aliases loc sg constr =
- let lid =
- match constr with
- | Pwith_type (lid, _) | Pwith_module (lid, _)
- | Pwith_typesubst (lid, _) | Pwith_modsubst (lid, _) -> lid
- in
+type with_info =
+ | With_type of Parsetree.type_declaration
+ | With_typesubst of Parsetree.type_declaration
+ | With_module of {
+ lid:Longident.t loc;
+ path:Path.t;
+ md:Types.module_declaration;
+ remove_aliases:bool
+ }
+ | With_modsubst of Longident.t loc * Path.t * Types.module_declaration
+ | With_modtype of Typedtree.module_type
+ | With_modtypesubst of Typedtree.module_type
+
+let merge_constraint initial_env loc sg lid constr =
let destructive_substitution =
match constr with
- | Pwith_type _ | Pwith_module _ -> false
- | Pwith_typesubst _ | Pwith_modsubst _ -> true
+ | With_type _ | With_module _ | With_modtype _ -> false
+ | With_typesubst _ | With_modsubst _ | With_modtypesubst _ -> true
in
let real_ids = ref [] in
- let rec merge sig_env sg namelist row_id =
- match (sg, namelist, constr) with
- ([], _, _) ->
- raise(Error(loc, sig_env, With_no_component lid.txt))
- | (Sig_type(id, decl, rs, priv) :: rem, [s],
- Pwith_type (_, ({ptype_kind = Ptype_abstract} as sdecl)))
+ let unpackable_modtype = ref None in
+ let split_row_id s ghosts =
+ let srow = s ^ "#row" in
+ let rec split before = function
+ | Sig_type(id,_,_,_) :: rest when Ident.name id = srow ->
+ before, Some id, rest
+ | a :: rest -> split (a::before) rest
+ | [] -> before, None, []
+ in
+ split [] ghosts
+ in
+ let rec patch_item constr namelist sig_env ~rec_group ~ghosts item =
+ let return ?(ghosts=ghosts) ~replace_by info =
+ Some (info, {Signature_group.ghosts; replace_by})
+ in
+ match item, namelist, constr with
+ | Sig_type(id, decl, rs, priv), [s],
+ With_type ({ptype_kind = Ptype_abstract} as sdecl)
when Ident.name id = s && Typedecl.is_fixed_type sdecl ->
let decl_row =
let arity = List.length sdecl.ptype_params in
type_expansion_scope = Btype.lowest_level;
type_attributes = [];
type_immediate = Unknown;
- type_unboxed = unboxed_false_default_false;
+ type_unboxed_default = false;
type_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
}
and id_row = Ident.create_local (s^"#row") in
Env.add_type ~check:false id_row decl_row initial_env
in
let tdecl =
- Typedecl.transl_with_constraint id (Some(Pident id_row))
+ Typedecl.transl_with_constraint id ~fixed_row_path:(Pident id_row)
~sig_env ~sig_decl:decl ~outer_env:initial_env sdecl in
let newdecl = tdecl.typ_type in
- check_type_decl sig_env sdecl.ptype_loc id row_id newdecl decl rs rem;
+ let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
+ check_type_decl sig_env sdecl.ptype_loc id row_id newdecl decl
+ rec_group;
let decl_row = {decl_row with type_params = newdecl.type_params} in
let rs' = if rs = Trec_first then Trec_not else rs in
- (Pident id, lid, Twith_type tdecl),
- Sig_type(id_row, decl_row, rs', priv)
- :: Sig_type(id, newdecl, rs, priv)
- :: rem
- | (Sig_type(id, sig_decl, rs, priv) :: rem , [s],
- (Pwith_type (_, sdecl) | Pwith_typesubst (_, sdecl) as constr))
+ let ghosts =
+ List.rev_append before_ghosts
+ (Sig_type(id_row, decl_row, rs', priv)::after_ghosts)
+ in
+ return ~ghosts
+ ~replace_by:(Some (Sig_type(id, newdecl, rs, priv)))
+ (Pident id, lid, Twith_type tdecl)
+ | Sig_type(id, sig_decl, rs, priv) , [s],
+ (With_type sdecl | With_typesubst sdecl as constr)
when Ident.name id = s ->
let tdecl =
- Typedecl.transl_with_constraint id None
+ Typedecl.transl_with_constraint id
~sig_env ~sig_decl ~outer_env:initial_env sdecl in
let newdecl = tdecl.typ_type and loc = sdecl.ptype_loc in
- check_type_decl sig_env loc id row_id newdecl sig_decl rs rem;
+ let before_ghosts, row_id, after_ghosts = split_row_id s ghosts in
+ let ghosts = List.rev_append before_ghosts after_ghosts in
+ check_type_decl sig_env loc id row_id newdecl sig_decl rec_group;
begin match constr with
- Pwith_type _ ->
- (Pident id, lid, Twith_type tdecl),
- Sig_type(id, newdecl, rs, priv) :: rem
- | (* Pwith_typesubst *) _ ->
+ With_type _ ->
+ return ~ghosts
+ ~replace_by:(Some(Sig_type(id, newdecl, rs, priv)))
+ (Pident id, lid, Twith_type tdecl)
+ | (* With_typesubst *) _ ->
real_ids := [Pident id];
- (Pident id, lid, Twith_typesubst tdecl),
- update_rec_next rs rem
+ return ~ghosts ~replace_by:None
+ (Pident id, lid, Twith_typesubst tdecl)
+ end
+ | Sig_modtype(id, mtd, priv), [s],
+ (With_modtype mty | With_modtypesubst mty)
+ when Ident.name id = s ->
+ let () = match mtd.mtd_type with
+ | None -> ()
+ | Some previous_mty ->
+ Includemod.check_modtype_equiv ~loc sig_env
+ id previous_mty mty.mty_type
+ in
+ if not destructive_substitution then
+ let mtd': modtype_declaration =
+ {
+ mtd_uid = Uid.mk ~current_unit:(Env.get_unit_name ());
+ mtd_type = Some mty.mty_type;
+ mtd_attributes = [];
+ mtd_loc = loc;
+ }
+ in
+ return
+ ~replace_by:(Some(Sig_modtype(id, mtd', priv)))
+ (Pident id, lid, Twith_modtype mty)
+ else begin
+ let path = Pident id in
+ real_ids := [path];
+ begin match mty.mty_type with
+ | Mty_ident _ -> ()
+ | mty -> unpackable_modtype := Some mty
+ end;
+ return ~replace_by:None (Pident id, lid, Twith_modtypesubst mty)
end
- | (Sig_type(id, _, _, _) :: rem, [s], (Pwith_type _ | Pwith_typesubst _))
- when Ident.name id = s ^ "#row" ->
- merge sig_env rem namelist (Some id)
- | (Sig_module(id, pres, md, rs, priv) :: rem, [s], Pwith_module (_, lid'))
+ | Sig_module(id, pres, md, rs, priv), [s],
+ With_module {lid=lid'; md=md'; path; remove_aliases}
when Ident.name id = s ->
- let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
let mty = md'.md_type in
let mty = Mtype.scrape_for_type_of ~remove_aliases sig_env mty in
let md'' = { md' with md_type = mty } in
let newmd = Mtype.strengthen_decl ~aliasable:false sig_env md'' path in
ignore(Includemod.modtypes ~mark:Mark_both ~loc sig_env
newmd.md_type md.md_type);
- (Pident id, lid, Twith_module (path, lid')),
- Sig_module(id, pres, newmd, rs, priv) :: rem
- | (Sig_module(id, _, md, rs, _) :: rem, [s], Pwith_modsubst (_, lid'))
+ return
+ ~replace_by:(Some(Sig_module(id, pres, newmd, rs, priv)))
+ (Pident id, lid, Twith_module (path, lid'))
+ | Sig_module(id, _, md, _rs, _), [s], With_modsubst (lid',path,md')
when Ident.name id = s ->
- let path, md' = Env.lookup_module ~loc lid'.txt initial_env in
let aliasable = not (Env.is_functor_arg path sig_env) in
ignore
(Includemod.strengthened_module_decl ~loc ~mark:Mark_both
~aliasable sig_env md' path md);
real_ids := [Pident id];
- (Pident id, lid, Twith_modsubst (path, lid')),
- update_rec_next rs rem
- | (Sig_module(id, _, md, rs, priv) as item :: rem, s :: namelist, constr)
+ return ~replace_by:None (Pident id, lid, Twith_modsubst (path, lid'))
+ | Sig_module(id, _, md, rs, priv) as item, s :: namelist, constr
when Ident.name id = s ->
let sg = extract_sig sig_env loc md.md_type in
let ((path, _, tcstr), newsg) = merge_signature sig_env sg namelist in
real_ids := path :: !real_ids;
let item =
match md.md_type, constr with
- Mty_alias _, (Pwith_module _ | Pwith_type _) ->
+ Mty_alias _, (With_module _ | With_type _) ->
(* A module alias cannot be refined, so keep it
and just check that the constraint is correct *)
item
let newmd = {md with md_type = Mty_signature newsg} in
Sig_module(id, Mp_present, newmd, rs, priv)
in
- (path, lid, tcstr),
- item :: rem
- | (item :: rem, _, _) ->
- let (cstr, items) = merge sig_env rem namelist row_id
- in
- cstr, item :: items
+ return ~replace_by:(Some item) (path, lid, tcstr)
+ | _ -> None
and merge_signature env sg namelist =
let sig_env = Env.add_signature sg env in
- merge sig_env sg namelist None
+ match
+ Signature_group.replace_in_place (patch_item constr namelist sig_env) sg
+ with
+ | Some (x,sg) -> x, sg
+ | None -> raise(Error(loc, sig_env, With_no_component lid.txt))
in
try
let names = Longident.flatten lid.txt in
let (tcstr, sg) = merge_signature initial_env sg names in
- if destructive_substitution then (
- match List.rev !real_ids with
- | [] -> assert false
- | last :: rest ->
- (* The last item is the one that's removed. We don't need to check how
- it's used since it's replaced by a more specific type/module. *)
- assert (match last with Pident _ -> true | _ -> false);
- match rest with
- | [] -> ()
- | _ :: _ ->
- check_usage_of_path_of_substituted_item
- rest initial_env sg ~loc ~lid;
- );
+ if destructive_substitution then
+ check_usage_after_substitution ~loc ~lid initial_env !real_ids
+ !unpackable_modtype sg;
let sg =
match tcstr with
| (_, _, Twith_typesubst tdecl) ->
let how_to_extend_subst =
let sdecl =
match constr with
- | Pwith_typesubst (_, sdecl) -> sdecl
+ | With_typesubst sdecl -> sdecl
| _ -> assert false
in
match type_decl_is_alias sdecl with
With_cannot_remove_constrained_type));
fun s path -> Subst.add_type_function path ~params ~body s
in
- let sub = List.fold_left how_to_extend_subst Subst.identity !real_ids in
+ let sub = Subst.change_locs Subst.identity loc in
+ let sub = List.fold_left how_to_extend_subst sub !real_ids in
(* This signature will not be used directly, it will always be freshened
by the caller. So what we do with the scope doesn't really matter. But
making it local makes it unlikely that we will ever use the result of
this function unfreshened without issue. *)
Subst.signature Make_local sub sg
| (_, _, Twith_modsubst (real_path, _)) ->
+ let sub = Subst.change_locs Subst.identity loc in
let sub =
List.fold_left
(fun s path -> Subst.add_module_path path real_path s)
- Subst.identity
+ sub
!real_ids
in
(* See explanation in the [Twith_typesubst] case above. *)
Subst.signature Make_local sub sg
+ | (_, _, Twith_modtypesubst tmty) ->
+ let add s p = Subst.add_modtype_path p tmty.mty_type s in
+ let sub = Subst.change_locs Subst.identity loc in
+ let sub = List.fold_left add sub !real_ids in
+ Subst.signature Make_local sub sg
| _ ->
sg
in
List.iter
(fun sdecl ->
match sdecl with
- | Pwith_type _ -> ()
- | Pwith_typesubst _ -> ()
+ | Pwith_type _
+ | Pwith_typesubst _
+ | Pwith_modtype _
+ | Pwith_modtypesubst _ -> ()
| Pwith_module (_, lid') ->
(* Lookup the module to make sure that it is not recursive.
(GPR#1626) *)
Env.enter_modtype ~scope d.pmtd_name.txt info env
in
Sig_modtype(id, info, Exported) :: approx_sig newenv srem
+ | Psig_modtypesubst d ->
+ let info = approx_modtype_info env d in
+ let scope = Ctype.create_scope () in
+ let (_id, newenv) =
+ Env.enter_modtype ~scope d.pmtd_name.txt info env
+ in
+ approx_sig newenv srem
| Psig_open sod ->
let _, env = type_open_descr env sod in
approx_sig env srem
module Signature_names : sig
type t
+ type shadowable =
+ {
+ self: Ident.t;
+ group: Ident.t list;
+ (** group includes the element itself and all elements
+ that should be removed at the same time
+ *)
+ loc:Location.t;
+ }
+
type info = [
| `Exported
| `From_open
- | `Shadowable of Ident.t * Location.t
+ | `Shadowable of shadowable
| `Substituted_away of Subst.t
+ | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
]
val create : unit -> t
val check_class_type: ?info:info -> t -> Location.t -> Ident.t -> unit
val check_sig_item:
- ?info:info -> t -> Location.t -> Types.signature_item -> unit
+ ?info:info -> t -> Location.t -> Signature_group.rec_group -> unit
val simplify: Env.t -> t -> Types.signature -> Types.signature
end = struct
+ type shadowable =
+ {
+ self: Ident.t;
+ group: Ident.t list;
+ (** group includes the element itself and all elements
+ that should be removed at the same time
+ *)
+ loc:Location.t;
+ }
+
type bound_info = [
| `Exported
- | `Shadowable of Ident.t * Location.t
+ | `Shadowable of shadowable
]
type info = [
| `From_open
| `Substituted_away of Subst.t
+ | `Unpackable_modtype_substituted_away of Ident.t * Subst.t
| bound_info
]
type to_be_removed = {
mutable subst: Subst.t;
mutable hide: (Sig_component_kind.t * Location.t * hide_reason) Ident.Map.t;
+ mutable unpackable_modtypes: Ident.Set.t;
}
type names_infos = (string, bound_info) Hashtbl.t
to_be_removed = {
subst = Subst.identity;
hide = Ident.Map.empty;
+ unpackable_modtypes = Ident.Set.empty;
};
}
- let check cl loc (tbl : names_infos) id (info : info) to_be_removed =
+ let table_for component names =
+ let open Sig_component_kind in
+ match component with
+ | Value -> names.values
+ | Type -> names.types
+ | Module -> names.modules
+ | Module_type -> names.modtypes
+ | Extension_constructor -> names.typexts
+ | Class -> names.classes
+ | Class_type -> names.class_types
+
+ let check cl t loc id (info : info) =
+ let to_be_removed = t.to_be_removed in
match info with
| `Substituted_away s ->
- to_be_removed.subst <- Subst.compose s to_be_removed.subst
+ to_be_removed.subst <- Subst.compose s to_be_removed.subst;
+ | `Unpackable_modtype_substituted_away (id,s) ->
+ to_be_removed.subst <- Subst.compose s to_be_removed.subst;
+ to_be_removed.unpackable_modtypes <-
+ Ident.Set.add id to_be_removed.unpackable_modtypes
| `From_open ->
to_be_removed.hide <-
Ident.Map.add id (cl, loc, From_open) to_be_removed.hide
| #bound_info as bound_info ->
+ let tbl = table_for cl t.bound in
let name = Ident.name id in
match Hashtbl.find_opt tbl name with
| None -> Hashtbl.add tbl name bound_info
- | Some (`Shadowable (shadowed_id, shadowed_loc)) ->
+ | Some (`Shadowable s) ->
Hashtbl.replace tbl name bound_info;
let reason = Shadowed_by (id, loc) in
+ List.iter (fun shadowed_id ->
to_be_removed.hide <-
- Ident.Map.add shadowed_id (cl, shadowed_loc, reason)
+ Ident.Map.add shadowed_id (cl, s.loc, reason)
to_be_removed.hide
+ ) s.group
| Some `Exported ->
raise(Error(loc, Env.empty, Repeated_name(cl, name)))
let info =
match info with
| Some i -> i
- | None -> `Shadowable (id, loc)
+ | None -> `Shadowable {self=id; group=[id]; loc}
in
- check Sig_component_kind.Value loc t.bound.values id info t.to_be_removed
+ check Sig_component_kind.Value t loc id info
let check_type ?(info=`Exported) t loc id =
- check Sig_component_kind.Type loc t.bound.types id info t.to_be_removed
+ check Sig_component_kind.Type t loc id info
let check_module ?(info=`Exported) t loc id =
- check Sig_component_kind.Module loc t.bound.modules id info t.to_be_removed
+ check Sig_component_kind.Module t loc id info
let check_modtype ?(info=`Exported) t loc id =
- check Sig_component_kind.Module_type loc t.bound.modtypes id info
- t.to_be_removed
+ check Sig_component_kind.Module_type t loc id info
let check_typext ?(info=`Exported) t loc id =
- check Sig_component_kind.Extension_constructor loc t.bound.typexts id info
- t.to_be_removed
+ check Sig_component_kind.Extension_constructor t loc id info
let check_class ?(info=`Exported) t loc id =
- check Sig_component_kind.Class loc t.bound.classes id info t.to_be_removed
+ check Sig_component_kind.Class t loc id info
let check_class_type ?(info=`Exported) t loc id =
- check Sig_component_kind.Class_type loc t.bound.class_types id info
- t.to_be_removed
-
- let check_sig_item ?info names loc component =
- let info id loc =
+ check Sig_component_kind.Class_type t loc id info
+
+ let classify =
+ let open Sig_component_kind in
+ function
+ | Sig_type(id, _, _, _) -> Type, id
+ | Sig_module(id, _, _, _, _) -> Module, id
+ | Sig_modtype(id, _, _) -> Module_type, id
+ | Sig_typext(id, _, _, _) -> Extension_constructor, id
+ | Sig_value (id, _, _) -> Value, id
+ | Sig_class (id, _, _, _) -> Class, id
+ | Sig_class_type (id, _, _, _) -> Class_type, id
+
+ let check_item ?info names loc kind id ids =
+ let info =
match info with
- | None -> `Shadowable (id, loc)
+ | None -> `Shadowable {self=id; group=ids; loc}
| Some i -> i
in
- match component with
- | Sig_type(id, _, _, _) ->
- check_type names loc id ~info:(info id loc)
- | Sig_module(id, _, _, _, _) ->
- check_module names loc id ~info:(info id loc)
- | Sig_modtype(id, _, _) ->
- check_modtype names loc id ~info:(info id loc)
- | Sig_typext(id, _, _, _) ->
- check_typext names loc id ~info:(info id loc)
- | Sig_value (id, _, _) ->
- check_value names loc id ~info:(info id loc)
- | Sig_class (id, _, _, _) ->
- check_class names loc id ~info:(info id loc)
- | Sig_class_type (id, _, _, _) ->
- check_class_type names loc id ~info:(info id loc)
+ check kind names loc id info
+
+ let check_sig_item ?info names loc (item:Signature_group.rec_group) =
+ let check ?info names loc item =
+ let all = List.map classify (Signature_group.flatten item) in
+ let group = List.map snd all in
+ List.iter (fun (kind,id) -> check_item ?info names loc kind id group)
+ all
+ in
+ (* we can ignore x.pre_ghosts: they are eliminated by strengthening, and
+ thus never appear in includes *)
+ List.iter (check ?info names loc) (Signature_group.rec_items item.group)
+
+ (*
+ Before applying local module type substitutions where the
+ right-hand side is not a path, we need to check that those module types
+ where never used to pack modules. For instance
+ {[
+ module type T := sig end
+ val x: (module T)
+ ]}
+ should raise an error.
+ *)
+ let check_unpackable_modtypes ~loc ~env to_remove component =
+ if not (Ident.Set.is_empty to_remove.unpackable_modtypes) then begin
+ let iterator =
+ let error p = Unpackable_local_modtype_subst p in
+ let paths =
+ List.map (fun id -> Pident id)
+ (Ident.Set.elements to_remove.unpackable_modtypes)
+ in
+ check_usage_of_module_types ~loc ~error ~paths
+ (ref (lazy env)) Btype.type_iterators
+ in
+ iterator.Btype.it_signature_item iterator component;
+ Btype.(unmark_iterators.it_signature_item unmark_iterators) component
+ end
(* We usually require name uniqueness of signature components (e.g. types,
modules, etc), however in some situation reusing the name is allowed: if
lst
) to_remove.hide []
in
- let aux component sg =
+ let simplify_item (component: Types.signature_item) =
let user_kind, user_id, user_loc =
let open Sig_component_kind in
match component with
| Sig_class_type (id, ct, _, _) -> Class_type, id, ct.clty_loc
in
if Ident.Map.mem user_id to_remove.hide then
- sg
+ None
else begin
let component =
if to_remove.subst == Subst.identity then
component
else
- Subst.signature_item Keep to_remove.subst component
+ begin
+ check_unpackable_modtypes ~loc:user_loc ~env to_remove component;
+ Subst.signature_item Keep to_remove.subst component
+ end
in
let component =
match ids_to_remove with
in
raise (Error(err_loc, env, Cannot_hide_id hiding_error))
in
- component :: sg
+ Some component
end
in
- List.fold_right aux sg []
+ List.filter_map simplify_item sg
end
let has_remove_aliases_attribute attr =
let init_sg = extract_sig env sbody.pmty_loc body.mty_type in
let remove_aliases = has_remove_aliases_attribute smty.pmty_attributes in
let (rev_tcstrs, final_sg) =
- List.fold_left
- (fun (rev_tcstrs,sg) sdecl ->
- let (tcstr, sg) =
- merge_constraint env remove_aliases smty.pmty_loc sg sdecl
- in
- (tcstr :: rev_tcstrs, sg)
- )
+ List.fold_left (transl_with ~loc:smty.pmty_loc env remove_aliases)
([],init_sg) constraints in
let scope = Ctype.create_scope () in
mkmty (Tmty_with ( body, List.rev rev_tcstrs))
| Pmty_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
+and transl_with ~loc env remove_aliases (rev_tcstrs,sg) constr =
+ let lid, with_info = match constr with
+ | Pwith_type (l,decl) ->l , With_type decl
+ | Pwith_typesubst (l,decl) ->l , With_typesubst decl
+ | Pwith_module (l,l') ->
+ let path, md = Env.lookup_module ~loc l'.txt env in
+ l , With_module {lid=l';path;md; remove_aliases}
+ | Pwith_modsubst (l,l') ->
+ let path, md' = Env.lookup_module ~loc l'.txt env in
+ l , With_modsubst (l',path,md')
+ | Pwith_modtype (l,smty) ->
+ let mty = transl_modtype env smty in
+ l, With_modtype mty
+ | Pwith_modtypesubst (l,smty) ->
+ let mty = transl_modtype env smty in
+ l, With_modtypesubst mty
+ in
+ let (tcstr, sg) = merge_constraint env loc sg lid with_info in
+ (tcstr :: rev_tcstrs, sg)
+
+
+
and transl_signature env sg =
let names = Signature_names.create () in
let rec transl_sig env sg =
decls rem,
final_env
| Psig_modtype pmtd ->
- let newenv, mtd, sg = transl_modtype_decl names env pmtd in
+ let newenv, mtd, sg = transl_modtype_decl env pmtd in
+ Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
let (trem, rem, final_env) = transl_sig newenv srem in
mksig (Tsig_modtype mtd) env loc :: trem,
sg :: rem,
final_env
+ | Psig_modtypesubst pmtd ->
+ let newenv, mtd, _sg = transl_modtype_decl env pmtd in
+ let info =
+ let mty = match mtd.mtd_type with
+ | Some tmty -> tmty.mty_type
+ | None ->
+ (* parsetree invariant, see Ast_invariants *)
+ assert false
+ in
+ let subst = Subst.add_modtype mtd.mtd_id mty Subst.identity in
+ match mty with
+ | Mty_ident _ -> `Substituted_away subst
+ | _ -> `Unpackable_modtype_substituted_away (mtd.mtd_id,subst)
+ in
+ Signature_names.check_modtype ~info names pmtd.pmtd_loc mtd.mtd_id;
+ let (trem, rem, final_env) = transl_sig newenv srem in
+ mksig (Tsig_modtypesubst mtd) env loc :: trem,
+ rem,
+ final_env
| Psig_open sod ->
let (od, newenv) = type_open_descr env sod in
let (trem, rem, final_env) = transl_sig newenv srem in
let scope = Ctype.create_scope () in
let sg, newenv = Env.enter_signature ~scope
(extract_sig env smty.pmty_loc mty) env in
- List.iter (Signature_names.check_sig_item names item.psig_loc) sg;
+ Signature_group.iter
+ (Signature_names.check_sig_item names item.psig_loc)
+ sg;
let incl =
{ incl_mod = tmty;
incl_type = sg;
sg
)
-and transl_modtype_decl names env pmtd =
+and transl_modtype_decl env pmtd =
Builtin_attributes.warning_scope pmtd.pmtd_attributes
- (fun () -> transl_modtype_decl_aux names env pmtd)
+ (fun () -> transl_modtype_decl_aux env pmtd)
-and transl_modtype_decl_aux names env
+and transl_modtype_decl_aux env
{pmtd_name; pmtd_type; pmtd_attributes; pmtd_loc} =
let tmty =
Option.map (transl_modtype (Env.in_signature true env)) pmtd_type
in
let scope = Ctype.create_scope () in
let (id, newenv) = Env.enter_modtype ~scope pmtd_name.txt decl env in
- Signature_names.check_modtype names pmtd_loc id;
let mtd =
{
mtd_id=id;
| Mty_ident p -> raise(Error(loc, env, Cannot_scrape_package_type p))
end
-let modtype_of_package env loc p nl tl =
+let modtype_of_package env loc p fl =
package_constraints env loc (Mty_ident p)
- (List.combine (List.map Longident.flatten nl) tl)
-
-let package_subtype env p1 nl1 tl1 p2 nl2 tl2 =
- let mkmty p nl tl =
- let ntl =
- List.filter (fun (_n,t) -> Ctype.free_variables t = [])
- (List.combine nl tl) in
- let (nl, tl) = List.split ntl in
- modtype_of_package env Location.none p nl tl
+ (List.map (fun (n, t) -> (Longident.flatten n, t)) fl)
+
+let package_subtype env p1 fl1 p2 fl2 =
+ let mkmty p fl =
+ let fl =
+ List.filter (fun (_n,t) -> Ctype.free_variables t = []) fl in
+ modtype_of_package env Location.none p fl
in
- match mkmty p1 nl1 tl1, mkmty p2 nl2 tl2 with
+ match mkmty p1 fl1, mkmty p2 fl2 with
| exception Error(_, _, Cannot_scrape_package_type _) -> false
| mty1, mty2 ->
let loc = Location.none in
(* Type a module value expression *)
+
+(* Summary for F(X) *)
+type application_summary = {
+ loc: Location.t;
+ attributes: attributes;
+ f_loc: Location.t; (* loc for F *)
+ arg_is_syntactic_unit: bool;
+ arg: Typedtree.module_expr;
+ arg_path:Path.t option
+}
+
+let simplify_app_summary app_view =
+ let mty = app_view.arg.mod_type in
+ match app_view.arg_is_syntactic_unit , app_view.arg_path with
+ | true, _ -> Includemod.Error.Unit, mty
+ | false, Some p -> Includemod.Error.Named p, mty
+ | false, None -> Includemod.Error.Anonymous, mty
+
let rec type_module ?(alias=false) sttn funct_body anchor env smod =
Builtin_attributes.warning_scope smod.pmod_attributes
(fun () -> type_module_aux ~alias sttn funct_body anchor env smod)
else match (Env.find_module path env).md_type with
| Mty_alias p1 when not alias ->
let p1 = Env.normalize_module_path (Some smod.pmod_loc) env p1 in
- let mty = Includemod.expand_module_alias env [] p1 in
+ let mty = Includemod.expand_module_alias env p1 in
{ md with
mod_desc =
Tmod_constraint (md, mty, Tmodtype_implicit,
in
Named (id, param, mty), Types.Named (id, mty.mty_type), newenv, true
in
- let body = type_module sttn funct_body None newenv sbody in
+ let body = type_module true funct_body None newenv sbody in
{ mod_desc = Tmod_functor(t_arg, body);
mod_type = Mty_functor(ty_arg, body.mod_type);
mod_env = env;
mod_attributes = smod.pmod_attributes;
mod_loc = smod.pmod_loc }
- | Pmod_apply(sfunct, sarg) ->
- let arg = type_module true funct_body None env sarg in
- let path = path_of_module arg in
- let funct =
- type_module (sttn && path <> None) funct_body None env sfunct in
- begin match Env.scrape_alias env funct.mod_type with
- | Mty_functor (Unit, mty_res) ->
- if sarg.pmod_desc <> Pmod_structure [] then
- raise (Error (sfunct.pmod_loc, env, Apply_generative));
- if funct_body && Mtype.contains_type env funct.mod_type then
- raise (Error (smod.pmod_loc, env, Not_allowed_in_functor_body));
- { mod_desc = Tmod_apply(funct, arg, Tcoerce_none);
- mod_type = mty_res;
- mod_env = env;
- mod_attributes = smod.pmod_attributes;
- mod_loc = smod.pmod_loc }
- | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
- let coercion =
- try
- Includemod.modtypes ~loc:sarg.pmod_loc ~mark:Mark_both env
- arg.mod_type mty_param
- with Includemod.Error msg ->
- raise(Error(sarg.pmod_loc, env, Not_included msg)) in
- let mty_appl =
- match path with
- | Some path ->
- let scope = Ctype.create_scope () in
- let subst =
- match param with
- | None -> Subst.identity
- | Some p -> Subst.add_module p path Subst.identity
- in
- Subst.modtype (Rescope scope) subst mty_res
- | None ->
- let env, nondep_mty =
- match param with
- | None -> env, mty_res
- | Some param ->
- let env =
- Env.add_module ~arg:true param Mp_present arg.mod_type
- env
- in
- check_well_formed_module env smod.pmod_loc
- "the signature of this functor application" mty_res;
- try env, Mtype.nondep_supertype env [param] mty_res
- with Ctype.Nondep_cannot_erase _ ->
- raise(Error(smod.pmod_loc, env,
- Cannot_eliminate_dependency mty_functor))
- in
- begin match
- Includemod.modtypes ~mark:Mark_neither
- ~loc:smod.pmod_loc env mty_res nondep_mty
- with
- | Tcoerce_none -> ()
- | _ ->
- fatal_error
- "unexpected coercion from original module type to \
- nondep_supertype one"
- | exception Includemod.Error _ ->
- fatal_error
- "nondep_supertype not included in original module type"
- end;
- nondep_mty
- in
- check_well_formed_module env smod.pmod_loc
- "the signature of this functor application" mty_appl;
- { mod_desc = Tmod_apply(funct, arg, coercion);
- mod_type = mty_appl;
- mod_env = env;
- mod_attributes = smod.pmod_attributes;
- mod_loc = smod.pmod_loc }
- | Mty_alias path ->
- raise(Error(sfunct.pmod_loc, env, Cannot_scrape_alias path))
- | _ ->
- raise(Error(sfunct.pmod_loc, env, Cannot_apply funct.mod_type))
- end
+ | Pmod_apply _ ->
+ type_application smod.pmod_loc sttn funct_body env smod
| Pmod_constraint(sarg, smty) ->
let arg = type_module ~alias true funct_body anchor env sarg in
let mty = transl_modtype env smty in
mod_loc = smod.pmod_loc;
mod_attributes = smod.pmod_attributes;
}
-
| Pmod_unpack sexp ->
if !Clflags.principal then Ctype.begin_def ();
let exp = Typecore.type_exp env sexp in
end;
let mty =
match Ctype.expand_head env exp.exp_type with
- {desc = Tpackage (p, nl, tl)} ->
- if List.exists (fun t -> Ctype.free_variables t <> []) tl then
+ {desc = Tpackage (p, fl)} ->
+ if List.exists (fun (_n, t) -> Ctype.free_variables t <> []) fl then
raise (Error (smod.pmod_loc, env,
Incomplete_packed_module exp.exp_type));
if !Clflags.principal &&
then
Location.prerr_warning smod.pmod_loc
(Warnings.Not_principal "this module unpacking");
- modtype_of_package env smod.pmod_loc p nl tl
+ modtype_of_package env smod.pmod_loc p fl
| {desc = Tvar _} ->
raise (Typecore.Error
(smod.pmod_loc, env, Typecore.Cannot_infer_signature))
| Pmod_extension ext ->
raise (Error_forward (Builtin_attributes.error_of_extension ext))
+and type_application loc strengthen funct_body env smod =
+ let rec extract_application funct_body env sargs smod =
+ match smod.pmod_desc with
+ | Pmod_apply(f, sarg) ->
+ let arg = type_module true funct_body None env sarg in
+ let summary =
+ { loc=smod.pmod_loc;
+ attributes=smod.pmod_attributes;
+ f_loc = f.pmod_loc;
+ arg_is_syntactic_unit = sarg.pmod_desc = Pmod_structure [];
+ arg;
+ arg_path = path_of_module arg
+ }
+ in
+ extract_application funct_body env (summary::sargs) f
+ | _ -> smod, sargs
+ in
+ let sfunct, args = extract_application funct_body env [] smod in
+ let funct =
+ let strengthen =
+ strengthen && List.for_all (fun {arg_path;_} -> arg_path <> None) args
+ in
+ type_module strengthen funct_body None env sfunct
+ in
+ List.fold_left (type_one_application ~ctx:(loc, funct, args) funct_body env)
+ funct args
+
+and type_one_application ~ctx:(apply_loc,md_f,args) funct_body env funct
+ app_view =
+ match Env.scrape_alias env funct.mod_type with
+ | Mty_functor (Unit, mty_res) ->
+ if not app_view.arg_is_syntactic_unit then
+ raise (Error (app_view.f_loc, env, Apply_generative));
+ if funct_body && Mtype.contains_type env funct.mod_type then
+ raise (Error (apply_loc, env, Not_allowed_in_functor_body));
+ { mod_desc = Tmod_apply(funct, app_view.arg, Tcoerce_none);
+ mod_type = mty_res;
+ mod_env = env;
+ mod_attributes = app_view.attributes;
+ mod_loc = funct.mod_loc }
+ | Mty_functor (Named (param, mty_param), mty_res) as mty_functor ->
+ let coercion =
+ try
+ Includemod.modtypes
+ ~loc:app_view.arg.mod_loc ~mark:Mark_both env
+ app_view.arg.mod_type mty_param
+ with Includemod.Error _ ->
+ let args = List.map simplify_app_summary args in
+ let mty_f = md_f.mod_type in
+ let lid_app = None in
+ raise(Includemod.Apply_error {loc=apply_loc;env;lid_app;mty_f;args})
+ in
+ let mty_appl =
+ match app_view.arg_path with
+ | Some path ->
+ let scope = Ctype.create_scope () in
+ let subst =
+ match param with
+ | None -> Subst.identity
+ | Some p -> Subst.add_module p path Subst.identity
+ in
+ Subst.modtype (Rescope scope) subst mty_res
+ | None ->
+ let env, nondep_mty =
+ match param with
+ | None -> env, mty_res
+ | Some param ->
+ let env =
+ Env.add_module ~arg:true param Mp_present
+ app_view.arg.mod_type env
+ in
+ check_well_formed_module env app_view.loc
+ "the signature of this functor application" mty_res;
+ try env, Mtype.nondep_supertype env [param] mty_res
+ with Ctype.Nondep_cannot_erase _ ->
+ let error = Cannot_eliminate_dependency mty_functor in
+ raise (Error(app_view.loc, env, error))
+ in
+ begin match
+ Includemod.modtypes
+ ~loc:app_view.loc ~mark:Mark_neither env mty_res nondep_mty
+ with
+ | Tcoerce_none -> ()
+ | _ ->
+ fatal_error
+ "unexpected coercion from original module type to \
+ nondep_supertype one"
+ | exception Includemod.Error _ ->
+ fatal_error
+ "nondep_supertype not included in original module type"
+ end;
+ nondep_mty
+ in
+ check_well_formed_module env apply_loc
+ "the signature of this functor application" mty_appl;
+ { mod_desc = Tmod_apply(funct, app_view.arg, coercion);
+ mod_type = mty_appl;
+ mod_env = env;
+ mod_attributes = app_view.attributes;
+ mod_loc = app_view.loc }
+ | Mty_alias path ->
+ raise(Error(app_view.f_loc, env, Cannot_scrape_alias path))
+ | _ ->
+ let args = List.map simplify_app_summary args in
+ let mty_f = md_f.mod_type in
+ let lid_app = None in
+ raise(Includemod.Apply_error {loc=apply_loc;env;lid_app;mty_f;args})
+
and type_open_decl ?used_slot ?toplevel funct_body names env sod =
Builtin_attributes.warning_scope sod.popen_attributes
(fun () ->
| Some false | None -> Some `From_open, Hidden
| Some true -> None, Exported
in
- List.iter (Signature_names.check_sig_item ?info names loc) sg;
+ Signature_group.iter (Signature_names.check_sig_item ?info names loc) sg;
let sg =
List.map (function
| Sig_value(id, vd, _) -> Sig_value(id, vd, visibility)
newenv
| Pstr_modtype pmtd ->
(* check that it is non-abstract *)
- let newenv, mtd, sg = transl_modtype_decl names env pmtd in
+ let newenv, mtd, sg = transl_modtype_decl env pmtd in
+ Signature_names.check_modtype names pmtd.pmtd_loc mtd.mtd_id;
Tstr_modtype mtd, [sg], newenv
| Pstr_open sod ->
let (od, sg, newenv) =
(List.map (fun cls ->
(cls.Typeclass.cls_info,
cls.Typeclass.cls_pub_methods)) classes),
-(* TODO: check with Jacques why this is here
- Tstr_class_type
- (List.map (fun (_,_, i, d, _,_,_,_,_,_,c) -> (i, c)) classes) ::
- Tstr_type
- (List.map (fun (_,_,_,_, i, d, _,_,_,_,_) -> (i, d)) classes) ::
- Tstr_type
- (List.map (fun (_,_,_,_,_,_, i, d, _,_,_) -> (i, d)) classes) ::
-*)
List.flatten
(map_rec
(fun rs cls ->
(cl.Typeclass.clsty_ty_id,
cl.Typeclass.clsty_id_loc,
cl.Typeclass.clsty_info)) classes),
-(* TODO: check with Jacques why this is here
- Tstr_type
- (List.map (fun (_, _, i, d, _, _) -> (i, d)) classes) ::
- Tstr_type
- (List.map (fun (_, _, _, _, i, d) -> (i, d)) classes) :: *)
List.flatten
(map_rec
(fun rs decl ->
(* Rename all identifiers bound by this signature to avoid clashes *)
let sg, new_env = Env.enter_signature ~scope
(extract_sig_open env smodl.pmod_loc modl.mod_type) env in
- List.iter (Signature_names.check_sig_item names loc) sg;
+ Signature_group.iter (Signature_names.check_sig_item names loc) sg;
let incl =
{ incl_mod = modl;
incl_type = sg;
| Ldot(m, name) -> Pdot(module_path m, name)
| Lapply _ -> assert false
-let type_package env m p nl =
+let type_package env m p fl =
(* Same as Pexp_letmodule *)
(* remember original level *)
Ctype.begin_def ();
let modl = type_module env m in
let scope = Ctype.create_scope () in
Typetexp.widen context;
- let nl', tl', env =
- match nl with
- | [] -> [], [], env
- | nl ->
+ let fl', env =
+ match fl with
+ | [] -> [], env
+ | fl ->
let type_path, env =
match modl.mod_desc with
| Tmod_ident (mp,_)
let sg, env = Env.enter_signature ~scope sg env in
lookup_type_in_sig sg, env
in
- let nl', tl' =
+ let fl' =
List.fold_right
- (fun lid (nl, tl) ->
+ (fun (lid, _t) fl ->
match type_path lid with
- | exception Not_found -> (nl, tl)
+ | exception Not_found -> fl
| path -> begin
match Env.find_type path env with
- | exception Not_found -> (nl, tl)
+ | exception Not_found -> fl
| decl ->
if decl.type_arity > 0 then begin
- (nl, tl)
+ fl
end else begin
let t = Btype.newgenty (Tconstr (path,[],ref Mnil)) in
- (lid :: nl, t :: tl)
+ (lid, t) :: fl
end
end)
- nl ([], [])
+ fl []
in
- nl', tl', env
+ fl', env
in
(* go back to original level *)
Ctype.end_def ();
let mty =
- if nl = [] then (Mty_ident p)
- else modtype_of_package env modl.mod_loc p nl' tl'
+ if fl = [] then (Mty_ident p)
+ else modtype_of_package env modl.mod_loc p fl'
in
- List.iter2
- (fun n ty ->
+ List.iter
+ (fun (n, ty) ->
try Ctype.unify env ty (Ctype.newvar ())
with Ctype.Unify _ ->
raise (Error(modl.mod_loc, env, Scoping_pack (n,ty))))
- nl' tl';
+ fl';
let modl = wrap_constraint env true modl mty Tmodtype_implicit in
- (* Dropped exports should have produced an error above *)
- assert (List.length nl = List.length tl');
- modl, tl'
+ modl, fl'
(* Fill in the forward declarations *)
Typecore.reset_delayed_checks ();
Env.reset_required_globals ();
if !Clflags.print_types then (* #7656 *)
- Warnings.parse_options false "-32-34-37-38-60";
+ ignore @@ Warnings.parse_options false "-32-34-37-38-60";
let (str, sg, names, finalenv) =
type_structure initial_env ast in
let simple_sg = Signature_names.simplify finalenv names sg in
(Printtyp.printed_signature sourcefile) simple_sg
);
gen_annot outputprefix sourcefile (Cmt_format.Implementation str);
- (str, Tcoerce_none) (* result is ignored by Compile.implementation *)
+ { structure = str;
+ coercion = Tcoerce_none;
+ signature = simple_sg
+ } (* result is ignored by Compile.implementation *)
end else begin
let sourceintf =
Filename.remove_extension sourcefile ^ !Config.interface_suffix in
Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
annots (Some sourcefile) initial_env None;
gen_annot outputprefix sourcefile annots;
- (str, coercion)
+ { structure = str;
+ coercion;
+ signature = dclsig
+ }
end else begin
+ Location.prerr_warning (Location.in_file sourcefile)
+ Warnings.Missing_mli;
let coercion =
Includemod.compunit initial_env ~mark:Mark_positive
sourcefile sg "(inferred signature)" simple_sg
annots (Some sourcefile) initial_env (Some cmi);
gen_annot outputprefix sourcefile annots
end;
- (str, coercion)
+ { structure = str;
+ coercion;
+ signature = simple_sg
+ }
end
end
)
Tcoerce_none
end
+
(* Error report *)
+
open Printtyp
-let report_error ppf = function
+let report_error ~loc _env = function
Cannot_apply mty ->
- fprintf ppf
+ Location.errorf ~loc
"@[This module is not a functor; it has type@ %a@]" modtype mty
| Not_included errs ->
- fprintf ppf
- "@[<v>Signature mismatch:@ %a@]" Includemod.report_error errs
+ let main = Includemod_errorprinter.err_msgs errs in
+ Location.errorf ~loc "@[<v>Signature mismatch:@ %t@]" main
| Cannot_eliminate_dependency mty ->
- fprintf ppf
+ Location.errorf ~loc
"@[This functor has type@ %a@ \
The parameter cannot be eliminated in the result type.@ \
Please bind the argument to a module identifier.@]" modtype mty
- | Signature_expected -> fprintf ppf "This module type is not a signature"
+ | Signature_expected ->
+ Location.errorf ~loc "This module type is not a signature"
| Structure_expected mty ->
- fprintf ppf
+ Location.errorf ~loc
"@[This module is not a structure; it has type@ %a" modtype mty
| With_no_component lid ->
- fprintf ppf
+ Location.errorf ~loc
"@[The signature constrained by `with' has no component named %a@]"
longident lid
| With_mismatch(lid, explanation) ->
- fprintf ppf
+ let main = Includemod_errorprinter.err_msgs explanation in
+ Location.errorf ~loc
"@[<v>\
@[In this `with' constraint, the new definition of %a@ \
does not match its original definition@ \
in the constrained signature:@]@ \
- %a@]"
- longident lid Includemod.report_error explanation
+ %t@]"
+ longident lid main
| With_makes_applicative_functor_ill_typed(lid, path, explanation) ->
- fprintf ppf
+ let main = Includemod_errorprinter.err_msgs explanation in
+ Location.errorf ~loc
"@[<v>\
@[This `with' constraint on %a makes the applicative functor @ \
type %s ill-typed in the constrained signature:@]@ \
- %a@]"
- longident lid (Path.name path) Includemod.report_error explanation
+ %t@]"
+ longident lid (Path.name path) main
| With_changes_module_alias(lid, id, path) ->
- fprintf ppf
+ Location.errorf ~loc
"@[<v>\
@[This `with' constraint on %a changes %s, which is aliased @ \
in the constrained signature (as %s)@].@]"
longident lid (Path.name path) (Ident.name id)
| With_cannot_remove_constrained_type ->
- fprintf ppf
+ Location.errorf ~loc
"@[<v>Destructive substitutions are not supported for constrained @ \
types (other than when replacing a type constructor with @ \
a type constructor with the same arguments).@]"
+ | With_cannot_remove_packed_modtype (p,mty) ->
+ Location.errorf ~loc
+ "This `with' constraint@ %s := %a@ makes a packed module ill-formed."
+ (Path.name p) Printtyp.modtype mty
| Repeated_name(kind, name) ->
- fprintf ppf
+ Location.errorf ~loc
"@[Multiple definition of the %s name %s.@ \
Names must be unique in a given structure or signature.@]"
(Sig_component_kind.to_string kind) name
| Non_generalizable typ ->
- fprintf ppf
+ Location.errorf ~loc
"@[The type of this expression,@ %a,@ \
contains type variables that cannot be generalized@]" type_scheme typ
| Non_generalizable_class (id, desc) ->
- fprintf ppf
+ Location.errorf ~loc
"@[The type of this class,@ %a,@ \
contains type variables that cannot be generalized@]"
(class_declaration id) desc
| Non_generalizable_module mty ->
- fprintf ppf
+ Location.errorf ~loc
"@[The type of this module,@ %a,@ \
contains type variables that cannot be generalized@]" modtype mty
| Implementation_is_required intf_name ->
- fprintf ppf
+ Location.errorf ~loc
"@[The interface %a@ declares values, not just types.@ \
An implementation must be provided.@]"
Location.print_filename intf_name
| Interface_not_compiled intf_name ->
- fprintf ppf
+ Location.errorf ~loc
"@[Could not find the .cmi file for interface@ %a.@]"
Location.print_filename intf_name
| Not_allowed_in_functor_body ->
- fprintf ppf
+ Location.errorf ~loc
"@[This expression creates fresh types.@ %s@]"
"It is not allowed inside applicative functors."
| Not_a_packed_module ty ->
- fprintf ppf
+ Location.errorf ~loc
"This expression is not a packed module. It has type@ %a"
type_expr ty
| Incomplete_packed_module ty ->
- fprintf ppf
+ Location.errorf ~loc
"The type of this packed module contains variables:@ %a"
type_expr ty
| Scoping_pack (lid, ty) ->
- fprintf ppf
- "The type %a in this module cannot be exported.@ " longident lid;
- fprintf ppf
- "Its type contains local dependencies:@ %a" type_expr ty
+ Location.errorf ~loc
+ "The type %a in this module cannot be exported.@ \
+ Its type contains local dependencies:@ %a" longident lid type_expr ty
| Recursive_module_require_explicit_type ->
- fprintf ppf "Recursive modules require an explicit module type."
+ Location.errorf ~loc "Recursive modules require an explicit module type."
| Apply_generative ->
- fprintf ppf "This is a generative functor. It can only be applied to ()"
+ Location.errorf ~loc
+ "This is a generative functor. It can only be applied to ()"
| Cannot_scrape_alias p ->
- fprintf ppf
+ Location.errorf ~loc
"This is an alias for module %a, which is missing"
path p
| Cannot_scrape_package_type p ->
- fprintf ppf
+ Location.errorf ~loc
"The type of this packed module refers to %a, which is missing"
path p
| Badly_formed_signature (context, err) ->
- fprintf ppf "@[In %s:@ %a@]" context Typedecl.report_error err
+ Location.errorf ~loc "@[In %s:@ %a@]" context Typedecl.report_error err
| Cannot_hide_id Illegal_shadowing
{ shadowed_item_kind; shadowed_item_id; shadowed_item_loc;
shadower_id; user_id; user_kind; user_loc } ->
let shadowed_item_kind= Sig_component_kind.to_string shadowed_item_kind in
- fprintf ppf
+ Location.errorf ~loc
"@[<v>Illegal shadowing of included %s %a by %a@ \
%a:@;<1 2>%s %a came from this include@ \
%a:@;<1 2>The %s %s has no valid type if %a is shadowed@]"
| Cannot_hide_id Appears_in_signature
{ opened_item_kind; opened_item_id; user_id; user_kind; user_loc } ->
let opened_item_kind= Sig_component_kind.to_string opened_item_kind in
- fprintf ppf
+ Location.errorf ~loc
"@[<v>The %s %a introduced by this open appears in the signature@ \
%a:@;<1 2>The %s %s has no valid type if %a is hidden@]"
opened_item_kind Ident.print opened_item_id
(Sig_component_kind.to_string user_kind) (Ident.name user_id)
Ident.print opened_item_id
| Invalid_type_subst_rhs ->
- fprintf ppf "Only type synonyms are allowed on the right of :="
+ Location.errorf ~loc "Only type synonyms are allowed on the right of :="
+ | Unpackable_local_modtype_subst p ->
+ Location.errorf ~loc
+ "The module type@ %s@ is not a valid type for a packed module:@ \
+ it is defined as a local substitution for a non-path module type."
+ (Path.name p)
-let report_error env ppf err =
- Printtyp.wrap_printing_env ~error:true env (fun () -> report_error ppf err)
+let report_error env ~loc err =
+ Printtyp.wrap_printing_env ~error:true env
+ (fun () -> report_error env ~loc err)
let () =
Location.register_error_of_exn
(function
| Error (loc, env, err) ->
- Some (Location.error_of_printer ~loc (report_error env) err)
+ Some (report_error ~loc env err)
| Error_forward err ->
Some err
| _ ->
*)
open Types
-open Format
module Signature_names : sig
type t
Env.t -> Parsetree.structure ->
Typedtree.structure * Types.signature * Signature_names.t * Env.t
val type_implementation:
- string -> string -> string -> Env.t -> Parsetree.structure ->
- Typedtree.structure * Typedtree.module_coercion
+ string -> string -> string -> Env.t ->
+ Parsetree.structure -> Typedtree.implementation
val type_interface:
Env.t -> Parsetree.signature -> Typedtree.signature
val transl_signature:
*)
val modtype_of_package:
Env.t -> Location.t ->
- Path.t -> Longident.t list -> type_expr list -> module_type
+ Path.t -> (Longident.t * type_expr) list -> module_type
val path_of_module : Typedtree.module_expr -> Path.t option
type error =
Cannot_apply of module_type
- | Not_included of Includemod.error list
+ | Not_included of Includemod.explanation
| Cannot_eliminate_dependency of module_type
| Signature_expected
| Structure_expected of module_type
| With_no_component of Longident.t
- | With_mismatch of Longident.t * Includemod.error list
+ | With_mismatch of Longident.t * Includemod.explanation
| With_makes_applicative_functor_ill_typed of
- Longident.t * Path.t * Includemod.error list
+ Longident.t * Path.t * Includemod.explanation
| With_changes_module_alias of Longident.t * Ident.t * Path.t
| With_cannot_remove_constrained_type
| Repeated_name of Sig_component_kind.t * string
| Badly_formed_signature of string * Typedecl.error
| Cannot_hide_id of hiding_error
| Invalid_type_subst_rhs
+ | Unpackable_local_modtype_subst of Path.t
+ | With_cannot_remove_packed_modtype of Path.t * module_type
exception Error of Location.t * Env.t * error
exception Error_forward of Location.error
-val report_error: Env.t -> formatter -> error -> unit
+val report_error: Env.t -> loc:Location.t -> error -> Location.error
match ty.desc with
| Tconstr (p, _, _) ->
begin match Env.find_type p env with
- | {type_unboxed = {unboxed = true; _}; _} ->
+ | {type_kind = ( Type_variant (_, Variant_unboxed)
+ | Type_record (_, Record_unboxed _) ); _} ->
begin match Typedecl.get_unboxed_type_representation env ty with
| None -> ty
| Some ty2 -> ty2
let bigarray_decode_type env ty tbl dfl =
match scrape env ty with
| Tconstr(Pdot(Pident mod_id, type_name), [], _)
- when Ident.name mod_id = "Stdlib__bigarray" ->
+ when Ident.name mod_id = "Stdlib__Bigarray" ->
begin try List.assoc type_name tbl with Not_found -> dfl end
| _ ->
dfl
| Tfield of string * field_kind * type_expr * type_expr
| Tnil
| Tlink of type_expr
- | Tsubst of type_expr (* for copying *)
+ | Tsubst of type_expr * type_expr option
| Tvariant of row_desc
| Tunivar of string option
| Tpoly of type_expr * type_expr list
- | Tpackage of Path.t * Longident.t list * type_expr list
+ | Tpackage of Path.t * (Longident.t * type_expr) list
and row_desc =
{ row_fields: (label * row_field) list;
let equal t1 t2 = t1 == t2
end
+module Private_type_expr = struct
+ let create desc ~level ~scope ~id = {desc; level; scope; id}
+ let set_desc ty d = ty.desc <- d
+ let set_level ty lv = ty.level <- lv
+ let set_scope ty sc = ty.scope <- sc
+end
(* *)
module Uid = struct
type type_declaration =
{ type_params: type_expr list;
type_arity: int;
- type_kind: type_kind;
+ type_kind: type_decl_kind;
type_private: private_flag;
type_manifest: type_expr option;
type_variance: Variance.t list;
type_loc: Location.t;
type_attributes: Parsetree.attributes;
type_immediate: Type_immediacy.t;
- type_unboxed: unboxed_status;
+ type_unboxed_default: bool;
type_uid: Uid.t;
}
-and type_kind =
+and type_decl_kind = (label_declaration, constructor_declaration) type_kind
+
+and ('lbl, 'cstr) type_kind =
Type_abstract
- | Type_record of label_declaration list * record_representation
- | Type_variant of constructor_declaration list
+ | Type_record of 'lbl list * record_representation
+ | Type_variant of 'cstr list * variant_representation
| Type_open
and record_representation =
| Record_inlined of int (* Inlined record *)
| Record_extension of Path.t (* Inlined record under extension *)
+and variant_representation =
+ Variant_regular (* Constant or boxed constructors *)
+ | Variant_unboxed (* One unboxed single-field constructor *)
+
and label_declaration =
{
ld_id: Ident.t;
| Cstr_tuple of type_expr list
| Cstr_record of label_declaration list
-and unboxed_status =
- {
- unboxed: bool;
- default: bool; (* False if the unboxed field was set from an attribute. *)
- }
-
-let unboxed_false_default_false = {unboxed = false; default = false}
-let unboxed_false_default_true = {unboxed = false; default = true}
-let unboxed_true_default_false = {unboxed = true; default = false}
-let unboxed_true_default_true = {unboxed = true; default = true}
-
type extension_constructor =
{ ext_type_path: Path.t;
ext_type_params: type_expr list;
Note on mutability: TBD.
*)
-type type_expr =
+type type_expr = private
{ mutable desc: type_desc;
mutable level: int;
mutable scope: int;
| Tlink of type_expr
(** Indirection used by unification engine. *)
- | Tsubst of type_expr (* for copying *)
+ | Tsubst of type_expr * type_expr option
(** [Tsubst] is used temporarily to store information in low-level
functions manipulating representation of types, such as
instantiation or copy.
+ The first argument contains a copy of the original node.
+ The second is available only when the first is the row variable of
+ a polymorphic variant. It then contains a copy of the whole variant.
This constructor should not appear outside of these cases. *)
| Tvariant of row_desc
where 'a1 ... 'an are names given to types in tyl
and occurrences of those types in ty. *)
- | Tpackage of Path.t * Longident.t list * type_expr list
+ | Tpackage of Path.t * (Longident.t * type_expr) list
(** Type of a first-class module (a.k.a package). *)
(** [ `X | `Y ] (row_closed = true)
| Cunknown
| Clink of commutable ref
+module Private_type_expr : sig
+ val create : type_desc -> level: int -> scope: int -> id: int -> type_expr
+ val set_desc : type_expr -> type_desc -> unit
+ val set_level : type_expr -> int -> unit
+ val set_scope : type_expr -> int -> unit
+end
+
module TypeOps : sig
type t = type_expr
val compare : t -> t -> int
type type_declaration =
{ type_params: type_expr list;
type_arity: int;
- type_kind: type_kind;
+ type_kind: type_decl_kind;
type_private: private_flag;
type_manifest: type_expr option;
type_variance: Variance.t list;
type_loc: Location.t;
type_attributes: Parsetree.attributes;
type_immediate: Type_immediacy.t;
- type_unboxed: unboxed_status;
+ type_unboxed_default: bool;
+ (* true if the unboxed-ness of this type was chosen by a compiler flag *)
type_uid: Uid.t;
}
-and type_kind =
+and type_decl_kind = (label_declaration, constructor_declaration) type_kind
+
+and ('lbl, 'cstr) type_kind =
Type_abstract
- | Type_record of label_declaration list * record_representation
- | Type_variant of constructor_declaration list
+ | Type_record of 'lbl list * record_representation
+ | Type_variant of 'cstr list * variant_representation
| Type_open
and record_representation =
| Record_inlined of int (* Inlined record *)
| Record_extension of Path.t (* Inlined record under extension *)
+and variant_representation =
+ Variant_regular (* Constant or boxed constructors *)
+ | Variant_unboxed (* One unboxed single-field constructor *)
+
and label_declaration =
{
ld_id: Ident.t;
| Cstr_tuple of type_expr list
| Cstr_record of label_declaration list
-and unboxed_status = private
- (* This type must be private in order to ensure perfect sharing of the
- four possible values. Otherwise, ocamlc.byte and ocamlc.opt produce
- different executables. *)
- {
- unboxed: bool;
- default: bool; (* True for unannotated unboxable types. *)
- }
-
-val unboxed_false_default_false : unboxed_status
-val unboxed_false_default_true : unboxed_status
-val unboxed_true_default_false : unboxed_status
-val unboxed_true_default_true : unboxed_status
-
type extension_constructor =
{
ext_type_path: Path.t;
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
- | Type_mismatch of Ctype.Unification_trace.t
- | Alias_type_mismatch of Ctype.Unification_trace.t
+ | Type_mismatch of Errortrace.unification Errortrace.t
+ | Alias_type_mismatch of Errortrace.unification Errortrace.t
| Present_has_conjunction of string
| Present_has_no_type of string
| Constructor_mismatch of type_expr * type_expr
List.iter2
(fun (sty, cty) ty' ->
try unify_param env ty' cty.ctyp_type with Unify trace ->
- let trace = Unification_trace.swap trace in
+ let trace = Errortrace.swap_trace trace in
raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
)
(List.combine stl args) params;
let constr =
newconstr path (List.map (fun ctyp -> ctyp.ctyp_type) args) in
- begin try
- Ctype.enforce_constraints env constr
- with Unify trace ->
- raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
- end;
ctyp (Ttyp_constr (path, lid, args)) constr
| Ptyp_object (fields, o) ->
let ty, fields = transl_fields env policy o fields in
List.iter2
(fun (sty, cty) ty' ->
try unify_var env ty' cty.ctyp_type with Unify trace ->
- let trace = Unification_trace.swap trace in
+ let trace = Errortrace.swap_trace trace in
raise (Error(sty.ptyp_loc, env, Type_mismatch trace))
)
(List.combine stl args) params;
in
let ty = transl_type env policy st in
begin try unify_var env t ty.ctyp_type with Unify trace ->
- let trace = Unification_trace.swap trace in
+ let trace = Errortrace.swap_trace trace in
raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
end;
ty
TyVarMap.add alias (t, styp.ptyp_loc) !used_variables;
let ty = transl_type env policy st in
begin try unify_var env t ty.ctyp_type with Unify trace ->
- let trace = Unification_trace.swap trace in
+ let trace = Errortrace.swap_trace trace in
raise(Error(styp.ptyp_loc, env, Alias_type_mismatch trace))
end;
if !Clflags.principal then begin
(* Check for tag conflicts *)
if l <> l' then raise(Error(styp.ptyp_loc, env, Variant_tags(l, l')));
let ty = mkfield l f and ty' = mkfield l f' in
- if equal env false [ty] [ty'] then () else
+ if is_equal env false [ty] [ty'] then () else
try unify env ty ty'
with Unify _trace ->
raise(Error(loc, env, Constructor_mismatch (ty,ty')))
if deep_occur v ty then begin
match v.desc with
Tvar name when v.level = Btype.generic_level ->
- v.desc <- Tunivar name;
+ Btype.set_type_desc v (Tunivar name);
v :: tyl
| _ ->
raise (Error (styp.ptyp_loc, env, Cannot_quantify (name, v)))
) l in
let path = !transl_modtype_longident styp.ptyp_loc env p.txt in
let ty = newty (Tpackage (path,
- List.map (fun (s, _pty) -> s.txt) l,
- List.map (fun (_,cty) -> cty.ctyp_type) ptys))
+ List.map (fun (s, cty) -> (s.txt, cty.ctyp_type)) ptys))
in
ctyp (Ttyp_package {
pack_path = path;
let add_typed_field loc l ty =
try
let ty' = Hashtbl.find hfields l in
- if equal env false [ty] [ty'] then () else
+ if is_equal env false [ty] [ty'] then () else
try unify env ty ty'
with Unify _trace ->
raise(Error(loc, env, Method_mismatch (l, ty, ty')))
(* Make the rows "fixed" in this type, to make universal check easier *)
let rec make_fixed_univars ty =
let ty = repr ty in
- if ty.level >= Btype.lowest_level then begin
- Btype.mark_type_node ty;
- match ty.desc with
+ if Btype.try_mark_node ty then
+ begin match ty.desc with
| Tvariant row ->
let row = Btype.row_repr row in
let more = Btype.row_more row in
if Btype.is_Tunivar more then
- ty.desc <- Tvariant
- {row with row_fixed=Some(Univar more);
- row_fields = List.map
+ Btype.set_type_desc ty
+ (Tvariant
+ {row with row_fixed=Some(Univar more);
+ row_fields = List.map
(fun (s,f as p) -> match Btype.row_field_repr f with
Reither (c, tl, _m, r) -> s, Reither (c, tl, true, r)
| _ -> p)
- row.row_fields};
+ row.row_fields});
Btype.iter_row make_fixed_univars row
| _ ->
Btype.iter_type_expr make_fixed_univars ty
- end
+ end
let make_fixed_univars ty =
make_fixed_univars ty;
let v = repr v in
match v.desc with
Tvar name when v.level = Btype.generic_level ->
- v.desc <- Tunivar name; v :: acc
+ Btype.set_type_desc v (Tunivar name); v :: acc
| _ -> acc)
[] !pre_univars
in
| Bound_type_variable of string
| Recursive_type
| Unbound_row_variable of Longident.t
- | Type_mismatch of Ctype.Unification_trace.t
- | Alias_type_mismatch of Ctype.Unification_trace.t
+ | Type_mismatch of Errortrace.unification Errortrace.t
+ | Alias_type_mismatch of Errortrace.unification Errortrace.t
| Present_has_conjunction of string
| Present_has_no_type of string
| Constructor_mismatch of type_expr * type_expr
| Tpat_constant cst -> Ppat_constant (constant cst)
| Tpat_tuple list ->
Ppat_tuple (List.map (sub.pat sub) list)
- | Tpat_construct (lid, _, args) ->
+ | Tpat_construct (lid, _, args, vto) ->
+ let tyo =
+ match vto with
+ None -> None
+ | Some (vl, ty) ->
+ let vl =
+ List.map (fun x -> {x with txt = Ident.name x.txt}) vl
+ in
+ Some (vl, sub.typ sub ty)
+ in
+ let arg =
+ match args with
+ [] -> None
+ | [arg] -> Some (sub.pat sub arg)
+ | args -> Some (Pat.tuple ~loc (List.map (sub.pat sub) args))
+ in
Ppat_construct (map_loc sub lid,
- (match args with
- [] -> None
- | [arg] -> Some (sub.pat sub arg)
- | args ->
- Some
- (Pat.tuple ~loc
- (List.map (sub.pat sub) args)
- )
- ))
+ match tyo, arg with
+ | Some (vl, ty), Some arg ->
+ Some (vl, Pat.mk ~loc (Ppat_constraint (arg, ty)))
+ | None, Some arg -> Some ([], arg)
+ | _, None -> None)
| Tpat_variant (label, pato, _) ->
Ppat_variant (label, Option.map (sub.pat sub) pato)
| Tpat_record (list, closed) ->
Psig_recmodule (List.map (sub.module_declaration sub) list)
| Tsig_modtype mtd ->
Psig_modtype (sub.module_type_declaration sub mtd)
+ | Tsig_modtypesubst mtd ->
+ Psig_modtypesubst (sub.module_type_declaration sub mtd)
| Tsig_open od ->
Psig_open (sub.open_description sub od)
| Tsig_include incl ->
| Unit -> Unit
| Named (_, name, mtype) -> Named (name, sub.module_type sub mtype)
-let module_type sub mty =
+let module_type (sub : mapper) mty =
let loc = sub.location sub mty.mty_loc in
let attrs = sub.attributes sub mty.mty_attributes in
let desc = match mty.mty_desc with
Pwith_type (map_loc sub lid, sub.type_declaration sub decl)
| Twith_module (_path, lid2) ->
Pwith_module (map_loc sub lid, map_loc sub lid2)
+ | Twith_modtype mty ->
+ let mty = sub.module_type sub mty in
+ Pwith_modtype (map_loc sub lid,mty)
| Twith_typesubst decl ->
Pwith_typesubst (map_loc sub lid, sub.type_declaration sub decl)
| Twith_modsubst (_path, lid2) ->
Pwith_modsubst (map_loc sub lid, map_loc sub lid2)
+ | Twith_modtypesubst mty ->
+ let mty = sub.module_type sub mty in
+ Pwith_modtypesubst (map_loc sub lid, mty)
-let module_expr sub mexpr =
+let module_expr (sub : mapper) mexpr =
let loc = sub.location sub mexpr.mod_loc in
let attrs = sub.attributes sub mexpr.mod_attributes in
match mexpr.mod_desc with
object_field = object_field ;
}
-let untype_structure ?(mapper=default_mapper) structure =
+let untype_structure ?(mapper : mapper = default_mapper) structure =
mapper.structure mapper structure
-let untype_signature ?(mapper=default_mapper) signature =
+let untype_signature ?(mapper : mapper = default_mapper) signature =
mapper.signature mapper signature
let untype_expression ?(mapper=default_mapper) expression =
tools to test the new release, and if you update *after* that you risk
breaking them again without them noticing.
-For example, the magic numbers for 4.10 were updated in
- 6423e5c9d11cfac1c07208aec9f761f37c1640f0
+For example, the magic numbers for 4.13 were updated in
+ dd7927e156b7cb2f9
include $(ROOTDIR)/Makefile.common
-ifeq "$(UNIX_OR_WIN32)" "win32"
-ifeq "$(wildcard $(ROOTDIR)/flexdll/Makefile)" ""
+ifeq "$(BOOTSTRAPPING_FLEXDLL)" "false"
FLEXDLL_DIR =
else
- FLEXDLL_DIR = $(if $(wildcard $(ROOTDIR)/flexdll/flexdll_*.$(O)),+flexdll)
-endif
-else
- FLEXDLL_DIR =
+ FLEXDLL_DIR = +flexdll
endif
FLEXLINK_FLAGS ?=
$(call SUBST_STRING,EXT_OBJ) \
$(call SUBST,FLAMBDA) \
$(call SUBST,WITH_FLAMBDA_INVARIANTS) \
+ $(call SUBST,WITH_CMM_INVARIANTS) \
$(call SUBST_STRING,FLEXLINK_FLAGS) \
$(call SUBST_QUOTE,FLEXDLL_DIR) \
$(call SUBST,HOST) \
+ $(call SUBST_STRING,BINDIR) \
$(call SUBST_STRING,LIBDIR) \
$(call SUBST_STRING,MKDLL) \
$(call SUBST_STRING,MKEXE) \
$(call SUBST_STRING,PACKLD) \
$(call SUBST,PROFINFO_WIDTH) \
$(call SUBST_STRING,RANLIBCMD) \
+ $(call SUBST_STRING,RPATH) \
+ $(call SUBST_STRING,MKSHAREDLIBRPATH) \
$(call SUBST,FORCE_SAFE_STRING) \
$(call SUBST,DEFAULT_SAFE_STRING) \
$(call SUBST,WINDOWS_UNICODE) \
let max_pos =
match max_len with
| None -> Bytes.length buf
- | Some n -> min (Bytes.length buf) (start + n)
+ | Some n -> Int.min (Bytes.length buf) (start + n)
in
let rec loop pos =
if pos >= max_pos || Bytes.get buf pos = '\000'
e_lfanew: int64;
number_of_sections: int;
size_of_optional_header: int;
- characteristics: int;
+ _characteristics: int;
}
let read_header e_lfanew d buf =
let number_of_sections = get_uint16 d buf 6 in
let size_of_optional_header = get_uint16 d buf 20 in
- let characteristics = get_uint16 d buf 22 in
- {e_lfanew; number_of_sections; size_of_optional_header; characteristics}
+ let _characteristics = get_uint16 d buf 22 in
+ {e_lfanew; number_of_sections; size_of_optional_header; _characteristics}
type optional_header_magic =
| PE32
type optional_header =
{
- magic: optional_header_magic;
+ _magic: optional_header_magic;
image_base: int64;
}
load_bytes d Int64.(add e_lfanew (of_int header_size))
size_of_optional_header
in
- let magic =
+ let _magic, image_base =
match get_uint16 d buf 0 with
- | 0x10b -> PE32
- | 0x20b -> PE32PLUS
+ | 0x10b -> PE32, uint64_of_uint32 (get_uint32 d buf 28)
+ | 0x20b -> PE32PLUS, get_uint64 d buf 24
| n ->
raise (Error (Unsupported ("optional_header_magic", Int64.of_int n)))
in
- let image_base =
- match magic with
- | PE32 -> uint64_of_uint32 (get_uint32 d buf 28)
- | PE32PLUS -> get_uint64 d buf 24
- in
- {magic; image_base}
+ {_magic; image_base}
type section =
{
name: string;
- virtual_size: int;
+ _virtual_size: int;
virtual_address: int64;
size_of_raw_data: int;
pointer_to_raw_data: int64;
let mk i =
let base = i * section_header_size in
let name = name_at ~max_len:8 buf (base + 0) in
- let virtual_size = get_uint "virtual_size" d buf (base + 8) in
+ let _virtual_size = get_uint "virtual_size" d buf (base + 8) in
let virtual_address = uint64_of_uint32 (get_uint32 d buf (base + 12)) in
let size_of_raw_data = get_uint "size_of_raw_data" d buf (base + 16) in
let pointer_to_raw_data =
uint64_of_uint32 (get_uint32 d buf (base + 20)) in
- {name; virtual_size; virtual_address;
+ {name; _virtual_size; virtual_address;
size_of_raw_data; pointer_to_raw_data}
in
Array.init number_of_sections mk
then r1
else command(Config.ranlib ^ " " ^ quoted_archive)
-let expand_libname name =
- if String.length name < 2 || String.sub name 0 2 <> "-l"
- then name
- else begin
- let libname =
- "lib" ^ String.sub name 2 (String.length name - 2) ^ Config.ext_lib in
- try
- Load_path.find libname
- with Not_found ->
- libname
- end
+let expand_libname cclibs =
+ cclibs |> List.map (fun cclib ->
+ if String.starts_with ~prefix:"-l" cclib then
+ let libname =
+ "lib" ^ String.sub cclib 2 (String.length cclib - 2) ^ Config.ext_lib in
+ try
+ Load_path.find libname
+ with Not_found ->
+ libname
+ else cclib)
type link_mode =
| Exe
Profile.record_call "c-linker" (fun () ->
let cmd =
if mode = Partial then
- let l_prefix =
+ let (l_prefix, files) =
match Config.ccomp_type with
- | "msvc" -> "/libpath:"
- | _ -> "-L"
+ | "msvc" -> ("/libpath:", expand_libname files)
+ | _ -> ("-L", files)
in
Printf.sprintf "%s%s %s %s %s"
Config.native_pack_linker
val compile_file:
?output:string -> ?opt:string -> ?stable_name:string -> string -> int
val create_archive: string -> string list -> int
-val expand_libname: string -> string
val quote_files: string list -> string
val quote_optfile: string option -> string
(*val make_link_options: string list -> string*)
let dump_selection = ref false (* -dsel *)
let dump_cse = ref false (* -dcse *)
let dump_live = ref false (* -dlive *)
-let dump_avail = ref false (* -davail *)
let dump_spill = ref false (* -dspill *)
let dump_split = ref false (* -dsplit *)
let dump_interf = ref false (* -dinterf *)
let dump_combine = ref false (* -dcombine *)
let profile_columns : Profile.column list ref = ref [] (* -dprofile/-dtimings *)
-let debug_runavail = ref false (* -drunavail *)
-
let native_code = ref false (* set to true under ocamlopt *)
let force_slash = ref false (* for ocamldep *)
let clambda_checks = ref false (* -clambda-checks *)
+let cmm_invariants =
+ ref Config.with_cmm_invariants (* -dcmm-invariants *)
let flambda_invariant_checks =
ref Config.with_flambda_invariants (* -flambda-(no-)invariants *)
(* If you add a new pass, the following must be updated:
- the variable `passes` below
- the manpages in man/ocaml{c,opt}.m
- - the manual manual/manual/cmds/unified-options.etex
+ - the manual manual/src/cmds/unified-options.etex
*)
type t = Parsing | Typing | Scheduling | Emit
arg_names := String.Map.add arg_name loc !arg_names
) args
-let print_arguments usage =
- Arg.usage !arg_spec usage
-
-(* This function is almost the same as [Arg.parse_expand], except
- that [Arg.parse_expand] could not be used because it does not take a
- reference for [arg_spec].*)
-let parse_arguments argv f msg =
- try
- let argv = ref argv in
- let current = ref 0 in
- Arg.parse_and_expand_argv_dynamic current argv arg_spec f msg
- with
- | Arg.Bad msg -> Printf.eprintf "%s" msg; exit 2
- | Arg.Help msg -> Printf.printf "%s" msg; exit 0
+let create_usage_msg program =
+ Printf.sprintf "Usage: %s <options> <files>\n\
+ Try '%s --help' for more information." program program
+
+
+let print_arguments program =
+ Arg.usage !arg_spec (create_usage_msg program)
(* *)
(**************************************************************************)
+
+
(** Command line flags *)
(** Optimization parameters represented as ints indexed by round number. *)
val dump_selection : bool ref
val dump_cse : bool ref
val dump_live : bool ref
-val dump_avail : bool ref
-val debug_runavail : bool ref
val dump_spill : bool ref
val dump_split : bool ref
val dump_interf : bool ref
val unbox_free_vars_of_closures : bool ref
val unbox_specialised_args : bool ref
val clambda_checks : bool ref
+val cmm_invariants : bool ref
val default_inline_max_depth : int
val inline_max_depth : Int_arg_helper.parsed ref
val remove_unused_arguments : bool ref
added. *)
val add_arguments : string -> (string * Arg.spec * string) list -> unit
-(* [parse_arguments argv anon_arg usage] will parse the arguments, using
- the arguments provided in [Clflags.arg_spec].
-*)
-val parse_arguments : string array -> Arg.anon_fun -> string -> unit
-
+(* [create_usage_msg program] creates a usage message for [program] *)
+val create_usage_msg: string -> string
(* [print_arguments usage] print the standard usage message *)
val print_arguments : string -> unit
val version: string
(** The current version number of the system *)
+val bindir: string
+(** The directory containing the binary programs *)
+
val standard_library: string
(** The directory containing the standard libraries *)
val ranlib: string
(** Command to randomize a library, or "" if not needed *)
+val default_rpath: string
+(** Option to add a directory to be searched for libraries at runtime
+ (used by ocamlmklib) *)
+
+val mksharedlibrpath: string
+(** Option to add a directory to be searched for shared libraries at runtime
+ (used by ocamlmklib) *)
+
val ar: string
(** Name of the ar command, or "" if not needed (MSVC) *)
val with_flambda_invariants : bool
(** Whether the invariants checks for flambda are enabled *)
+val with_cmm_invariants : bool
+(** Whether the invariants checks for Cmm are enabled *)
+
val profinfo : bool
(** Whether the compiler was configured for profiling *)
(* The main OCaml version string has moved to ../VERSION *)
let version = Sys.ocaml_version
+let bindir = "%%BINDIR%%"
+
let standard_library_default = "%%LIBDIR%%"
let standard_library =
let native_c_libraries = "%%NATIVECCLIBS%%"
let native_pack_linker = "%%PACKLD%%"
let ranlib = "%%RANLIBCMD%%"
+let default_rpath = "%%RPATH%%"
+let mksharedlibrpath = "%%MKSHAREDLIBRPATH%%"
let ar = "%%ARCMD%%"
+let supports_shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%%
let mkdll, mkexe, mkmaindll =
(* @@DRA Cygwin - but only if shared libraries are enabled, which we
should be able to detect? *)
- if Sys.os_type = "Win32" then
+ if Sys.win32 || Sys.cygwin && supports_shared_libraries then
try
let flexlink =
let flexlink = Sys.getenv "OCAML_FLEXLINK" in
let f i =
let c = flexlink.[i] in
- if c = '/' then '\\' else c in
+ if c = '/' && Sys.win32 then '\\' else c in
(String.init (String.length flexlink) f) ^ " %%FLEXLINK_FLAGS%%" in
flexlink ^ "%%FLEXLINK_DLL_LDFLAGS%%",
flexlink ^ " -exe%%FLEXLINK_LDFLAGS%%",
let flambda = %%FLAMBDA%%
let with_flambda_invariants = %%WITH_FLAMBDA_INVARIANTS%%
+let with_cmm_invariants = %%WITH_CMM_INVARIANTS%%
let safe_string = %%FORCE_SAFE_STRING%%
let default_safe_string = %%DEFAULT_SAFE_STRING%%
let windows_unicode = %%WINDOWS_UNICODE%% != 0
-let supports_shared_libraries = %%SUPPORTS_SHARED_LIBRARIES%%
let flat_float_array = %%FLAT_FLOAT_ARRAY%%
let function_sections = %%FUNCTION_SECTIONS%%
let afl_instrument = %%AFL_INSTRUMENT%%
-let exec_magic_number = "Caml1999X029"
+let exec_magic_number = "Caml1999X030"
(* exec_magic_number is duplicated in runtime/caml/exec.h *)
-and cmi_magic_number = "Caml1999I029"
-and cmo_magic_number = "Caml1999O029"
-and cma_magic_number = "Caml1999A029"
+and cmi_magic_number = "Caml1999I030"
+and cmo_magic_number = "Caml1999O030"
+and cma_magic_number = "Caml1999A030"
and cmx_magic_number =
if flambda then
- "Caml1999y029"
+ "Caml1999y030"
else
- "Caml1999Y029"
+ "Caml1999Y030"
and cmxa_magic_number =
if flambda then
- "Caml1999z029"
+ "Caml1999z030"
else
- "Caml1999Z029"
-and ast_impl_magic_number = "Caml1999M029"
-and ast_intf_magic_number = "Caml1999N029"
-and cmxs_magic_number = "Caml1999D029"
-and cmt_magic_number = "Caml1999T029"
-and linear_magic_number = "Caml1999L029"
+ "Caml1999Z030"
+and ast_impl_magic_number = "Caml1999M030"
+and ast_intf_magic_number = "Caml1999N030"
+and cmxs_magic_number = "Caml1999D030"
+and cmt_magic_number = "Caml1999T030"
+and linear_magic_number = "Caml1999L030"
let interface_suffix = ref ".mli"
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Radanne, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+[@@@warning "-16"]
+
+(* This module implements a modified version of Wagner-Fischer
+ See <https://en.wikipedia.org/wiki/Wagner%E2%80%93Fischer_algorithm>
+ for preliminary reading.
+
+ The main extensions is that:
+ - State is computed based on the optimal patch so far.
+ - The lists can be extended at each state computation.
+
+ We add the constraint that extensions can only be in one side
+ (either the left or right list). This is enforced by the external API.
+
+*)
+
+let (let*) = Option.bind
+let (let+) x f = Option.map f x
+let (let*!) x f = Option.iter f x
+
+type ('left, 'right, 'eq, 'diff) change =
+ | Delete of 'left
+ | Insert of 'right
+ | Keep of 'left * 'right * 'eq
+ | Change of 'left * 'right * 'diff
+
+type ('l, 'r, 'eq, 'diff) patch = ('l, 'r, 'eq, 'diff) change list
+
+let map f g = function
+ | Delete x -> Delete (f x)
+ | Insert x -> Insert (g x)
+ | Keep (x,y,k) -> Keep (f x, g y, k)
+ | Change (x,y,k) -> Change (f x, g y, k)
+
+type ('st,'left,'right) full_state = {
+ line: 'left array;
+ column: 'right array;
+ state: 'st
+}
+
+(* The matrix supporting our dynamic programming implementation.
+
+ Each cell contains:
+ - The diff and its weight
+ - The state computed so far
+ - The lists, potentially extended locally.
+
+ The matrix can also be reshaped.
+*)
+module Matrix : sig
+
+ type shape = { l : int ; c : int }
+
+ type ('state,'left,'right,'eq,'diff) t
+
+ val make : shape -> ('st,'l,'r,'e,'d) t
+ val reshape : shape -> ('st,'l,'r,'e,'d) t -> ('st,'l,'r,'e,'d) t
+
+ (** accessor functions *)
+ val diff : (_,'l,'r,'e,'d) t -> int -> int -> ('l,'r,'e,'d) change option
+ val state :
+ ('st,'l,'r,'e,'d) t -> int -> int -> ('st, 'l, 'r) full_state option
+ val weight : _ t -> int -> int -> int
+
+ val line : (_,'l,_,_,_) t -> int -> int -> 'l option
+ val column : (_,_,'r,_,_) t -> int -> int -> 'r option
+
+ val set :
+ ('st,'l,'r,'e,'d) t -> int -> int ->
+ diff:('l,'r,'e,'d) change option ->
+ weight:int ->
+ state:('st, 'l, 'r) full_state ->
+ unit
+
+ (** the shape when starting filling the matrix *)
+ val shape : _ t -> shape
+
+ (** [shape m i j] is the shape as seen from the state at position (i,j)
+ after some possible extensions
+ *)
+ val shape_at : _ t -> int -> int -> shape option
+
+ (** the maximal shape on the whole matrix *)
+ val real_shape : _ t -> shape
+
+ (** debugging printer *)
+ val[@warning "-32"] pp : Format.formatter -> _ t -> unit
+
+end = struct
+
+ type shape = { l : int ; c : int }
+
+ type ('state,'left,'right,'eq,'diff) t =
+ { states: ('state,'left,'right) full_state option array array;
+ weight: int array array;
+ diff: ('left,'right,'eq,'diff) change option array array;
+ columns: int;
+ lines: int;
+ }
+ let opt_get a n =
+ if n < Array.length a then Some (Array.unsafe_get a n) else None
+ let line m i j = let* st = m.states.(i).(j) in opt_get st.line i
+ let column m i j = let* st = m.states.(i).(j) in opt_get st.column j
+ let diff m i j = m.diff.(i).(j)
+ let weight m i j = m.weight.(i).(j)
+ let state m i j = m.states.(i).(j)
+ let shape m = { l = m.lines ; c = m.columns }
+
+ let set m i j ~diff ~weight ~state =
+ m.weight.(i).(j) <- weight;
+ m.states.(i).(j) <- Some state;
+ m.diff.(i).(j) <- diff;
+ ()
+
+ let shape_at tbl i j =
+ let+ st = tbl.states.(i).(j) in
+ let l = Array.length st.line in
+ let c = Array.length st.column in
+ { l ; c }
+
+ let real_shape tbl =
+ let lines = ref tbl.lines in
+ let columns = ref tbl.columns in
+ for i = 0 to tbl.lines do
+ for j = 0 to tbl.columns do
+ let*! {l; c} = shape_at tbl i j in
+ if l > !lines then lines := l;
+ if c > !columns then columns := c
+ done;
+ done;
+ { l = !lines ; c = !columns }
+
+ let make { l = lines ; c = columns } =
+ { states = Array.make_matrix (lines + 1) (columns + 1) None;
+ weight = Array.make_matrix (lines + 1) (columns + 1) max_int;
+ diff = Array.make_matrix (lines + 1) (columns + 1) None;
+ lines;
+ columns;
+ }
+
+ let reshape { l = lines ; c = columns } m =
+ let copy default a =
+ Array.init (1+lines) (fun i -> Array.init (1+columns) (fun j ->
+ if i <= m.lines && j <= m.columns then
+ a.(i).(j)
+ else default) ) in
+ { states = copy None m.states;
+ weight = copy max_int m.weight;
+ diff = copy None m.diff;
+ lines;
+ columns
+ }
+
+ let pp ppf m =
+ let { l ; c } = shape m in
+ Format.eprintf "Shape : %i, %i@." l c;
+ for i = 0 to l do
+ for j = 0 to c do
+ let d = diff m i j in
+ match d with
+ | None ->
+ Format.fprintf ppf " "
+ | Some diff ->
+ let sdiff = match diff with
+ | Insert _ -> "\u{2190}"
+ | Delete _ -> "\u{2191}"
+ | Keep _ -> "\u{2196}"
+ | Change _ -> "\u{21F1}"
+ in
+ let w = weight m i j in
+ Format.fprintf ppf "%s%i " sdiff w
+ done;
+ Format.pp_print_newline ppf ()
+ done
+
+end
+
+(* Computation of new cells *)
+
+let select_best_proposition l =
+ let compare_proposition curr prop =
+ match curr, prop with
+ | None, o | o, None -> o
+ | Some (curr_m, curr_res), Some (m, res) ->
+ Some (if curr_m <= m then curr_m, curr_res else m,res)
+ in
+ List.fold_left compare_proposition None l
+
+(* Boundary cell update *)
+let compute_column0 ~weight ~update tbl i =
+ let*! st = Matrix.state tbl (i-1) 0 in
+ let*! line = Matrix.line tbl (i-1) 0 in
+ let diff = Delete line in
+ Matrix.set tbl i 0
+ ~weight:(weight diff + Matrix.weight tbl (i-1) 0)
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+let compute_line0 ~weight ~update tbl j =
+ let*! st = Matrix.state tbl 0 (j-1) in
+ let*! column = Matrix.column tbl 0 (j-1) in
+ let diff = Insert column in
+ Matrix.set tbl 0 j
+ ~weight:(weight diff + Matrix.weight tbl 0 (j-1))
+ ~state:(update diff st)
+ ~diff:(Some diff)
+
+let compute_inner_cell ~weight ~test ~update tbl i j =
+ let compute_proposition i j diff =
+ let* diff = diff in
+ let+ localstate = Matrix.state tbl i j in
+ weight diff + Matrix.weight tbl i j, (diff, localstate)
+ in
+ let del =
+ let diff = let+ x = Matrix.line tbl (i-1) j in Delete x in
+ compute_proposition (i-1) j diff
+ in
+ let insert =
+ let diff = let+ x = Matrix.column tbl i (j-1) in Insert x in
+ compute_proposition i (j-1) diff
+ in
+ let diag =
+ let diff =
+ let* state = Matrix.state tbl (i-1) (j-1) in
+ let* line = Matrix.line tbl (i-1) (j-1) in
+ let* column = Matrix.column tbl (i-1) (j-1) in
+ match test state.state line column with
+ | Ok ok -> Some (Keep (line, column, ok))
+ | Error err -> Some (Change (line, column, err))
+ in
+ compute_proposition (i-1) (j-1) diff
+ in
+ let*! newweight, (diff, localstate) =
+ select_best_proposition [diag;del;insert]
+ in
+ let state = update diff localstate in
+ Matrix.set tbl i j ~weight:newweight ~state ~diff:(Some diff)
+
+let compute_cell ~weight ~test ~update m i j =
+ match i, j with
+ | _ when Matrix.diff m i j <> None -> ()
+ | 0,0 -> ()
+ | 0,j -> compute_line0 ~update ~weight m j
+ | i,0 -> compute_column0 ~update ~weight m i;
+ | _ -> compute_inner_cell ~weight ~test ~update m i j
+
+(* Filling the matrix
+
+ We fill the whole matrix, as in vanilla Wagner-Fischer.
+ At this point, the lists in some states might have been extended.
+ If any list have been extended, we need to reshape the matrix
+ and repeat the process
+*)
+let compute_matrix ~weight ~test ~update state0 =
+ let m0 = Matrix.make { l = 0 ; c = 0 } in
+ Matrix.set m0 0 0 ~weight:0 ~state:state0 ~diff:None;
+ let rec loop m =
+ let shape = Matrix.shape m in
+ let new_shape = Matrix.real_shape m in
+ if new_shape.l > shape.l || new_shape.c > shape.c then
+ let m = Matrix.reshape new_shape m in
+ for i = 0 to new_shape.l do
+ for j = 0 to new_shape.c do
+ compute_cell ~update ~test ~weight m i j
+ done
+ done;
+ loop m
+ else
+ m
+ in
+ loop m0
+
+(* Building the patch.
+
+ We first select the best final cell. A potential final cell
+ is a cell where the local shape (i.e., the size of the strings) correspond
+ to its position in the matrix. In other words: it's at the end of both its
+ strings. We select the final cell with the smallest weight.
+
+ We then build the patch by walking backward from the final cell to the
+ origin.
+*)
+
+let select_final_state m0 =
+ let maybe_final i j =
+ match Matrix.shape_at m0 i j with
+ | Some shape_here -> shape_here.l = i && shape_here.c = j
+ | None -> false
+ in
+ let best_state (i0,j0,weigth0) (i,j) =
+ let weight = Matrix.weight m0 i j in
+ if weight < weigth0 then (i,j,weight) else (i0,j0,weigth0)
+ in
+ let res = ref (0,0,max_int) in
+ let shape = Matrix.shape m0 in
+ for i = 0 to shape.l do
+ for j = 0 to shape.c do
+ if maybe_final i j then
+ res := best_state !res (i,j)
+ done
+ done;
+ let i_final, j_final, _ = !res in
+ assert (i_final <> 0 || j_final <> 0);
+ (i_final, j_final)
+
+let construct_patch m0 =
+ let rec aux acc (i, j) =
+ if i = 0 && j = 0 then
+ acc
+ else
+ match Matrix.diff m0 i j with
+ | None -> assert false
+ | Some d ->
+ let next = match d with
+ | Keep _ | Change _ -> (i-1, j-1)
+ | Delete _ -> (i-1, j)
+ | Insert _ -> (i, j-1)
+ in
+ aux (d::acc) next
+ in
+ aux [] (select_final_state m0)
+
+let diff ~weight ~test ~update state line column =
+ let update d fs = { fs with state = update d fs.state } in
+ let fullstate = { line; column; state } in
+ compute_matrix ~weight ~test ~update fullstate
+ |> construct_patch
+
+type ('l, 'r, 'e, 'd, 'state) update =
+ | Without_extensions of (('l,'r,'e,'d) change -> 'state -> 'state)
+ | With_left_extensions of
+ (('l,'r,'e,'d) change -> 'state -> 'state * 'l array)
+ | With_right_extensions of
+ (('l,'r,'e,'d) change -> 'state -> 'state * 'r array)
+
+let variadic_diff ~weight ~test ~(update:_ update) state line column =
+ let may_append x = function
+ | [||] -> x
+ | y -> Array.append x y in
+ let update = match update with
+ | Without_extensions up ->
+ fun d fs ->
+ let state = up d fs.state in
+ { fs with state }
+ | With_left_extensions up ->
+ fun d fs ->
+ let state, a = up d fs.state in
+ { fs with state ; line = may_append fs.line a }
+ | With_right_extensions up ->
+ fun d fs ->
+ let state, a = up d fs.state in
+ { fs with state ; column = may_append fs.column a }
+ in
+ let fullstate = { line; column; state } in
+ compute_matrix ~weight ~test ~update fullstate
+ |> construct_patch
--- /dev/null
+
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Gabriel Radanne, projet Cambium, Inria Paris *)
+(* *)
+(* Copyright 2020 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+(** {0 Parametric diffing}
+
+ This module implements diffing over lists of arbitrary content.
+ It is parameterized by
+ - The content of the two lists
+ - The equality witness when an element is kept
+ - The diffing witness when an element is changed
+
+ Diffing is extended to maintain state depending on the
+ computed changes while walking through the two lists.
+
+ The underlying algorithm is a modified Wagner-Fischer algorithm
+ (see <https://en.wikipedia.org/wiki/Wagner%E2%80%93Fischer_algorithm>).
+
+ We provide the following guarantee:
+ Given two lists [l] and [r], if different patches result in different
+ states, we say that the state diverges.
+ - We always return the optimal patch on prefixes of [l] and [r]
+ on which state does not diverge.
+ - Otherwise, we return a correct but non-optimal patch where subpatches
+ with no divergent states are optimal for the given initial state.
+
+ More precisely, the optimality of Wagner-Fischer depends on the property
+ that the edit-distance between a k-prefix of the left input and a l-prefix
+ of the right input d(k,l) satisfies
+
+ d(k,l) = min (
+ del_cost + d(k-1,l),
+ insert_cost + d(k,l-1),
+ change_cost + d(k-1,l-1)
+ )
+
+ Under this hypothesis, it is optimal to choose greedily the state of the
+ minimal patch transforming the left k-prefix into the right l-prefix as a
+ representative of the states of all possible patches transforming the left
+ k-prefix into the right l-prefix.
+
+ If this property is not satisfied, we can still choose greedily a
+ representative state. However, the computed patch is no more guaranteed to
+ be globally optimal.
+ Nevertheless, it is still a correct patch, which is even optimal among all
+ explored patches.
+
+*)
+
+(** The type of potential changes on a list. *)
+type ('left, 'right, 'eq, 'diff) change =
+ | Delete of 'left
+ | Insert of 'right
+ | Keep of 'left * 'right * 'eq
+ | Change of 'left * 'right * 'diff
+
+val map :
+ ('l1 -> 'l2) -> ('r1 -> 'r2) ->
+ ('l1, 'r1, 'eq, 'diff) change ->
+ ('l2, 'r2, 'eq, 'diff) change
+
+(** A patch is an ordered list of changes. *)
+type ('l, 'r, 'eq, 'diff) patch = ('l, 'r, 'eq, 'diff) change list
+
+(** [diff ~weight ~test ~update state l r] computes
+ the diff between [l] and [r], using the initial state [state].
+ - [test st xl xr] tests if the elements [xl] and [xr] are
+ compatible ([Ok]) or not ([Error]).
+ - [weight ch] returns the weight of the change [ch].
+ Used to find the smallest patch.
+ - [update ch st] returns the new state after applying a change.
+*)
+val diff :
+ weight:(('l, 'r, 'eq, 'diff) change -> int) ->
+ test:('state -> 'l -> 'r -> ('eq, 'diff) result) ->
+ update:(('l, 'r, 'eq, 'diff) change -> 'state -> 'state) ->
+ 'state -> 'l array -> 'r array -> ('l, 'r, 'eq, 'diff) patch
+
+(** {1 Variadic diffing}
+
+ Variadic diffing allows to expand the lists being diffed during diffing.
+*)
+
+type ('l, 'r, 'e, 'd, 'state) update =
+ | Without_extensions of (('l,'r,'e,'d) change -> 'state -> 'state)
+ | With_left_extensions of
+ (('l,'r,'e,'d) change -> 'state -> 'state * 'l array)
+ | With_right_extensions of
+ (('l,'r,'e,'d) change -> 'state -> 'state * 'r array)
+
+(** [variadic_diff ~weight ~test ~update state l r] behaves as [diff]
+ with the following difference:
+ - [update] must now be an {!update} which indicates in which direction
+ the expansion takes place.
+*)
+val variadic_diff :
+ weight:(('l, 'r, 'eq, 'diff) change -> int) ->
+ test:('state -> 'l -> 'r -> ('eq, 'diff) result) ->
+ update:('l, 'r, 'eq, 'diff, 'state) update ->
+ 'state -> 'l array -> 'r array -> ('l, 'r, 'eq, 'diff) patch
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type ('a,'b) t = ('a,'b) eval ref
+
+and ('a,'b) eval =
+ | Done of 'b
+ | Raise of exn
+ | Thunk of 'a
+
+type undo =
+ | Nil
+ | Cons : ('a, 'b) t * 'a * undo -> undo
+
+type log = undo ref
+
+let force f x =
+ match !x with
+ | Done x -> x
+ | Raise e -> raise e
+ | Thunk e ->
+ match f e with
+ | y ->
+ x := Done y;
+ y
+ | exception e ->
+ x := Raise e;
+ raise e
+
+let get_arg x =
+ match !x with Thunk a -> Some a | _ -> None
+
+let create x =
+ ref (Thunk x)
+
+let create_forced y =
+ ref (Done y)
+
+let create_failed e =
+ ref (Raise e)
+
+let log () =
+ ref Nil
+
+let force_logged log f x =
+ match !x with
+ | Done x -> x
+ | Raise e -> raise e
+ | Thunk e ->
+ match f e with
+ | (Error _ as err : _ result) ->
+ x := Done err;
+ log := Cons(x, e, !log);
+ err
+ | Ok _ as res ->
+ x := Done res;
+ res
+ | exception e ->
+ x := Raise e;
+ raise e
+
+let backtrack log =
+ let rec loop = function
+ | Nil -> ()
+ | Cons(x, e, rest) ->
+ x := Thunk e;
+ loop rest
+ in
+ loop !log
--- /dev/null
+(**************************************************************************)
+(* *)
+(* OCaml *)
+(* *)
+(* Fabrice Le Fessant, INRIA Saclay *)
+(* *)
+(* Copyright 2012 Institut National de Recherche en Informatique et *)
+(* en Automatique. *)
+(* *)
+(* All rights reserved. This file is distributed under the terms of *)
+(* the GNU Lesser General Public License version 2.1, with the *)
+(* special exception on linking described in the file LICENSE. *)
+(* *)
+(**************************************************************************)
+
+type ('a,'b) t
+
+type log
+
+val force : ('a -> 'b) -> ('a,'b) t -> 'b
+val create : 'a -> ('a,'b) t
+val get_arg : ('a,'b) t -> 'a option
+val create_forced : 'b -> ('a, 'b) t
+val create_failed : exn -> ('a, 'b) t
+
+(* [force_logged log f t] is equivalent to [force f t] but if [f]
+ returns [Error _] then [t] is recorded in [log]. [backtrack log]
+ will then reset all the recorded [t]s back to their original
+ state. *)
+val log : unit -> log
+val force_logged :
+ log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result
+val backtrack : log -> unit
open Local_store
-module SMap = Misc.Stdlib.String.Map
+module STbl = Misc.Stdlib.String.Tbl
(* Mapping from basenames to full filenames *)
-type registry = string SMap.t ref
+type registry = string STbl.t
-let files : registry = s_ref SMap.empty
-let files_uncap : registry = s_ref SMap.empty
+let files : registry ref = s_table STbl.create 42
+let files_uncap : registry ref = s_table STbl.create 42
module Dir = struct
type t = {
let reset () =
assert (not Config.merlin || Local_store.is_bound ());
- files := SMap.empty;
- files_uncap := SMap.empty;
+ STbl.clear !files;
+ STbl.clear !files_uncap;
dirs := []
let get () = List.rev !dirs
let get_paths () = List.rev_map Dir.path !dirs
-let add_to_maps fn basenames files files_uncap =
- List.fold_left (fun (files, files_uncap) base ->
- let fn = fn base in
- SMap.add base fn files,
- SMap.add (String.uncapitalize_ascii base) fn files_uncap
- ) (files, files_uncap) basenames
-
(* Optimized version of [add] below, for use in [init] and [remove_dir]: since
we are starting from an empty cache, we can avoid checking whether a unit
name already exists in the cache simply by adding entries in reverse
order. *)
let prepend_add dir =
- assert (not Config.merlin || Local_store.is_bound ());
- let new_files, new_files_uncap =
- add_to_maps (Filename.concat dir.Dir.path)
- dir.Dir.files !files !files_uncap
- in
- files := new_files;
- files_uncap := new_files_uncap
+ List.iter (fun base ->
+ let fn = Filename.concat dir.Dir.path base in
+ STbl.replace !files base fn;
+ STbl.replace !files_uncap (String.uncapitalize_ascii base) fn
+ ) dir.Dir.files
let init l =
reset ();
order to enforce left-to-right precedence. *)
let add dir =
assert (not Config.merlin || Local_store.is_bound ());
- let new_files, new_files_uncap =
- add_to_maps (Filename.concat dir.Dir.path) dir.Dir.files
- SMap.empty SMap.empty
- in
- let first _ fn _ = Some fn in
- files := SMap.union first !files new_files;
- files_uncap := SMap.union first !files_uncap new_files_uncap;
+ List.iter
+ (fun base ->
+ let fn = Filename.concat dir.Dir.path base in
+ if not (STbl.mem !files base) then
+ STbl.replace !files base fn;
+ let ubase = String.uncapitalize_ascii base in
+ if not (STbl.mem !files_uncap ubase) then
+ STbl.replace !files_uncap ubase fn)
+ dir.Dir.files;
dirs := dir :: !dirs
let append_dir = add
let find fn =
assert (not Config.merlin || Local_store.is_bound ());
- if is_basename fn then
- SMap.find fn !files
+ if is_basename fn && not !Sys.interactive then
+ STbl.find !files fn
else
Misc.find_in_path (get_paths ()) fn
let find_uncap fn =
assert (not Config.merlin || Local_store.is_bound ());
- if is_basename fn then
- SMap.find (String.uncapitalize_ascii fn) !files_uncap
+ if is_basename fn && not !Sys.interactive then
+ STbl.find !files_uncap (String.uncapitalize_ascii fn)
else
Misc.find_in_path_uncap (get_paths ()) fn
let buff = Bytes.create 0x1000 in
let rec copy n =
if n <= 0 then () else begin
- let r = input ic buff 0 (min n 0x1000) in
+ let r = input ic buff 0 (Int.min n 0x1000) in
if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
end
in copy len
let input_bytes_into tbl ic len =
let count = ref len in
Array.iter (fun str ->
- let chunk = min !count (Bytes.length str) in
+ let chunk = Int.min !count (Bytes.length str) in
really_input ic str 0 chunk;
count := !count - chunk) tbl
let cutoff =
(* using max_int for cutoff would cause overflows in (i + cutoff + 1);
we bring it back to the (max la lb) worstcase *)
- min (max la lb) cutoff in
+ Int.min (Int.max la lb) cutoff in
if abs (la - lb) > cutoff then None
else begin
(* initialize with 'cutoff + 1' so that not-yet-written-to cases have
m.(0).(j) <- j;
done;
for i = 1 to la do
- for j = max 1 (i - cutoff - 1) to min lb (i + cutoff + 1) do
+ for j = Int.max 1 (i - cutoff - 1) to Int.min lb (i + cutoff + 1) do
let cost = if a.[i-1] = b.[j-1] then 0 else 1 in
let best =
(* insert, delete or substitute *)
- min (1 + min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost)
+ Int.min (1 + Int.min m.(i-1).(j) m.(i).(j-1)) (m.(i-1).(j-1) + cost)
in
let best =
(* swap two adjacent letters; we use "cost" again in case of
imitation has its virtues *)
if not (i > 1 && j > 1 && a.[i-1] = b.[j-2] && a.[i-2] = b.[j-1])
then best
- else min best (m.(i-2).(j-2) + cost)
+ else Int.min best (m.(i-2).(j-2) + cost)
in
m.(i).(j) <- best
done;
in
"\x1b[" ^ s ^ "m"
+
+ type Format.stag += Style of style list
type styles = {
error: style list;
warning: style list;
| Format.String_tag "error" -> (!cur_styles).error
| Format.String_tag "warning" -> (!cur_styles).warning
| Format.String_tag "loc" -> (!cur_styles).loc
+ | Style s -> s
| _ -> raise Not_found
let color_enabled = ref true
let pp_two_columns ?(sep = "|") ?max_lines ppf (lines: (string * string) list) =
let left_column_size =
- List.fold_left (fun acc (s, _) -> max acc (String.length s)) 0 lines in
+ List.fold_left (fun acc (s, _) -> Int.max acc (String.length s)) 0 lines in
let lines_nb = List.length lines in
let ellipsed_first, ellipsed_last =
match max_lines with
type alerts = string Stdlib.String.Map.t
-
-module EnvLazy = struct
- type ('a,'b) t = ('a,'b) eval ref
-
- and ('a,'b) eval =
- | Done of 'b
- | Raise of exn
- | Thunk of 'a
-
- type undo =
- | Nil
- | Cons : ('a, 'b) t * 'a * undo -> undo
-
- type log = undo ref
-
- let force f x =
- match !x with
- | Done x -> x
- | Raise e -> raise e
- | Thunk e ->
- match f e with
- | y ->
- x := Done y;
- y
- | exception e ->
- x := Raise e;
- raise e
-
- let get_arg x =
- match !x with Thunk a -> Some a | _ -> None
-
- let create x =
- ref (Thunk x)
-
- let create_forced y =
- ref (Done y)
-
- let create_failed e =
- ref (Raise e)
-
- let log () =
- ref Nil
-
- let force_logged log f x =
- match !x with
- | Done x -> x
- | Raise e -> raise e
- | Thunk e ->
- match f e with
- | (Error _ as err : _ result) ->
- x := Done err;
- log := Cons(x, e, !log);
- err
- | Ok _ as res ->
- x := Done res;
- res
- | exception e ->
- x := Raise e;
- raise e
-
- let backtrack log =
- let rec loop = function
- | Nil -> ()
- | Cons(x, e, rest) ->
- x := Thunk e;
- loop rest
- in
- loop !log
-
-end
-
-
module Magic_number = struct
type native_obj_config = {
flambda : bool;
(* a header is "truncated" if it starts like a valid magic number,
that is if its longest segment of length at most [kind_length]
is a prefix of [raw_kind kind] for some kind [kind] *)
- let sub_length = min kind_length (String.length s) in
+ let sub_length = Int.min kind_length (String.length s) in
let starts_as kind =
String.sub s 0 sub_length = String.sub (raw_kind kind) 0 sub_length
in
| Bold
| Reset
+ type Format.stag += Style of style list
+
val ansi_of_style_l : style list -> string
(* ANSI escape sequence for the given style *)
type alerts = string Stdlib.String.Map.t
-module EnvLazy: sig
- type ('a,'b) t
-
- type log
-
- val force : ('a -> 'b) -> ('a,'b) t -> 'b
- val create : 'a -> ('a,'b) t
- val get_arg : ('a,'b) t -> 'a option
- val create_forced : 'b -> ('a, 'b) t
- val create_failed : exn -> ('a, 'b) t
-
- (* [force_logged log f t] is equivalent to [force f t] but if [f]
- returns [Error _] then [t] is recorded in [log]. [backtrack log]
- will then reset all the recorded [t]s back to their original
- state. *)
- val log : unit -> log
- val force_logged :
- log -> ('a -> ('b, 'c) result) -> ('a,('b, 'c) result) t -> ('b, 'c) result
- val backtrack : log -> unit
-
-end
-
-
module Magic_number : sig
(** a typical magic number is "Caml1999I011"; it is formed of an
alphanumeric prefix, here Caml1990I, followed by a version,
let max_by_column ~n_columns rows =
let a = Array.make n_columns 0. in
let rec loop (R (_, values, rows)) =
- List.iteri (fun i (v, _) -> a.(i) <- max a.(i) v) values;
+ List.iteri (fun i (v, _) -> a.(i) <- Float.max a.(i) v) values;
List.iter loop rows
in
List.iter loop rows;
let rec loop (R (_, values, rows)) =
List.iteri (fun i cell ->
let _, str = display_cell i cell ~width:0 in
- a.(i) <- max a.(i) (String.length str)
+ a.(i) <- Int.max a.(i) (String.length str)
) values;
List.iter loop rows;
in
set)
dependencies
- type numbering = {
- back : int Id.Map.t;
- forth : Id.t array;
- }
-
let number graph =
let size = Id.Map.cardinal graph in
let bindings = Id.Map.bindings graph in
v :: acc)
dests [])
in
- { back; forth }, integer_graph
+ forth, integer_graph
let component_graph graph =
- let numbering, integer_graph = number graph in
+ let forth, integer_graph = number graph in
let { Kosaraju. sorted_connected_components;
component_edges } =
Kosaraju.component_graph integer_graph
| [] -> assert false
| [node] ->
(if List.mem node integer_graph.(node)
- then Has_loop [numbering.forth.(node)]
- else No_loop numbering.forth.(node)),
+ then Has_loop [forth.(node)]
+ else No_loop forth.(node)),
component_edges.(component)
| _::_ ->
- (Has_loop (List.map (fun node -> numbering.forth.(node)) nodes)),
+ (Has_loop (List.map (fun node -> forth.(node)) nodes)),
component_edges.(component))
sorted_connected_components
loc_ghost: bool;
}
+type field_usage_warning =
+ | Unused
+ | Not_read
+ | Not_mutated
+
+type constructor_usage_warning =
+ | Unused
+ | Not_constructed
+ | Only_exported_private
+
type t =
| Comment_start (* 1 *)
| Comment_not_end (* 2 *)
| Unused_type_declaration of string (* 34 *)
| Unused_for_index of string (* 35 *)
| Unused_ancestor of string (* 36 *)
- | Unused_constructor of string * bool * bool (* 37 *)
- | Unused_extension of string * bool * bool * bool (* 38 *)
+ | Unused_constructor of string * constructor_usage_warning (* 37 *)
+ | Unused_extension of string * bool * constructor_usage_warning (* 38 *)
| Unused_rec_flag (* 39 *)
| Name_out_of_scope of string * string list * bool (* 40 *)
| Ambiguous_name of string list * string list * bool * string (* 41 *)
| Unused_open_bang of string (* 66 *)
| Unused_functor_parameter of string (* 67 *)
| Match_on_mutable_state_prevent_uncurry (* 68 *)
+ | Unused_field of string * field_usage_warning (* 69 *)
+ | Missing_mli (* 70 *)
;;
(* If you remove a warning, leave a hole in the numbering. NEVER change
| Unused_open_bang _ -> 66
| Unused_functor_parameter _ -> 67
| Match_on_mutable_state_prevent_uncurry -> 68
+ | Unused_field _ -> 69
+ | Missing_mli -> 70
;;
-let last_warning_number = 68
+let last_warning_number = 70
;;
(* Third component of each tuple is the list of names for each warning. The
68, "Pattern-matching depending on mutable state prevents the remaining \
arguments from being uncurried.",
["match-on-mutable-state-prevent-uncurry"];
+ 69, "Unused record field.",
+ ["unused-field"];
+ 70, "Missing interface file.",
+ ["missing-mli"]
]
;;
in
scan 0
-let parse_opt error active errflag s =
- let flags = if errflag then error else active in
- let set i =
- if i = 3 then set_alert ~error:errflag ~enable:true "deprecated"
- else flags.(i) <- true
+type modifier =
+ | Set (** +a *)
+ | Clear (** -a *)
+ | Set_all (** @a *)
+
+type token =
+ | Letter of char * modifier option
+ | Num of int * int * modifier
+
+let letter_alert tokens =
+ let print_warning_char ppf c =
+ let lowercase = Char.lowercase_ascii c = c in
+ Format.fprintf ppf "%c%c"
+ (if lowercase then '-' else '+') c
in
- let clear i =
- if i = 3 then set_alert ~error:errflag ~enable:false "deprecated"
- else flags.(i) <- false
+ let print_modifier ppf = function
+ | Set_all -> Format.fprintf ppf "@"
+ | Clear -> Format.fprintf ppf "-"
+ | Set -> Format.fprintf ppf "+"
in
- let set_all i =
- if i = 3 then begin
- set_alert ~error:false ~enable:true "deprecated";
- set_alert ~error:true ~enable:true "deprecated"
- end
- else begin
- active.(i) <- true;
- error.(i) <- true
- end
+ let print_token ppf = function
+ | Num (a,b,m) -> if a = b then
+ Format.fprintf ppf "%a%d" print_modifier m a
+ else
+ Format.fprintf ppf "%a%d..%d" print_modifier m a b
+ | Letter(l,Some m) -> Format.fprintf ppf "%a%c" print_modifier m l
+ | Letter(l,None) -> print_warning_char ppf l
+ in
+ let consecutive_letters =
+ (* we are tracking sequences of 2 or more consecutive unsigned letters
+ in warning strings, for instance in '-w "not-principa"'. *)
+ let commit_chunk l = function
+ | [] | [ _ ] -> l
+ | _ :: _ :: _ as chunk -> List.rev chunk :: l
+ in
+ let group_consecutive_letters (l,current) = function
+ | Letter (x, None) -> (l, x::current)
+ | _ -> (commit_chunk l current, [])
+ in
+ let l, on_going =
+ List.fold_left group_consecutive_letters ([],[]) tokens
+ in
+ commit_chunk l on_going
in
+ match consecutive_letters with
+ | [] -> None
+ | example :: _ ->
+ let pos = { Lexing.dummy_pos with pos_fname = "_none_" } in
+ let nowhere = { loc_start=pos; loc_end=pos; loc_ghost=true } in
+ let spelling_hint ppf =
+ let max_seq_len =
+ List.fold_left (fun l x -> Int.max l (List.length x))
+ 0 consecutive_letters
+ in
+ if max_seq_len >= 5 then
+ Format.fprintf ppf
+ "@ @[Hint: Did you make a spelling mistake \
+ when using a mnemonic name?@]"
+ else
+ ()
+ in
+ let message =
+ Format.asprintf
+ "@[<v>@[Setting a warning with a sequence of lowercase \
+ or uppercase letters,@ like '%a',@ is deprecated.@]@ \
+ @[Use the equivalent signed form:@ %t.@]@ \
+ @[Hint: Enabling or disabling a warning by its mnemonic name \
+ requires a + or - prefix.@]\
+ %t@?@]"
+ Format.(pp_print_list ~pp_sep:(fun _ -> ignore) pp_print_char) example
+ (fun ppf -> List.iter (print_token ppf) tokens)
+ spelling_hint
+ in
+ Some {
+ kind="ocaml_deprecated_cli";
+ use=nowhere; def=nowhere;
+ message
+ }
+
+
+let parse_warnings s =
let error () = raise (Arg.Bad "Ill-formed list of warnings") in
let rec get_num n i =
if i >= String.length s then i, n
else
i, n1, n1
in
- let rec loop i =
- if i >= String.length s then () else
+ let rec loop tokens i =
+ if i >= String.length s then List.rev tokens else
match s.[i] with
- | 'A' .. 'Z' ->
- List.iter set (letter (Char.lowercase_ascii s.[i]));
- loop (i+1)
- | 'a' .. 'z' ->
- List.iter clear (letter s.[i]);
- loop (i+1)
- | '+' -> loop_letter_num set (i+1)
- | '-' -> loop_letter_num clear (i+1)
- | '@' -> loop_letter_num set_all (i+1)
+ | 'A' .. 'Z' | 'a' .. 'z' ->
+ loop (Letter(s.[i],None)::tokens) (i+1)
+ | '+' -> loop_letter_num tokens Set (i+1)
+ | '-' -> loop_letter_num tokens Clear (i+1)
+ | '@' -> loop_letter_num tokens Set_all (i+1)
| _ -> error ()
- and loop_letter_num myset i =
+ and loop_letter_num tokens modifier i =
if i >= String.length s then error () else
match s.[i] with
| '0' .. '9' ->
let i, n1, n2 = get_range i in
- for n = n1 to min n2 last_warning_number do myset n done;
- loop i
- | 'A' .. 'Z' ->
- List.iter myset (letter (Char.lowercase_ascii s.[i]));
- loop (i+1)
- | 'a' .. 'z' ->
- List.iter myset (letter s.[i]);
- loop (i+1)
+ loop (Num(n1,n2,modifier)::tokens) i
+ | 'A' .. 'Z' | 'a' .. 'z' ->
+ loop (Letter(s.[i],Some modifier)::tokens) (i+1)
| _ -> error ()
in
- match name_to_number s with
- | Some n -> set n
+ loop [] 0
+
+let parse_opt error active errflag s =
+ let flags = if errflag then error else active in
+ let action modifier i = match modifier with
+ | Set ->
+ if i = 3 then set_alert ~error:errflag ~enable:true "deprecated"
+ else flags.(i) <- true
+ | Clear ->
+ if i = 3 then set_alert ~error:errflag ~enable:false "deprecated"
+ else flags.(i) <- false
+ | Set_all ->
+ if i = 3 then begin
+ set_alert ~error:false ~enable:true "deprecated";
+ set_alert ~error:true ~enable:true "deprecated"
+ end
+ else begin
+ active.(i) <- true;
+ error.(i) <- true
+ end
+ in
+ let eval = function
+ | Letter(c, m) ->
+ let lc = Char.lowercase_ascii c in
+ let modifier = match m with
+ | None -> if c = lc then Clear else Set
+ | Some m -> m
+ in
+ List.iter (action modifier) (letter lc)
+ | Num(n1,n2,modifier) ->
+ for n = n1 to Int.min n2 last_warning_number do action modifier n done
+ in
+ let parse_and_eval s =
+ let tokens = parse_warnings s in
+ List.iter eval tokens;
+ letter_alert tokens
+ in
+ match name_to_number s with
+ | Some n -> action Set n; None
| None ->
- if s = "" then loop 0
+ if s = "" then parse_and_eval s
else begin
let rest = String.sub s 1 (String.length s - 1) in
match s.[0], name_to_number rest with
- | '+', Some n -> set n
- | '-', Some n -> clear n
- | '@', Some n -> set_all n
- | _ -> loop 0
+ | '+', Some n -> action Set n; None
+ | '-', Some n -> action Clear n; None
+ | '@', Some n -> action Set_all n; None
+ | _ -> parse_and_eval s
end
;;
let parse_options errflag s =
let error = Array.copy (!current).error in
let active = Array.copy (!current).active in
- parse_opt error active errflag s;
- current := {(!current) with error; active}
+ let alerts = parse_opt error active errflag s in
+ current := {(!current) with error; active};
+ alerts
(* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-30-32..42-44-45-48-50-60-66-67-68";;
+let defaults_w = "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70";;
let defaults_warn_error = "-a+31";;
-let () = parse_options false defaults_w;;
-let () = parse_options true defaults_warn_error;;
+let () = ignore @@ parse_options false defaults_w;;
+let () = ignore @@ parse_options true defaults_warn_error;;
let ref_manual_explanation () =
(* manual references are checked a posteriori by the manual
cross-reference consistency check in manual/tests*)
- let[@manual.ref "s:comp-warnings"] chapter, section = 9, 5 in
+ let[@manual.ref "s:comp-warnings"] chapter, section = 11, 5 in
Printf.sprintf "(See manual section %d.%d)" chapter section
let message = function
| Unused_type_declaration s -> "unused type " ^ s ^ "."
| Unused_for_index s -> "unused for-loop index " ^ s ^ "."
| Unused_ancestor s -> "unused ancestor variable " ^ s ^ "."
- | Unused_constructor (s, false, false) -> "unused constructor " ^ s ^ "."
- | Unused_constructor (s, true, _) ->
+ | Unused_constructor (s, Unused) -> "unused constructor " ^ s ^ "."
+ | Unused_constructor (s, Not_constructed) ->
"constructor " ^ s ^
" is never used to build values.\n\
(However, this constructor appears in patterns.)"
- | Unused_constructor (s, false, true) ->
+ | Unused_constructor (s, Only_exported_private) ->
"constructor " ^ s ^
" is never used to build values.\n\
Its type is exported as a private type."
- | Unused_extension (s, is_exception, cu_pattern, cu_privatize) ->
+ | Unused_extension (s, is_exception, complaint) ->
let kind =
if is_exception then "exception" else "extension constructor" in
let name = kind ^ " " ^ s in
- begin match cu_pattern, cu_privatize with
- | false, false -> "unused " ^ name
- | true, _ ->
+ begin match complaint with
+ | Unused -> "unused " ^ name
+ | Not_constructed ->
name ^
" is never used to build values.\n\
(However, this constructor appears in patterns.)"
- | false, true ->
+ | Only_exported_private ->
name ^
" is never used to build values.\n\
It is exported or rebound as a private extension."
"This pattern depends on mutable state.\n\
It prevents the remaining arguments from being uncurried, which will \
cause additional closure allocations."
+ | Unused_field (s, Unused) -> "unused record field " ^ s ^ "."
+ | Unused_field (s, Not_read) ->
+ "record field " ^ s ^
+ " is never read.\n\
+ (However, this field is used to build or mutate values.)"
+ | Unused_field (s, Not_mutated) ->
+ "mutable record field " ^ s ^
+ " is never mutated."
+ | Missing_mli ->
+ "Cannot find interface file."
;;
let nerrors = ref 0;;
loc_ghost: bool;
}
+type field_usage_warning =
+ | Unused
+ | Not_read
+ | Not_mutated
+
+type constructor_usage_warning =
+ | Unused
+ | Not_constructed
+ | Only_exported_private
+
type t =
| Comment_start (* 1 *)
| Comment_not_end (* 2 *)
| Unused_type_declaration of string (* 34 *)
| Unused_for_index of string (* 35 *)
| Unused_ancestor of string (* 36 *)
- | Unused_constructor of string * bool * bool (* 37 *)
- | Unused_extension of string * bool * bool * bool (* 38 *)
+ | Unused_constructor of string * constructor_usage_warning (* 37 *)
+ | Unused_extension of string * bool * constructor_usage_warning (* 38 *)
| Unused_rec_flag (* 39 *)
| Name_out_of_scope of string * string list * bool (* 40 *)
| Ambiguous_name of string list * string list * bool * string (* 41 *)
| Unused_open_bang of string (* 66 *)
| Unused_functor_parameter of string (* 67 *)
| Match_on_mutable_state_prevent_uncurry (* 68 *)
+ | Unused_field of string * field_usage_warning (* 69 *)
+ | Missing_mli (* 70 *)
;;
type alert = {kind:string; message:string; def:loc; use:loc}
-val parse_options : bool -> string -> unit;;
+val parse_options : bool -> string -> alert option;;
val parse_alert_option: string -> unit
(** Disable/enable alerts based on the parameter to the -alert
projects / ocaml.git / commitdiff
![manual/manual/htmlman/contents_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/contents_motif.gif;h=5d3d016702478a74ae10ef900888bdd3c379aa3b;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![history](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=history;f=manual/manual/htmlman/contents_motif.gif;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg;h=1e520978debd2ac5c352a1a4c70422969e574210;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![history](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=history;f=manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![manual/manual/htmlman/libgraph.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/libgraph.gif;h=b385985b13d8f91851761f15db95b0e26f47f204;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![history](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=history;f=manual/manual/htmlman/libgraph.gif;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![manual/manual/htmlman/next_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/next_motif.gif;h=3f84bacfb26ea6a4141ad407ff4fb77954171fea;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![history](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=history;f=manual/manual/htmlman/next_motif.gif;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![manual/manual/htmlman/previous_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/previous_motif.gif;h=8c8a3e6430050e67e2e71dbd1f99fb9caf6176bf;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![history](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=history;f=manual/manual/htmlman/previous_motif.gif;hb=eabdaae7eba23922e31e223c0c97c3efed1f71b8){kind=link}
![manual/src/htmlman/contents_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/contents_motif.gif;h=5d3d016702478a74ae10ef900888bdd3c379aa3b;hb=e0926bb13788d678dda3abb3418403fad818a0f4){kind=link}
![manual/src/htmlman/fonts/fira-sans-v8-latin-regular.svg](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/fonts/fira-sans-v8-latin-regular.svg;h=1e520978debd2ac5c352a1a4c70422969e574210;hb=e0926bb13788d678dda3abb3418403fad818a0f4){kind=link}
![manual/src/htmlman/libgraph.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/libgraph.gif;h=b385985b13d8f91851761f15db95b0e26f47f204;hb=e0926bb13788d678dda3abb3418403fad818a0f4){kind=link}
![manual/src/htmlman/next_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/next_motif.gif;h=3f84bacfb26ea6a4141ad407ff4fb77954171fea;hb=e0926bb13788d678dda3abb3418403fad818a0f4){kind=link}
![manual/src/htmlman/previous_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/previous_motif.gif;h=8c8a3e6430050e67e2e71dbd1f99fb9caf6176bf;hb=e0926bb13788d678dda3abb3418403fad818a0f4){kind=link}
![a/manual/manual/htmlman/contents_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/contents_motif.gif;h=5d3d016702478a74ae10ef900888bdd3c379aa3b){kind=link}
![a/manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg;h=1e520978debd2ac5c352a1a4c70422969e574210){kind=link}
![-1,330](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/fonts/fira-sans-v8-latin-regular.svg;h=1e520978debd2ac5c352a1a4c70422969e574210#l1){kind=link}
![a/manual/manual/htmlman/libgraph.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/libgraph.gif;h=b385985b13d8f91851761f15db95b0e26f47f204){kind=link}
![a/manual/manual/htmlman/next_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/next_motif.gif;h=3f84bacfb26ea6a4141ad407ff4fb77954171fea){kind=link}
![a/manual/manual/htmlman/previous_motif.gif](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/manual/htmlman/previous_motif.gif;h=8c8a3e6430050e67e2e71dbd1f99fb9caf6176bf){kind=link}
![+1,330](/"http:/www.example.com/cgi/"https://"Program?p=ocaml.git;a=blob;f=manual/src/htmlman/fonts/fira-sans-v8-latin-regular.svg;h=1e520978debd2ac5c352a1a4c70422969e574210;hb=e0926bb13788d678dda3abb3418403fad818a0f4#l1){kind=link}